Takehisa Oneta / Mbed 2 deprecated malisp

Lisp Interpreter for mbed LPC1768

Dependencies:   mbed

Lisp Interpreter

(Marc Adler Lisp Interpreter, malisp)

mbed LPC1768 port by Takehisa Oneta (ohneta@gmail.com)

lisplib.cpp@0:e9a7a38d9ad3, 2016-04-17 (annotated)

Committer:
ohneta
Date:
Sun Apr 17 11:59:13 2016 +0000
Revision:
0:e9a7a38d9ad3
???????????

Who changed what in which revision?

UserRevisionLine numberNew contents of line
ohneta 0:e9a7a38d9ad3 1 // liblisp
ohneta 0:e9a7a38d9ad3 2
ohneta 0:e9a7a38d9ad3 3 const char *lisplib =
ohneta 0:e9a7a38d9ad3 4 "\
ohneta 0:e9a7a38d9ad3 5 (defun append (x y)\n\
ohneta 0:e9a7a38d9ad3 6 (cond ((null x) y)\n\
ohneta 0:e9a7a38d9ad3 7 (t (cons (car x) (append (cdr x) y)))\n\
ohneta 0:e9a7a38d9ad3 8 ) )\n\
ohneta 0:e9a7a38d9ad3 9 \n\
ohneta 0:e9a7a38d9ad3 10 (defun member (a lat)\n\
ohneta 0:e9a7a38d9ad3 11 (cond ((null lat) nil)\n\
ohneta 0:e9a7a38d9ad3 12 ((eq (car lat) a) t)\n\
ohneta 0:e9a7a38d9ad3 13 (t (member a (cdr lat)))\n\
ohneta 0:e9a7a38d9ad3 14 ) )\n\
ohneta 0:e9a7a38d9ad3 15 \n\
ohneta 0:e9a7a38d9ad3 16 (defun eqn (n1 n2)\n\
ohneta 0:e9a7a38d9ad3 17 (cond ((zerop n2) (zerop n1))\n\
ohneta 0:e9a7a38d9ad3 18 ((zerop n1) nil)\n\
ohneta 0:e9a7a38d9ad3 19 (t (eqn (sub1 n1) (sub1 n2)))\n\
ohneta 0:e9a7a38d9ad3 20 ) )\n\
ohneta 0:e9a7a38d9ad3 21 \n\
ohneta 0:e9a7a38d9ad3 22 (defun eqan (a1 a2)\n\
ohneta 0:e9a7a38d9ad3 23 (cond ((and (numberp a1) (numberp a2)) (eqn a1 a2))\n\
ohneta 0:e9a7a38d9ad3 24 ((or (numberp a1) (numberp a2)) nil)\n\
ohneta 0:e9a7a38d9ad3 25 (t (eq a1 a2))\n\
ohneta 0:e9a7a38d9ad3 26 ) )\n\
ohneta 0:e9a7a38d9ad3 27 \n\
ohneta 0:e9a7a38d9ad3 28 (defun equal (s1 s2)\n\
ohneta 0:e9a7a38d9ad3 29 (cond ((atom x) (eq x y))\n\
ohneta 0:e9a7a38d9ad3 30 ((atom y) nil)\n\
ohneta 0:e9a7a38d9ad3 31 ((equal (car x) (car y)) (equal (cdr x) (cdr y)))\n\
ohneta 0:e9a7a38d9ad3 32 (t nil)\n\
ohneta 0:e9a7a38d9ad3 33 ) )\n\
ohneta 0:e9a7a38d9ad3 34 \n\
ohneta 0:e9a7a38d9ad3 35 (defun equal2 (s1 s2)\n\
ohneta 0:e9a7a38d9ad3 36 (cond ((and (not (atom s1)) (not (atom s2)))\n\
ohneta 0:e9a7a38d9ad3 37 (and (equal2 (car s1) (car s2)) (equal2 (cdr s1) (cdr s2))))\n\
ohneta 0:e9a7a38d9ad3 38 ((and (atom s1) (atom s2)) (eqan s1 s2))\n\
ohneta 0:e9a7a38d9ad3 39 (t nil)\n\
ohneta 0:e9a7a38d9ad3 40 ) )\n\
ohneta 0:e9a7a38d9ad3 41 \n\
ohneta 0:e9a7a38d9ad3 42 (defun subst (old new lat)\n\
ohneta 0:e9a7a38d9ad3 43 (cond ((null lat) ())\n\
ohneta 0:e9a7a38d9ad3 44 ((eq (car lat) old) (cons new (cdr lat)))\n\
ohneta 0:e9a7a38d9ad3 45 (t (cons (car lat) (subst old new (cdr lat))))\n\
ohneta 0:e9a7a38d9ad3 46 ) )\n\
ohneta 0:e9a7a38d9ad3 47 \n\
ohneta 0:e9a7a38d9ad3 48 (defun length (lat)\n\
ohneta 0:e9a7a38d9ad3 49 (cond ((null lat) 0)\n\
ohneta 0:e9a7a38d9ad3 50 (t (add1 (length (cdr lat))))\n\
ohneta 0:e9a7a38d9ad3 51 ) )\n\
ohneta 0:e9a7a38d9ad3 52 \n\
ohneta 0:e9a7a38d9ad3 53 (defun intersect (set1 set2)\n\
ohneta 0:e9a7a38d9ad3 54 (cond ((null set1) ())\n\
ohneta 0:e9a7a38d9ad3 55 ((member (car set1) set2) (cons (car set1) (intersect (cdr set1) set2)))\n\
ohneta 0:e9a7a38d9ad3 56 (t (intersect (cdr set1) set2))\n\
ohneta 0:e9a7a38d9ad3 57 ) )\n\
ohneta 0:e9a7a38d9ad3 58 \n\
ohneta 0:e9a7a38d9ad3 59 (defun mapcar (fn x)\n\
ohneta 0:e9a7a38d9ad3 60 (cond ((null x) nil)\n\
ohneta 0:e9a7a38d9ad3 61 (t (cons (funcall fn (car x)) (mapcar fn (cdr x))))\n\
ohneta 0:e9a7a38d9ad3 62 ) )\n\
ohneta 0:e9a7a38d9ad3 63 \n\
ohneta 0:e9a7a38d9ad3 64 (defun maplist (fn x)\n\
ohneta 0:e9a7a38d9ad3 65 (cond ((null x) nil)\n\
ohneta 0:e9a7a38d9ad3 66 (t (cons (funcall fn x) (maplist fn (cdr x))))\n\
ohneta 0:e9a7a38d9ad3 67 ) )\n\
ohneta 0:e9a7a38d9ad3 68 \n\
ohneta 0:e9a7a38d9ad3 69 (defun mapc (fn x)\n\
ohneta 0:e9a7a38d9ad3 70 (prog ()\n\
ohneta 0:e9a7a38d9ad3 71 a (cond ((atom x) (return x)))\n\
ohneta 0:e9a7a38d9ad3 72 (funcall fn (car x))\n\
ohneta 0:e9a7a38d9ad3 73 (setq x (cdr x))\n\
ohneta 0:e9a7a38d9ad3 74 (go a)\n\
ohneta 0:e9a7a38d9ad3 75 )\n\
ohneta 0:e9a7a38d9ad3 76 )\n\
ohneta 0:e9a7a38d9ad3 77 \n\
ohneta 0:e9a7a38d9ad3 78 (defun map (fn x)\n\
ohneta 0:e9a7a38d9ad3 79 (prog ()\n\
ohneta 0:e9a7a38d9ad3 80 loop (cond ((atom x) (return x))\n\
ohneta 0:e9a7a38d9ad3 81 ((null x) (return nil))\n\
ohneta 0:e9a7a38d9ad3 82 )\n\
ohneta 0:e9a7a38d9ad3 83 (funcall fn x)\n\
ohneta 0:e9a7a38d9ad3 84 (setq x (cdr x))\n\
ohneta 0:e9a7a38d9ad3 85 (go loop)\n\
ohneta 0:e9a7a38d9ad3 86 )\n\
ohneta 0:e9a7a38d9ad3 87 )\n\
ohneta 0:e9a7a38d9ad3 88 ";