├── LICENSE ├── README.md ├── plisp-gc ├── Makefile ├── build.sh ├── code │ ├── Makefile │ ├── gencode.py │ ├── input.lisp │ ├── p0.lisp │ ├── p1.lisp │ ├── p10.lisp │ ├── p11.lisp │ ├── p12.lisp │ ├── p13.lisp │ ├── p14.lisp │ ├── p15.lisp │ ├── p2.lisp │ ├── p3.lisp │ ├── p4.lisp │ ├── p5.lisp │ ├── p6.lisp │ ├── p7.lisp │ ├── p8.lisp │ └── p9.lisp ├── defines.h ├── device_main.c ├── device_proto.h ├── globals.h ├── host_main.c ├── host_proto.h ├── includes.h ├── libdevice.c ├── libhost.c ├── libhost.h ├── libplisp.c ├── onefile.c ├── onefile.py ├── params.h ├── plisp ├── prog.lisp ├── run.sh ├── structures.h └── testfuncs.lisp ├── plisp-initial ├── Makefile ├── build.sh ├── code │ ├── Makefile │ ├── gencode.py │ ├── input.lisp │ ├── input2.lisp │ ├── p0.lisp │ ├── p1.lisp │ ├── p10.lisp │ ├── p11.lisp │ ├── p12.lisp │ ├── p13.lisp │ ├── p14.lisp │ ├── p15.lisp │ ├── p2.lisp │ ├── p3.lisp │ ├── p4.lisp │ ├── p5.lisp │ ├── p6.lisp │ ├── p7.lisp │ ├── p8.lisp │ └── p9.lisp ├── common.h ├── defines.h ├── fl-device.c ├── fl-host.c ├── globals.h ├── lisp.c ├── onefile.c ├── onefile.py ├── proto.h ├── run.sh └── structures.h ├── plisp ├── Makefile ├── build.sh ├── code │ ├── Makefile │ ├── gencode.py │ ├── input.lisp │ ├── p0.lisp │ ├── p1.lisp │ ├── p10.lisp │ ├── p11.lisp │ ├── p12.lisp │ ├── p13.lisp │ ├── p14.lisp │ ├── p15.lisp │ ├── p2.lisp │ ├── p3.lisp │ ├── p4.lisp │ ├── p5.lisp │ ├── p6.lisp │ ├── p7.lisp │ ├── p8.lisp │ └── p9.lisp ├── defines.h ├── device_main.c ├── device_proto.h ├── globals.h ├── host_main.c ├── host_proto.h ├── includes.h ├── libdevice.c ├── libhost.c ├── libhost.h ├── libplisp.c ├── onefile.c ├── onefile.py ├── params.h ├── plisp ├── prog.lisp ├── run.sh ├── structures.h └── testfuncs.lisp └── tests ├── eval.lisp ├── functions.lisp ├── hello-world.lisp ├── loop.lisp ├── math.lisp └── ycomb.lisp /plisp-gc/Makefile: -------------------------------------------------------------------------------- 1 | 2 | all: gencode fl onefile 3 | rm -f Trace.out 4 | 5 | build: 6 | (cd code; python gencode.py) 7 | bash ./build.sh 8 | 9 | run: 10 | (cd code; python gencode.py) 11 | bash ./run.sh 12 | 13 | gencode: 14 | (cd code; python gencode.py) 15 | 16 | fl: force 17 | rm -f fl fl.exe 18 | gcc -Os -std=gnu99 -Wall -o fl device_main.c libdevice.c libplisp.c 19 | 20 | onefile: force 21 | python onefile.py > onefile.c 22 | rm -f onefile onefile.exe 23 | gcc -Os -std=gnu99 -o onefile onefile.c 24 | wc -l onefile.c 25 | 26 | proto: 27 | cproto device_main.c libdevice.c libplisp.c > device_proto.h 28 | cproto -I/opt/adapteva/esdk/tools/host.armv7l/include host_main.c libhost.c > host_proto.h 29 | 30 | force: 31 | 32 | clean: 33 | rm -f fl onefile initmem *.elf *.srec *.o *.exe* Trace.out 34 | -------------------------------------------------------------------------------- /plisp-gc/build.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | set -e 4 | 5 | ESDK=${EPIPHANY_HOME} 6 | ELIBS=${ESDK}/tools/host/lib 7 | EINCS=${ESDK}/tools/host/include 8 | ELDF=${ESDK}/bsps/current/fast.ldf 9 | 10 | SCRIPT=$(readlink -f "$0") 11 | EXEPATH=$(dirname "$SCRIPT") 12 | cd $EXEPATH 13 | 14 | CROSS_PREFIX= 15 | case $(uname -p) in 16 | arm*) 17 | # Use native arm compiler (no cross prefix) 18 | CROSS_PREFIX= 19 | ;; 20 | *) 21 | # Use cross compiler 22 | CROSS_PREFIX="arm-linux-gnueabihf-" 23 | ;; 24 | esac 25 | 26 | ${CROSS_PREFIX}gcc -Os -std=gnu99 -Wno-format-security host_main.c libhost.c -o fl-host.elf -I ${EINCS} -L ${ELIBS} -le-hal -le-loader -lpthread 27 | 28 | e-gcc -Os -DEPIPHANY=1 -std=gnu99 -T ${ELDF} device_main.c libdevice.c libplisp.c -o fl-device.elf -le-lib 29 | 30 | e-objcopy --srec-forceS3 --output-target srec fl-device.elf fl-device.srec 31 | 32 | -------------------------------------------------------------------------------- /plisp-gc/code/Makefile: -------------------------------------------------------------------------------- 1 | 2 | all: 3 | python gencode.py 4 | -------------------------------------------------------------------------------- /plisp-gc/code/input.lisp: -------------------------------------------------------------------------------- 1 | (label nfibs 2 | (lambda (n) 3 | (if (< n 2) 4 | n 5 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 6 | ) 7 | ) 8 | ) 9 | (label recurse (lambda (x) 10 | (cond ((equal (car x) end) 'stop) 11 | (t (recurse (cdr x))) 12 | ) 13 | ) 14 | ) 15 | (recurse (a b c d e f end)) 16 | (nfibs 10) 17 | 18 | (label ff (lambda (x y) 19 | (cons (car x) y) 20 | ) 21 | ) 22 | 'a 23 | '(a b c) 24 | (car '(a b c)) 25 | (cdr '(a b c)) 26 | (cons 'a '(b c)) 27 | (equal (car '(a b)) 'a) 28 | (equal (car (cdr '(a b))) 'a) 29 | (atom 'a) 30 | (cond ((atom '(1 2)) 'b) (t 'c)) 31 | (cond (nil 10) (t 20)) 32 | ((lambda (x y) (cons (car x) y)) '(a b) (cdr '(c d))) 33 | (ff '(a b) (cdr '(c d))) 34 | (label xx '(a b)) 35 | (car xx) 36 | (label xx '(c d)) 37 | (car xx) 38 | -------------------------------------------------------------------------------- /plisp-gc/code/p1.lisp: -------------------------------------------------------------------------------- 1 | 2 | (defun nfibs (n) 3 | (if (< n 2) n 4 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 5 | ) 6 | ) 7 | 8 | (defun member (a lat) 9 | (cond ((null lat) nil) 10 | ((eq (car lat) a) t) 11 | (t (member a (cdr lat))) 12 | ) 13 | ) 14 | 15 | (defun rember (a lat) 16 | (cond ((null lat) ()) 17 | ((eq (car lat) a) (cdr lat)) 18 | (t (cons (car lat) (rember a (cdr lat)))) 19 | ) 20 | ) 21 | 22 | (defun eqn (n1 n2) 23 | (cond ((zerop n2) (zerop n1)) 24 | ((zerop n1) nil) 25 | (t (eqn (sub1 n1) (sub1 n2))) 26 | ) 27 | ) 28 | 29 | (defun multiins (old new lat) 30 | (cond ((null lat) ()) 31 | ((eq (car lat) old) (cons (car lat) 32 | (cons new (multiins old new (cdr lat))))) 33 | (t (cons (car lat) (multiins old new (cdr lat)))) 34 | ) 35 | ) 36 | 37 | (defun mapcar (fn x) 38 | (cond ((null x) nil) 39 | (t (cons (funcall fn (car x)) (mapcar fn (cdr x)))) 40 | ) 41 | ) 42 | 43 | (defun maplist (fn x) 44 | (cond ((null x) nil) 45 | (t (cons (funcall fn x) (maplist fn (cdr x)))) 46 | ) 47 | ) 48 | 49 | (defun map (f lst) 50 | (if (atom lst) lst 51 | (cons (f (car lst)) (map f (cdr lst))))) 52 | 53 | (defun mycar (x) (car x)) 54 | (defun mycdr (x) (cdr x)) 55 | 56 | (defun pow (n1 n2) 57 | (cond ((zerop n2) 1) 58 | (t (times n1 (pow n1 (sub1 n2)))) 59 | ) 60 | ) 61 | 62 | (defun double (n) (times n 2)) 63 | (defun square (n) (times n n)) 64 | (defun testfun (n) 65 | (funcall (cond ((greaterp n 100) 'double) 66 | (t 'square) ) 67 | n) 68 | ) 69 | 70 | (defun subst (old new lat) 71 | (cond ((null lat) ()) 72 | ((eq (car lat) old) (cons new (cdr lat))) 73 | (t (cons (car lat) (subst old new (cdr lat)))) 74 | ) 75 | ) 76 | 77 | (defun length (lat) 78 | (cond ((null lat) 0) 79 | (t (add1 (length (cdr lat)))) 80 | ) 81 | ) 82 | 83 | (defun intersect (set1 set2) 84 | (cond ((null set1) ()) 85 | ((member (car set1) set2) (cons (car set1) (intersect (cdr set1) set2))) 86 | (t (intersect (cdr set1) set2)) 87 | ) 88 | ) 89 | 90 | (defun factorial (n) 91 | (cond ((= n 1) 1) 92 | (t (* n (factorial (- n 1)))) 93 | ) 94 | ) 95 | 96 | (defun rem (x d) 97 | (- x (* (/ x d) d))) 98 | 99 | (defun is-even (x) 100 | (if (= 0 (rem x 2)) 101 | t 102 | nil)) 103 | 104 | (defun is-odd (x) 105 | (if (is-even x) 106 | nil 107 | t)) 108 | 109 | (defun is-divisible (x y) 110 | (if (= y 1) 111 | nil 112 | (if (>= y x) 113 | nil 114 | (if (= 0 (rem x y)) 115 | t 116 | nil)))) 117 | 118 | (defun is-prime (x) 119 | (if (is-even x) 120 | nil 121 | (is-prime-rec x 1))) 122 | 123 | (defun is-prime-rec 124 | (x y) 125 | (if (is-divisible x y) 126 | nil 127 | (if (>= y x) 128 | t 129 | (is-prime-rec x (+ 2 y))))) 130 | 131 | (defun gcd (x y) 132 | (cond 133 | ((= y 0) x) 134 | (t (gcd y (rem x y))))) 135 | 136 | (defun lcm (x y) 137 | (/ (abs (* x y)) (gcd x y))) 138 | 139 | (defun nth (lis n) 140 | (if (= n 0) 141 | (car lis) 142 | (nth (cdr lis) (- n 1)) 143 | ) 144 | ) 145 | 146 | (defun nthcdr (lst n) 147 | (if (<= n 0) lst 148 | (nthcdr (cdr lst) (- n 1)))) 149 | 150 | (defun list-ref (lst n) 151 | (car (nthcdr lst n))) 152 | 153 | (defun filter (pred lst) 154 | (cond ((null lst) ()) 155 | ((not (pred (car lst))) (filter pred (cdr lst))) 156 | (t (cons (car lst) (filter pred (cdr lst)))))) 157 | 158 | (defun caar (x) (car (car x))) 159 | 160 | (defun assoc (item lst) 161 | (cond ((atom lst) ()) 162 | ((eq (caar lst) item) (car lst)) 163 | (t (assoc item (cdr lst))))) 164 | 165 | (defun sum-to-n (n) 166 | (cond 167 | ((< n 0) 0) 168 | (t (+ n (sum-to-n (- n 1)))))) 169 | 170 | (defun gauss (n) 171 | (/ (* n (+ n 1)) 2)) 172 | 173 | (defun abs (x) (if (< x 0) (- 0 x) x)) 174 | 175 | (defun reverse- (zero lst) 176 | (if (null lst) zero 177 | (reverse- (cons (car lst) zero) (cdr lst)))) 178 | 179 | (defun reverse (lst) (reverse- () lst)) 180 | 181 | (defun last (l) 182 | (cond ((atom l) l) 183 | ((atom (cdr l)) l) 184 | (t (last (cdr l))))) 185 | 186 | (defun foldr (f zero lst) 187 | (if (null lst) zero 188 | (f (car lst) (foldr f zero (cdr lst))))) 189 | 190 | (defun foldl (f zero lst) 191 | (if (null lst) zero 192 | (foldl f (f (car lst) zero) (cdr lst)))) 193 | 194 | (defun reverse2 (lst) (foldl cons nil lst)) 195 | 196 | (defun append (a b) (foldr cons b a)) 197 | 198 | (defun identity (x) x) 199 | (defun copy-list (l) (map identity l)) 200 | (defun copy-tree (l) 201 | (if (atom l) l 202 | (cons (copy-tree (car l)) 203 | (copy-tree (cdr l))))) 204 | 205 | (defun every (pred lst) 206 | (or (atom lst) 207 | (and (funcall pred (car lst)) 208 | (every pred (cdr lst))))) 209 | 210 | (defun any (pred lst) 211 | (and (consp lst) 212 | (or (funcall pred (car lst)) 213 | (any pred (cdr lst))))) 214 | 215 | (copy-tree '((a b c d) (e f g) h i j)) 216 | (gauss 100) 217 | (list-ref '(1 2 3 4) 1) 218 | (mapcar 'atom '(list 1 (2) foo t nil)) 219 | (mapcar 'is-prime (3 5 7 11 13 17 19 23 29 31 37 41 43 47)) 220 | (nthcdr '(1 2 3 4 5) 2) 221 | (every numberp '(1 2)) 222 | (filter numberp '(1 2 3 a b c 4 5 6)) 223 | 224 | (last '(1 2 3 4)) 225 | -------------------------------------------------------------------------------- /plisp-gc/code/p10.lisp: -------------------------------------------------------------------------------- 1 | 2 | (defun nfibs (n) 3 | (if (< n 2) n 4 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 5 | ) 6 | ) 7 | 8 | (defun member (a lat) 9 | (cond ((null lat) nil) 10 | ((eq (car lat) a) t) 11 | (t (member a (cdr lat))) 12 | ) 13 | ) 14 | 15 | (defun rember (a lat) 16 | (cond ((null lat) ()) 17 | ((eq (car lat) a) (cdr lat)) 18 | (t (cons (car lat) (rember a (cdr lat)))) 19 | ) 20 | ) 21 | 22 | (defun eqn (n1 n2) 23 | (cond ((zerop n2) (zerop n1)) 24 | ((zerop n1) nil) 25 | (t (eqn (sub1 n1) (sub1 n2))) 26 | ) 27 | ) 28 | 29 | (defun multiins (old new lat) 30 | (cond ((null lat) ()) 31 | ((eq (car lat) old) (cons (car lat) 32 | (cons new (multiins old new (cdr lat))))) 33 | (t (cons (car lat) (multiins old new (cdr lat)))) 34 | ) 35 | ) 36 | 37 | (defun mapcar (fn x) 38 | (cond ((null x) nil) 39 | (t (cons (funcall fn (car x)) (mapcar fn (cdr x)))) 40 | ) 41 | ) 42 | 43 | (defun maplist (fn x) 44 | (cond ((null x) nil) 45 | (t (cons (funcall fn x) (maplist fn (cdr x)))) 46 | ) 47 | ) 48 | 49 | (defun map (f lst) 50 | (if (atom lst) lst 51 | (cons (f (car lst)) (map f (cdr lst))))) 52 | 53 | (defun mycar (x) (car x)) 54 | (defun mycdr (x) (cdr x)) 55 | 56 | (defun pow (n1 n2) 57 | (cond ((zerop n2) 1) 58 | (t (times n1 (pow n1 (sub1 n2)))) 59 | ) 60 | ) 61 | 62 | (defun double (n) (times n 2)) 63 | (defun square (n) (times n n)) 64 | (defun testfun (n) 65 | (funcall (cond ((greaterp n 100) 'double) 66 | (t 'square) ) 67 | n) 68 | ) 69 | 70 | (defun subst (old new lat) 71 | (cond ((null lat) ()) 72 | ((eq (car lat) old) (cons new (cdr lat))) 73 | (t (cons (car lat) (subst old new (cdr lat)))) 74 | ) 75 | ) 76 | 77 | (defun length (lat) 78 | (cond ((null lat) 0) 79 | (t (add1 (length (cdr lat)))) 80 | ) 81 | ) 82 | 83 | (defun intersect (set1 set2) 84 | (cond ((null set1) ()) 85 | ((member (car set1) set2) (cons (car set1) (intersect (cdr set1) set2))) 86 | (t (intersect (cdr set1) set2)) 87 | ) 88 | ) 89 | 90 | (defun factorial (n) 91 | (cond ((= n 1) 1) 92 | (t (* n (factorial (- n 1)))) 93 | ) 94 | ) 95 | 96 | (defun rem (x d) 97 | (- x (* (/ x d) d))) 98 | 99 | (defun is-even (x) 100 | (if (= 0 (rem x 2)) 101 | t 102 | nil)) 103 | 104 | (defun is-odd (x) 105 | (if (is-even x) 106 | nil 107 | t)) 108 | 109 | (defun is-divisible (x y) 110 | (if (= y 1) 111 | nil 112 | (if (>= y x) 113 | nil 114 | (if (= 0 (rem x y)) 115 | t 116 | nil)))) 117 | 118 | (defun is-prime (x) 119 | (if (is-even x) 120 | nil 121 | (is-prime-rec x 1))) 122 | 123 | (defun is-prime-rec 124 | (x y) 125 | (if (is-divisible x y) 126 | nil 127 | (if (>= y x) 128 | t 129 | (is-prime-rec x (+ 2 y))))) 130 | 131 | (defun gcd (x y) 132 | (cond 133 | ((= y 0) x) 134 | (t (gcd y (rem x y))))) 135 | 136 | (defun lcm (x y) 137 | (/ (abs (* x y)) (gcd x y))) 138 | 139 | (defun nth (lis n) 140 | (if (= n 0) 141 | (car lis) 142 | (nth (cdr lis) (- n 1)) 143 | ) 144 | ) 145 | 146 | (defun nthcdr (lst n) 147 | (if (<= n 0) lst 148 | (nthcdr (cdr lst) (- n 1)))) 149 | 150 | (defun list-ref (lst n) 151 | (car (nthcdr lst n))) 152 | 153 | (defun filter (pred lst) 154 | (cond ((null lst) ()) 155 | ((not (pred (car lst))) (filter pred (cdr lst))) 156 | (t (cons (car lst) (filter pred (cdr lst)))))) 157 | 158 | (defun caar (x) (car (car x))) 159 | 160 | (defun assoc (item lst) 161 | (cond ((atom lst) ()) 162 | ((eq (caar lst) item) (car lst)) 163 | (t (assoc item (cdr lst))))) 164 | 165 | (defun sum-to-n (n) 166 | (cond 167 | ((< n 0) 0) 168 | (t (+ n (sum-to-n (- n 1)))))) 169 | 170 | (defun gauss (n) 171 | (/ (* n (+ n 1)) 2)) 172 | 173 | (defun abs (x) (if (< x 0) (- 0 x) x)) 174 | 175 | (defun reverse- (zero lst) 176 | (if (null lst) zero 177 | (reverse- (cons (car lst) zero) (cdr lst)))) 178 | 179 | (defun reverse (lst) (reverse- () lst)) 180 | 181 | (defun last (l) 182 | (cond ((atom l) l) 183 | ((atom (cdr l)) l) 184 | (t (last (cdr l))))) 185 | 186 | (defun foldr (f zero lst) 187 | (if (null lst) zero 188 | (f (car lst) (foldr f zero (cdr lst))))) 189 | 190 | (defun foldl (f zero lst) 191 | (if (null lst) zero 192 | (foldl f (f (car lst) zero) (cdr lst)))) 193 | 194 | (defun reverse2 (lst) (foldl cons nil lst)) 195 | 196 | (defun append (a b) (foldr cons b a)) 197 | 198 | (defun identity (x) x) 199 | (defun copy-list (l) (map identity l)) 200 | (defun copy-tree (l) 201 | (if (atom l) l 202 | (cons (copy-tree (car l)) 203 | (copy-tree (cdr l))))) 204 | 205 | (defun every (pred lst) 206 | (or (atom lst) 207 | (and (funcall pred (car lst)) 208 | (every pred (cdr lst))))) 209 | 210 | (defun any (pred lst) 211 | (and (consp lst) 212 | (or (funcall pred (car lst)) 213 | (any pred (cdr lst))))) 214 | 215 | (testfun 101) 216 | (reverse '(1 2 3 4 5 6 7)) 217 | (every numberp '(1 a)) 218 | (length '(0 1 2 3 4 5 6 7 8 9)) 219 | (pow 234 0) 220 | (mapcar 'atom '(list 1 (2) foo t nil)) 221 | (last '(1 2 3 4)) 222 | (list-ref '(1 2 3 4) 1) 223 | (any numberp '(a b)) 224 | (subst 'me 'you '(a list with me)) 225 | -------------------------------------------------------------------------------- /plisp-gc/code/p12.lisp: -------------------------------------------------------------------------------- 1 | 2 | (defun nfibs (n) 3 | (if (< n 2) n 4 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 5 | ) 6 | ) 7 | 8 | (defun member (a lat) 9 | (cond ((null lat) nil) 10 | ((eq (car lat) a) t) 11 | (t (member a (cdr lat))) 12 | ) 13 | ) 14 | 15 | (defun rember (a lat) 16 | (cond ((null lat) ()) 17 | ((eq (car lat) a) (cdr lat)) 18 | (t (cons (car lat) (rember a (cdr lat)))) 19 | ) 20 | ) 21 | 22 | (defun eqn (n1 n2) 23 | (cond ((zerop n2) (zerop n1)) 24 | ((zerop n1) nil) 25 | (t (eqn (sub1 n1) (sub1 n2))) 26 | ) 27 | ) 28 | 29 | (defun multiins (old new lat) 30 | (cond ((null lat) ()) 31 | ((eq (car lat) old) (cons (car lat) 32 | (cons new (multiins old new (cdr lat))))) 33 | (t (cons (car lat) (multiins old new (cdr lat)))) 34 | ) 35 | ) 36 | 37 | (defun mapcar (fn x) 38 | (cond ((null x) nil) 39 | (t (cons (funcall fn (car x)) (mapcar fn (cdr x)))) 40 | ) 41 | ) 42 | 43 | (defun maplist (fn x) 44 | (cond ((null x) nil) 45 | (t (cons (funcall fn x) (maplist fn (cdr x)))) 46 | ) 47 | ) 48 | 49 | (defun map (f lst) 50 | (if (atom lst) lst 51 | (cons (f (car lst)) (map f (cdr lst))))) 52 | 53 | (defun mycar (x) (car x)) 54 | (defun mycdr (x) (cdr x)) 55 | 56 | (defun pow (n1 n2) 57 | (cond ((zerop n2) 1) 58 | (t (times n1 (pow n1 (sub1 n2)))) 59 | ) 60 | ) 61 | 62 | (defun double (n) (times n 2)) 63 | (defun square (n) (times n n)) 64 | (defun testfun (n) 65 | (funcall (cond ((greaterp n 100) 'double) 66 | (t 'square) ) 67 | n) 68 | ) 69 | 70 | (defun subst (old new lat) 71 | (cond ((null lat) ()) 72 | ((eq (car lat) old) (cons new (cdr lat))) 73 | (t (cons (car lat) (subst old new (cdr lat)))) 74 | ) 75 | ) 76 | 77 | (defun length (lat) 78 | (cond ((null lat) 0) 79 | (t (add1 (length (cdr lat)))) 80 | ) 81 | ) 82 | 83 | (defun intersect (set1 set2) 84 | (cond ((null set1) ()) 85 | ((member (car set1) set2) (cons (car set1) (intersect (cdr set1) set2))) 86 | (t (intersect (cdr set1) set2)) 87 | ) 88 | ) 89 | 90 | (defun factorial (n) 91 | (cond ((= n 1) 1) 92 | (t (* n (factorial (- n 1)))) 93 | ) 94 | ) 95 | 96 | (defun rem (x d) 97 | (- x (* (/ x d) d))) 98 | 99 | (defun is-even (x) 100 | (if (= 0 (rem x 2)) 101 | t 102 | nil)) 103 | 104 | (defun is-odd (x) 105 | (if (is-even x) 106 | nil 107 | t)) 108 | 109 | (defun is-divisible (x y) 110 | (if (= y 1) 111 | nil 112 | (if (>= y x) 113 | nil 114 | (if (= 0 (rem x y)) 115 | t 116 | nil)))) 117 | 118 | (defun is-prime (x) 119 | (if (is-even x) 120 | nil 121 | (is-prime-rec x 1))) 122 | 123 | (defun is-prime-rec 124 | (x y) 125 | (if (is-divisible x y) 126 | nil 127 | (if (>= y x) 128 | t 129 | (is-prime-rec x (+ 2 y))))) 130 | 131 | (defun gcd (x y) 132 | (cond 133 | ((= y 0) x) 134 | (t (gcd y (rem x y))))) 135 | 136 | (defun lcm (x y) 137 | (/ (abs (* x y)) (gcd x y))) 138 | 139 | (defun nth (lis n) 140 | (if (= n 0) 141 | (car lis) 142 | (nth (cdr lis) (- n 1)) 143 | ) 144 | ) 145 | 146 | (defun nthcdr (lst n) 147 | (if (<= n 0) lst 148 | (nthcdr (cdr lst) (- n 1)))) 149 | 150 | (defun list-ref (lst n) 151 | (car (nthcdr lst n))) 152 | 153 | (defun filter (pred lst) 154 | (cond ((null lst) ()) 155 | ((not (pred (car lst))) (filter pred (cdr lst))) 156 | (t (cons (car lst) (filter pred (cdr lst)))))) 157 | 158 | (defun caar (x) (car (car x))) 159 | 160 | (defun assoc (item lst) 161 | (cond ((atom lst) ()) 162 | ((eq (caar lst) item) (car lst)) 163 | (t (assoc item (cdr lst))))) 164 | 165 | (defun sum-to-n (n) 166 | (cond 167 | ((< n 0) 0) 168 | (t (+ n (sum-to-n (- n 1)))))) 169 | 170 | (defun gauss (n) 171 | (/ (* n (+ n 1)) 2)) 172 | 173 | (defun abs (x) (if (< x 0) (- 0 x) x)) 174 | 175 | (defun reverse- (zero lst) 176 | (if (null lst) zero 177 | (reverse- (cons (car lst) zero) (cdr lst)))) 178 | 179 | (defun reverse (lst) (reverse- () lst)) 180 | 181 | (defun last (l) 182 | (cond ((atom l) l) 183 | ((atom (cdr l)) l) 184 | (t (last (cdr l))))) 185 | 186 | (defun foldr (f zero lst) 187 | (if (null lst) zero 188 | (f (car lst) (foldr f zero (cdr lst))))) 189 | 190 | (defun foldl (f zero lst) 191 | (if (null lst) zero 192 | (foldl f (f (car lst) zero) (cdr lst)))) 193 | 194 | (defun reverse2 (lst) (foldl cons nil lst)) 195 | 196 | (defun append (a b) (foldr cons b a)) 197 | 198 | (defun identity (x) x) 199 | (defun copy-list (l) (map identity l)) 200 | (defun copy-tree (l) 201 | (if (atom l) l 202 | (cons (copy-tree (car l)) 203 | (copy-tree (cdr l))))) 204 | 205 | (defun every (pred lst) 206 | (or (atom lst) 207 | (and (funcall pred (car lst)) 208 | (every pred (cdr lst))))) 209 | 210 | (defun any (pred lst) 211 | (and (consp lst) 212 | (or (funcall pred (car lst)) 213 | (any pred (cdr lst))))) 214 | 215 | (gauss 100) 216 | (reverse '(1 2 3 4 5 6 7)) 217 | (pow 234 0) 218 | (intersect '(a b c d e f) '(d e f)) 219 | 220 | (mapcar 'is-prime (3 5 7 11 13 17 19 23 29 31 37 41 43 47)) 221 | 222 | (subst 'me 'you '(a list with me)) 223 | (copy-tree '((a b c d) (e f g) h i j)) 224 | (pow 2 3) 225 | -------------------------------------------------------------------------------- /plisp-gc/code/p13.lisp: -------------------------------------------------------------------------------- 1 | 2 | (defun nfibs (n) 3 | (if (< n 2) n 4 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 5 | ) 6 | ) 7 | 8 | (defun member (a lat) 9 | (cond ((null lat) nil) 10 | ((eq (car lat) a) t) 11 | (t (member a (cdr lat))) 12 | ) 13 | ) 14 | 15 | (defun rember (a lat) 16 | (cond ((null lat) ()) 17 | ((eq (car lat) a) (cdr lat)) 18 | (t (cons (car lat) (rember a (cdr lat)))) 19 | ) 20 | ) 21 | 22 | (defun eqn (n1 n2) 23 | (cond ((zerop n2) (zerop n1)) 24 | ((zerop n1) nil) 25 | (t (eqn (sub1 n1) (sub1 n2))) 26 | ) 27 | ) 28 | 29 | (defun multiins (old new lat) 30 | (cond ((null lat) ()) 31 | ((eq (car lat) old) (cons (car lat) 32 | (cons new (multiins old new (cdr lat))))) 33 | (t (cons (car lat) (multiins old new (cdr lat)))) 34 | ) 35 | ) 36 | 37 | (defun mapcar (fn x) 38 | (cond ((null x) nil) 39 | (t (cons (funcall fn (car x)) (mapcar fn (cdr x)))) 40 | ) 41 | ) 42 | 43 | (defun maplist (fn x) 44 | (cond ((null x) nil) 45 | (t (cons (funcall fn x) (maplist fn (cdr x)))) 46 | ) 47 | ) 48 | 49 | (defun map (f lst) 50 | (if (atom lst) lst 51 | (cons (f (car lst)) (map f (cdr lst))))) 52 | 53 | (defun mycar (x) (car x)) 54 | (defun mycdr (x) (cdr x)) 55 | 56 | (defun pow (n1 n2) 57 | (cond ((zerop n2) 1) 58 | (t (times n1 (pow n1 (sub1 n2)))) 59 | ) 60 | ) 61 | 62 | (defun double (n) (times n 2)) 63 | (defun square (n) (times n n)) 64 | (defun testfun (n) 65 | (funcall (cond ((greaterp n 100) 'double) 66 | (t 'square) ) 67 | n) 68 | ) 69 | 70 | (defun subst (old new lat) 71 | (cond ((null lat) ()) 72 | ((eq (car lat) old) (cons new (cdr lat))) 73 | (t (cons (car lat) (subst old new (cdr lat)))) 74 | ) 75 | ) 76 | 77 | (defun length (lat) 78 | (cond ((null lat) 0) 79 | (t (add1 (length (cdr lat)))) 80 | ) 81 | ) 82 | 83 | (defun intersect (set1 set2) 84 | (cond ((null set1) ()) 85 | ((member (car set1) set2) (cons (car set1) (intersect (cdr set1) set2))) 86 | (t (intersect (cdr set1) set2)) 87 | ) 88 | ) 89 | 90 | (defun factorial (n) 91 | (cond ((= n 1) 1) 92 | (t (* n (factorial (- n 1)))) 93 | ) 94 | ) 95 | 96 | (defun rem (x d) 97 | (- x (* (/ x d) d))) 98 | 99 | (defun is-even (x) 100 | (if (= 0 (rem x 2)) 101 | t 102 | nil)) 103 | 104 | (defun is-odd (x) 105 | (if (is-even x) 106 | nil 107 | t)) 108 | 109 | (defun is-divisible (x y) 110 | (if (= y 1) 111 | nil 112 | (if (>= y x) 113 | nil 114 | (if (= 0 (rem x y)) 115 | t 116 | nil)))) 117 | 118 | (defun is-prime (x) 119 | (if (is-even x) 120 | nil 121 | (is-prime-rec x 1))) 122 | 123 | (defun is-prime-rec 124 | (x y) 125 | (if (is-divisible x y) 126 | nil 127 | (if (>= y x) 128 | t 129 | (is-prime-rec x (+ 2 y))))) 130 | 131 | (defun gcd (x y) 132 | (cond 133 | ((= y 0) x) 134 | (t (gcd y (rem x y))))) 135 | 136 | (defun lcm (x y) 137 | (/ (abs (* x y)) (gcd x y))) 138 | 139 | (defun nth (lis n) 140 | (if (= n 0) 141 | (car lis) 142 | (nth (cdr lis) (- n 1)) 143 | ) 144 | ) 145 | 146 | (defun nthcdr (lst n) 147 | (if (<= n 0) lst 148 | (nthcdr (cdr lst) (- n 1)))) 149 | 150 | (defun list-ref (lst n) 151 | (car (nthcdr lst n))) 152 | 153 | (defun filter (pred lst) 154 | (cond ((null lst) ()) 155 | ((not (pred (car lst))) (filter pred (cdr lst))) 156 | (t (cons (car lst) (filter pred (cdr lst)))))) 157 | 158 | (defun caar (x) (car (car x))) 159 | 160 | (defun assoc (item lst) 161 | (cond ((atom lst) ()) 162 | ((eq (caar lst) item) (car lst)) 163 | (t (assoc item (cdr lst))))) 164 | 165 | (defun sum-to-n (n) 166 | (cond 167 | ((< n 0) 0) 168 | (t (+ n (sum-to-n (- n 1)))))) 169 | 170 | (defun gauss (n) 171 | (/ (* n (+ n 1)) 2)) 172 | 173 | (defun abs (x) (if (< x 0) (- 0 x) x)) 174 | 175 | (defun reverse- (zero lst) 176 | (if (null lst) zero 177 | (reverse- (cons (car lst) zero) (cdr lst)))) 178 | 179 | (defun reverse (lst) (reverse- () lst)) 180 | 181 | (defun last (l) 182 | (cond ((atom l) l) 183 | ((atom (cdr l)) l) 184 | (t (last (cdr l))))) 185 | 186 | (defun foldr (f zero lst) 187 | (if (null lst) zero 188 | (f (car lst) (foldr f zero (cdr lst))))) 189 | 190 | (defun foldl (f zero lst) 191 | (if (null lst) zero 192 | (foldl f (f (car lst) zero) (cdr lst)))) 193 | 194 | (defun reverse2 (lst) (foldl cons nil lst)) 195 | 196 | (defun append (a b) (foldr cons b a)) 197 | 198 | (defun identity (x) x) 199 | (defun copy-list (l) (map identity l)) 200 | (defun copy-tree (l) 201 | (if (atom l) l 202 | (cons (copy-tree (car l)) 203 | (copy-tree (cdr l))))) 204 | 205 | (defun every (pred lst) 206 | (or (atom lst) 207 | (and (funcall pred (car lst)) 208 | (every pred (cdr lst))))) 209 | 210 | (defun any (pred lst) 211 | (and (consp lst) 212 | (or (funcall pred (car lst)) 213 | (any pred (cdr lst))))) 214 | 215 | 216 | (list-ref '(1 2 3 4) 1) 217 | (pow 234 0) 218 | (mapcar 'mycar '( (1 2) (3 4) (5 6))) 219 | (mapcar 'atom '(list 1 (2) foo t nil)) 220 | (every numberp '(1 2)) 221 | (assoc 'five '((one two) (three four) (five six) (seven eight))) 222 | 223 | (length '(0 1 2 3 4 5 6 7 8 9)) 224 | (any numberp '(a b)) 225 | -------------------------------------------------------------------------------- /plisp-gc/code/p14.lisp: -------------------------------------------------------------------------------- 1 | 2 | (defun nfibs (n) 3 | (if (< n 2) n 4 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 5 | ) 6 | ) 7 | 8 | (defun member (a lat) 9 | (cond ((null lat) nil) 10 | ((eq (car lat) a) t) 11 | (t (member a (cdr lat))) 12 | ) 13 | ) 14 | 15 | (defun rember (a lat) 16 | (cond ((null lat) ()) 17 | ((eq (car lat) a) (cdr lat)) 18 | (t (cons (car lat) (rember a (cdr lat)))) 19 | ) 20 | ) 21 | 22 | (defun eqn (n1 n2) 23 | (cond ((zerop n2) (zerop n1)) 24 | ((zerop n1) nil) 25 | (t (eqn (sub1 n1) (sub1 n2))) 26 | ) 27 | ) 28 | 29 | (defun multiins (old new lat) 30 | (cond ((null lat) ()) 31 | ((eq (car lat) old) (cons (car lat) 32 | (cons new (multiins old new (cdr lat))))) 33 | (t (cons (car lat) (multiins old new (cdr lat)))) 34 | ) 35 | ) 36 | 37 | (defun mapcar (fn x) 38 | (cond ((null x) nil) 39 | (t (cons (funcall fn (car x)) (mapcar fn (cdr x)))) 40 | ) 41 | ) 42 | 43 | (defun maplist (fn x) 44 | (cond ((null x) nil) 45 | (t (cons (funcall fn x) (maplist fn (cdr x)))) 46 | ) 47 | ) 48 | 49 | (defun map (f lst) 50 | (if (atom lst) lst 51 | (cons (f (car lst)) (map f (cdr lst))))) 52 | 53 | (defun mycar (x) (car x)) 54 | (defun mycdr (x) (cdr x)) 55 | 56 | (defun pow (n1 n2) 57 | (cond ((zerop n2) 1) 58 | (t (times n1 (pow n1 (sub1 n2)))) 59 | ) 60 | ) 61 | 62 | (defun double (n) (times n 2)) 63 | (defun square (n) (times n n)) 64 | (defun testfun (n) 65 | (funcall (cond ((greaterp n 100) 'double) 66 | (t 'square) ) 67 | n) 68 | ) 69 | 70 | (defun subst (old new lat) 71 | (cond ((null lat) ()) 72 | ((eq (car lat) old) (cons new (cdr lat))) 73 | (t (cons (car lat) (subst old new (cdr lat)))) 74 | ) 75 | ) 76 | 77 | (defun length (lat) 78 | (cond ((null lat) 0) 79 | (t (add1 (length (cdr lat)))) 80 | ) 81 | ) 82 | 83 | (defun intersect (set1 set2) 84 | (cond ((null set1) ()) 85 | ((member (car set1) set2) (cons (car set1) (intersect (cdr set1) set2))) 86 | (t (intersect (cdr set1) set2)) 87 | ) 88 | ) 89 | 90 | (defun factorial (n) 91 | (cond ((= n 1) 1) 92 | (t (* n (factorial (- n 1)))) 93 | ) 94 | ) 95 | 96 | (defun rem (x d) 97 | (- x (* (/ x d) d))) 98 | 99 | (defun is-even (x) 100 | (if (= 0 (rem x 2)) 101 | t 102 | nil)) 103 | 104 | (defun is-odd (x) 105 | (if (is-even x) 106 | nil 107 | t)) 108 | 109 | (defun is-divisible (x y) 110 | (if (= y 1) 111 | nil 112 | (if (>= y x) 113 | nil 114 | (if (= 0 (rem x y)) 115 | t 116 | nil)))) 117 | 118 | (defun is-prime (x) 119 | (if (is-even x) 120 | nil 121 | (is-prime-rec x 1))) 122 | 123 | (defun is-prime-rec 124 | (x y) 125 | (if (is-divisible x y) 126 | nil 127 | (if (>= y x) 128 | t 129 | (is-prime-rec x (+ 2 y))))) 130 | 131 | (defun gcd (x y) 132 | (cond 133 | ((= y 0) x) 134 | (t (gcd y (rem x y))))) 135 | 136 | (defun lcm (x y) 137 | (/ (abs (* x y)) (gcd x y))) 138 | 139 | (defun nth (lis n) 140 | (if (= n 0) 141 | (car lis) 142 | (nth (cdr lis) (- n 1)) 143 | ) 144 | ) 145 | 146 | (defun nthcdr (lst n) 147 | (if (<= n 0) lst 148 | (nthcdr (cdr lst) (- n 1)))) 149 | 150 | (defun list-ref (lst n) 151 | (car (nthcdr lst n))) 152 | 153 | (defun filter (pred lst) 154 | (cond ((null lst) ()) 155 | ((not (pred (car lst))) (filter pred (cdr lst))) 156 | (t (cons (car lst) (filter pred (cdr lst)))))) 157 | 158 | (defun caar (x) (car (car x))) 159 | 160 | (defun assoc (item lst) 161 | (cond ((atom lst) ()) 162 | ((eq (caar lst) item) (car lst)) 163 | (t (assoc item (cdr lst))))) 164 | 165 | (defun sum-to-n (n) 166 | (cond 167 | ((< n 0) 0) 168 | (t (+ n (sum-to-n (- n 1)))))) 169 | 170 | (defun gauss (n) 171 | (/ (* n (+ n 1)) 2)) 172 | 173 | (defun abs (x) (if (< x 0) (- 0 x) x)) 174 | 175 | (defun reverse- (zero lst) 176 | (if (null lst) zero 177 | (reverse- (cons (car lst) zero) (cdr lst)))) 178 | 179 | (defun reverse (lst) (reverse- () lst)) 180 | 181 | (defun last (l) 182 | (cond ((atom l) l) 183 | ((atom (cdr l)) l) 184 | (t (last (cdr l))))) 185 | 186 | (defun foldr (f zero lst) 187 | (if (null lst) zero 188 | (f (car lst) (foldr f zero (cdr lst))))) 189 | 190 | (defun foldl (f zero lst) 191 | (if (null lst) zero 192 | (foldl f (f (car lst) zero) (cdr lst)))) 193 | 194 | (defun reverse2 (lst) (foldl cons nil lst)) 195 | 196 | (defun append (a b) (foldr cons b a)) 197 | 198 | (defun identity (x) x) 199 | (defun copy-list (l) (map identity l)) 200 | (defun copy-tree (l) 201 | (if (atom l) l 202 | (cons (copy-tree (car l)) 203 | (copy-tree (cdr l))))) 204 | 205 | (defun every (pred lst) 206 | (or (atom lst) 207 | (and (funcall pred (car lst)) 208 | (every pred (cdr lst))))) 209 | 210 | (defun any (pred lst) 211 | (and (consp lst) 212 | (or (funcall pred (car lst)) 213 | (any pred (cdr lst))))) 214 | 215 | (mapcar 'is-prime (3 5 7 11 13 17 19 23 29 31 37 41 43 47)) 216 | (reverse2 '(1 2 3 4 5 6 7 8 9)) 217 | (testfun 13) 218 | (filter numberp '(1 2 3 a b c 4 5 6)) 219 | (gauss 100) 220 | (copy-tree '((a b c d) (e f g) h i j)) 221 | (testfun 101) 222 | (sum-to-n 100) 223 | (pow 234 0) 224 | (mapcar 'mycar '( (1 2) (3 4) (5 6))) 225 | -------------------------------------------------------------------------------- /plisp-gc/code/p2.lisp: -------------------------------------------------------------------------------- 1 | 2 | (defun nfibs (n) 3 | (if (< n 2) n 4 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 5 | ) 6 | ) 7 | 8 | (defun member (a lat) 9 | (cond ((null lat) nil) 10 | ((eq (car lat) a) t) 11 | (t (member a (cdr lat))) 12 | ) 13 | ) 14 | 15 | (defun rember (a lat) 16 | (cond ((null lat) ()) 17 | ((eq (car lat) a) (cdr lat)) 18 | (t (cons (car lat) (rember a (cdr lat)))) 19 | ) 20 | ) 21 | 22 | (defun eqn (n1 n2) 23 | (cond ((zerop n2) (zerop n1)) 24 | ((zerop n1) nil) 25 | (t (eqn (sub1 n1) (sub1 n2))) 26 | ) 27 | ) 28 | 29 | (defun multiins (old new lat) 30 | (cond ((null lat) ()) 31 | ((eq (car lat) old) (cons (car lat) 32 | (cons new (multiins old new (cdr lat))))) 33 | (t (cons (car lat) (multiins old new (cdr lat)))) 34 | ) 35 | ) 36 | 37 | (defun mapcar (fn x) 38 | (cond ((null x) nil) 39 | (t (cons (funcall fn (car x)) (mapcar fn (cdr x)))) 40 | ) 41 | ) 42 | 43 | (defun maplist (fn x) 44 | (cond ((null x) nil) 45 | (t (cons (funcall fn x) (maplist fn (cdr x)))) 46 | ) 47 | ) 48 | 49 | (defun map (f lst) 50 | (if (atom lst) lst 51 | (cons (f (car lst)) (map f (cdr lst))))) 52 | 53 | (defun mycar (x) (car x)) 54 | (defun mycdr (x) (cdr x)) 55 | 56 | (defun pow (n1 n2) 57 | (cond ((zerop n2) 1) 58 | (t (times n1 (pow n1 (sub1 n2)))) 59 | ) 60 | ) 61 | 62 | (defun double (n) (times n 2)) 63 | (defun square (n) (times n n)) 64 | (defun testfun (n) 65 | (funcall (cond ((greaterp n 100) 'double) 66 | (t 'square) ) 67 | n) 68 | ) 69 | 70 | (defun subst (old new lat) 71 | (cond ((null lat) ()) 72 | ((eq (car lat) old) (cons new (cdr lat))) 73 | (t (cons (car lat) (subst old new (cdr lat)))) 74 | ) 75 | ) 76 | 77 | (defun length (lat) 78 | (cond ((null lat) 0) 79 | (t (add1 (length (cdr lat)))) 80 | ) 81 | ) 82 | 83 | (defun intersect (set1 set2) 84 | (cond ((null set1) ()) 85 | ((member (car set1) set2) (cons (car set1) (intersect (cdr set1) set2))) 86 | (t (intersect (cdr set1) set2)) 87 | ) 88 | ) 89 | 90 | (defun factorial (n) 91 | (cond ((= n 1) 1) 92 | (t (* n (factorial (- n 1)))) 93 | ) 94 | ) 95 | 96 | (defun rem (x d) 97 | (- x (* (/ x d) d))) 98 | 99 | (defun is-even (x) 100 | (if (= 0 (rem x 2)) 101 | t 102 | nil)) 103 | 104 | (defun is-odd (x) 105 | (if (is-even x) 106 | nil 107 | t)) 108 | 109 | (defun is-divisible (x y) 110 | (if (= y 1) 111 | nil 112 | (if (>= y x) 113 | nil 114 | (if (= 0 (rem x y)) 115 | t 116 | nil)))) 117 | 118 | (defun is-prime (x) 119 | (if (is-even x) 120 | nil 121 | (is-prime-rec x 1))) 122 | 123 | (defun is-prime-rec 124 | (x y) 125 | (if (is-divisible x y) 126 | nil 127 | (if (>= y x) 128 | t 129 | (is-prime-rec x (+ 2 y))))) 130 | 131 | (defun gcd (x y) 132 | (cond 133 | ((= y 0) x) 134 | (t (gcd y (rem x y))))) 135 | 136 | (defun lcm (x y) 137 | (/ (abs (* x y)) (gcd x y))) 138 | 139 | (defun nth (lis n) 140 | (if (= n 0) 141 | (car lis) 142 | (nth (cdr lis) (- n 1)) 143 | ) 144 | ) 145 | 146 | (defun nthcdr (lst n) 147 | (if (<= n 0) lst 148 | (nthcdr (cdr lst) (- n 1)))) 149 | 150 | (defun list-ref (lst n) 151 | (car (nthcdr lst n))) 152 | 153 | (defun filter (pred lst) 154 | (cond ((null lst) ()) 155 | ((not (pred (car lst))) (filter pred (cdr lst))) 156 | (t (cons (car lst) (filter pred (cdr lst)))))) 157 | 158 | (defun caar (x) (car (car x))) 159 | 160 | (defun assoc (item lst) 161 | (cond ((atom lst) ()) 162 | ((eq (caar lst) item) (car lst)) 163 | (t (assoc item (cdr lst))))) 164 | 165 | (defun sum-to-n (n) 166 | (cond 167 | ((< n 0) 0) 168 | (t (+ n (sum-to-n (- n 1)))))) 169 | 170 | (defun gauss (n) 171 | (/ (* n (+ n 1)) 2)) 172 | 173 | (defun abs (x) (if (< x 0) (- 0 x) x)) 174 | 175 | (defun reverse- (zero lst) 176 | (if (null lst) zero 177 | (reverse- (cons (car lst) zero) (cdr lst)))) 178 | 179 | (defun reverse (lst) (reverse- () lst)) 180 | 181 | (defun last (l) 182 | (cond ((atom l) l) 183 | ((atom (cdr l)) l) 184 | (t (last (cdr l))))) 185 | 186 | (defun foldr (f zero lst) 187 | (if (null lst) zero 188 | (f (car lst) (foldr f zero (cdr lst))))) 189 | 190 | (defun foldl (f zero lst) 191 | (if (null lst) zero 192 | (foldl f (f (car lst) zero) (cdr lst)))) 193 | 194 | (defun reverse2 (lst) (foldl cons nil lst)) 195 | 196 | (defun append (a b) (foldr cons b a)) 197 | 198 | (defun identity (x) x) 199 | (defun copy-list (l) (map identity l)) 200 | (defun copy-tree (l) 201 | (if (atom l) l 202 | (cons (copy-tree (car l)) 203 | (copy-tree (cdr l))))) 204 | 205 | (defun every (pred lst) 206 | (or (atom lst) 207 | (and (funcall pred (car lst)) 208 | (every pred (cdr lst))))) 209 | 210 | (defun any (pred lst) 211 | (and (consp lst) 212 | (or (funcall pred (car lst)) 213 | (any pred (cdr lst))))) 214 | 215 | (pow 234 0) 216 | 217 | (every numberp '(1 2)) 218 | (every numberp '(1 a)) 219 | (reverse '(1 2 3 4 5 6 7)) 220 | (rember 'me '(please remove me)) 221 | (append '(1 2 3 4) '(5 6 7 8 9)) 222 | (nthcdr '(1 2 3 4 5) 2) 223 | (intersect '(a b c d e f) '(d e f)) 224 | (last '(1 2 3 4)) 225 | -------------------------------------------------------------------------------- /plisp-gc/code/p3.lisp: -------------------------------------------------------------------------------- 1 | 2 | (defun nfibs (n) 3 | (if (< n 2) n 4 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 5 | ) 6 | ) 7 | 8 | (defun member (a lat) 9 | (cond ((null lat) nil) 10 | ((eq (car lat) a) t) 11 | (t (member a (cdr lat))) 12 | ) 13 | ) 14 | 15 | (defun rember (a lat) 16 | (cond ((null lat) ()) 17 | ((eq (car lat) a) (cdr lat)) 18 | (t (cons (car lat) (rember a (cdr lat)))) 19 | ) 20 | ) 21 | 22 | (defun eqn (n1 n2) 23 | (cond ((zerop n2) (zerop n1)) 24 | ((zerop n1) nil) 25 | (t (eqn (sub1 n1) (sub1 n2))) 26 | ) 27 | ) 28 | 29 | (defun multiins (old new lat) 30 | (cond ((null lat) ()) 31 | ((eq (car lat) old) (cons (car lat) 32 | (cons new (multiins old new (cdr lat))))) 33 | (t (cons (car lat) (multiins old new (cdr lat)))) 34 | ) 35 | ) 36 | 37 | (defun mapcar (fn x) 38 | (cond ((null x) nil) 39 | (t (cons (funcall fn (car x)) (mapcar fn (cdr x)))) 40 | ) 41 | ) 42 | 43 | (defun maplist (fn x) 44 | (cond ((null x) nil) 45 | (t (cons (funcall fn x) (maplist fn (cdr x)))) 46 | ) 47 | ) 48 | 49 | (defun map (f lst) 50 | (if (atom lst) lst 51 | (cons (f (car lst)) (map f (cdr lst))))) 52 | 53 | (defun mycar (x) (car x)) 54 | (defun mycdr (x) (cdr x)) 55 | 56 | (defun pow (n1 n2) 57 | (cond ((zerop n2) 1) 58 | (t (times n1 (pow n1 (sub1 n2)))) 59 | ) 60 | ) 61 | 62 | (defun double (n) (times n 2)) 63 | (defun square (n) (times n n)) 64 | (defun testfun (n) 65 | (funcall (cond ((greaterp n 100) 'double) 66 | (t 'square) ) 67 | n) 68 | ) 69 | 70 | (defun subst (old new lat) 71 | (cond ((null lat) ()) 72 | ((eq (car lat) old) (cons new (cdr lat))) 73 | (t (cons (car lat) (subst old new (cdr lat)))) 74 | ) 75 | ) 76 | 77 | (defun length (lat) 78 | (cond ((null lat) 0) 79 | (t (add1 (length (cdr lat)))) 80 | ) 81 | ) 82 | 83 | (defun intersect (set1 set2) 84 | (cond ((null set1) ()) 85 | ((member (car set1) set2) (cons (car set1) (intersect (cdr set1) set2))) 86 | (t (intersect (cdr set1) set2)) 87 | ) 88 | ) 89 | 90 | (defun factorial (n) 91 | (cond ((= n 1) 1) 92 | (t (* n (factorial (- n 1)))) 93 | ) 94 | ) 95 | 96 | (defun rem (x d) 97 | (- x (* (/ x d) d))) 98 | 99 | (defun is-even (x) 100 | (if (= 0 (rem x 2)) 101 | t 102 | nil)) 103 | 104 | (defun is-odd (x) 105 | (if (is-even x) 106 | nil 107 | t)) 108 | 109 | (defun is-divisible (x y) 110 | (if (= y 1) 111 | nil 112 | (if (>= y x) 113 | nil 114 | (if (= 0 (rem x y)) 115 | t 116 | nil)))) 117 | 118 | (defun is-prime (x) 119 | (if (is-even x) 120 | nil 121 | (is-prime-rec x 1))) 122 | 123 | (defun is-prime-rec 124 | (x y) 125 | (if (is-divisible x y) 126 | nil 127 | (if (>= y x) 128 | t 129 | (is-prime-rec x (+ 2 y))))) 130 | 131 | (defun gcd (x y) 132 | (cond 133 | ((= y 0) x) 134 | (t (gcd y (rem x y))))) 135 | 136 | (defun lcm (x y) 137 | (/ (abs (* x y)) (gcd x y))) 138 | 139 | (defun nth (lis n) 140 | (if (= n 0) 141 | (car lis) 142 | (nth (cdr lis) (- n 1)) 143 | ) 144 | ) 145 | 146 | (defun nthcdr (lst n) 147 | (if (<= n 0) lst 148 | (nthcdr (cdr lst) (- n 1)))) 149 | 150 | (defun list-ref (lst n) 151 | (car (nthcdr lst n))) 152 | 153 | (defun filter (pred lst) 154 | (cond ((null lst) ()) 155 | ((not (pred (car lst))) (filter pred (cdr lst))) 156 | (t (cons (car lst) (filter pred (cdr lst)))))) 157 | 158 | (defun caar (x) (car (car x))) 159 | 160 | (defun assoc (item lst) 161 | (cond ((atom lst) ()) 162 | ((eq (caar lst) item) (car lst)) 163 | (t (assoc item (cdr lst))))) 164 | 165 | (defun sum-to-n (n) 166 | (cond 167 | ((< n 0) 0) 168 | (t (+ n (sum-to-n (- n 1)))))) 169 | 170 | (defun gauss (n) 171 | (/ (* n (+ n 1)) 2)) 172 | 173 | (defun abs (x) (if (< x 0) (- 0 x) x)) 174 | 175 | (defun reverse- (zero lst) 176 | (if (null lst) zero 177 | (reverse- (cons (car lst) zero) (cdr lst)))) 178 | 179 | (defun reverse (lst) (reverse- () lst)) 180 | 181 | (defun last (l) 182 | (cond ((atom l) l) 183 | ((atom (cdr l)) l) 184 | (t (last (cdr l))))) 185 | 186 | (defun foldr (f zero lst) 187 | (if (null lst) zero 188 | (f (car lst) (foldr f zero (cdr lst))))) 189 | 190 | (defun foldl (f zero lst) 191 | (if (null lst) zero 192 | (foldl f (f (car lst) zero) (cdr lst)))) 193 | 194 | (defun reverse2 (lst) (foldl cons nil lst)) 195 | 196 | (defun append (a b) (foldr cons b a)) 197 | 198 | (defun identity (x) x) 199 | (defun copy-list (l) (map identity l)) 200 | (defun copy-tree (l) 201 | (if (atom l) l 202 | (cons (copy-tree (car l)) 203 | (copy-tree (cdr l))))) 204 | 205 | (defun every (pred lst) 206 | (or (atom lst) 207 | (and (funcall pred (car lst)) 208 | (every pred (cdr lst))))) 209 | 210 | (defun any (pred lst) 211 | (and (consp lst) 212 | (or (funcall pred (car lst)) 213 | (any pred (cdr lst))))) 214 | 215 | (gauss 100) 216 | (last '(1 2 3 4)) 217 | (nfibs 10) 218 | (reverse2 '(1 2 3 4 5 6 7 8 9)) 219 | (any numberp '(a b)) 220 | (mapcar 'mycar '( (1 2) (3 4) (5 6))) 221 | (list-ref '(1 2 3 4) 1) 222 | (mapcar 'is-prime (3 5 7 11 13 17 19 23 29 31 37 41 43 47)) 223 | (testfun 101) 224 | (intersect '(a b c d e f) '(d e f)) 225 | -------------------------------------------------------------------------------- /plisp-gc/code/p4.lisp: -------------------------------------------------------------------------------- 1 | 2 | (defun nfibs (n) 3 | (if (< n 2) n 4 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 5 | ) 6 | ) 7 | 8 | (defun member (a lat) 9 | (cond ((null lat) nil) 10 | ((eq (car lat) a) t) 11 | (t (member a (cdr lat))) 12 | ) 13 | ) 14 | 15 | (defun rember (a lat) 16 | (cond ((null lat) ()) 17 | ((eq (car lat) a) (cdr lat)) 18 | (t (cons (car lat) (rember a (cdr lat)))) 19 | ) 20 | ) 21 | 22 | (defun eqn (n1 n2) 23 | (cond ((zerop n2) (zerop n1)) 24 | ((zerop n1) nil) 25 | (t (eqn (sub1 n1) (sub1 n2))) 26 | ) 27 | ) 28 | 29 | (defun multiins (old new lat) 30 | (cond ((null lat) ()) 31 | ((eq (car lat) old) (cons (car lat) 32 | (cons new (multiins old new (cdr lat))))) 33 | (t (cons (car lat) (multiins old new (cdr lat)))) 34 | ) 35 | ) 36 | 37 | (defun mapcar (fn x) 38 | (cond ((null x) nil) 39 | (t (cons (funcall fn (car x)) (mapcar fn (cdr x)))) 40 | ) 41 | ) 42 | 43 | (defun maplist (fn x) 44 | (cond ((null x) nil) 45 | (t (cons (funcall fn x) (maplist fn (cdr x)))) 46 | ) 47 | ) 48 | 49 | (defun map (f lst) 50 | (if (atom lst) lst 51 | (cons (f (car lst)) (map f (cdr lst))))) 52 | 53 | (defun mycar (x) (car x)) 54 | (defun mycdr (x) (cdr x)) 55 | 56 | (defun pow (n1 n2) 57 | (cond ((zerop n2) 1) 58 | (t (times n1 (pow n1 (sub1 n2)))) 59 | ) 60 | ) 61 | 62 | (defun double (n) (times n 2)) 63 | (defun square (n) (times n n)) 64 | (defun testfun (n) 65 | (funcall (cond ((greaterp n 100) 'double) 66 | (t 'square) ) 67 | n) 68 | ) 69 | 70 | (defun subst (old new lat) 71 | (cond ((null lat) ()) 72 | ((eq (car lat) old) (cons new (cdr lat))) 73 | (t (cons (car lat) (subst old new (cdr lat)))) 74 | ) 75 | ) 76 | 77 | (defun length (lat) 78 | (cond ((null lat) 0) 79 | (t (add1 (length (cdr lat)))) 80 | ) 81 | ) 82 | 83 | (defun intersect (set1 set2) 84 | (cond ((null set1) ()) 85 | ((member (car set1) set2) (cons (car set1) (intersect (cdr set1) set2))) 86 | (t (intersect (cdr set1) set2)) 87 | ) 88 | ) 89 | 90 | (defun factorial (n) 91 | (cond ((= n 1) 1) 92 | (t (* n (factorial (- n 1)))) 93 | ) 94 | ) 95 | 96 | (defun rem (x d) 97 | (- x (* (/ x d) d))) 98 | 99 | (defun is-even (x) 100 | (if (= 0 (rem x 2)) 101 | t 102 | nil)) 103 | 104 | (defun is-odd (x) 105 | (if (is-even x) 106 | nil 107 | t)) 108 | 109 | (defun is-divisible (x y) 110 | (if (= y 1) 111 | nil 112 | (if (>= y x) 113 | nil 114 | (if (= 0 (rem x y)) 115 | t 116 | nil)))) 117 | 118 | (defun is-prime (x) 119 | (if (is-even x) 120 | nil 121 | (is-prime-rec x 1))) 122 | 123 | (defun is-prime-rec 124 | (x y) 125 | (if (is-divisible x y) 126 | nil 127 | (if (>= y x) 128 | t 129 | (is-prime-rec x (+ 2 y))))) 130 | 131 | (defun gcd (x y) 132 | (cond 133 | ((= y 0) x) 134 | (t (gcd y (rem x y))))) 135 | 136 | (defun lcm (x y) 137 | (/ (abs (* x y)) (gcd x y))) 138 | 139 | (defun nth (lis n) 140 | (if (= n 0) 141 | (car lis) 142 | (nth (cdr lis) (- n 1)) 143 | ) 144 | ) 145 | 146 | (defun nthcdr (lst n) 147 | (if (<= n 0) lst 148 | (nthcdr (cdr lst) (- n 1)))) 149 | 150 | (defun list-ref (lst n) 151 | (car (nthcdr lst n))) 152 | 153 | (defun filter (pred lst) 154 | (cond ((null lst) ()) 155 | ((not (pred (car lst))) (filter pred (cdr lst))) 156 | (t (cons (car lst) (filter pred (cdr lst)))))) 157 | 158 | (defun caar (x) (car (car x))) 159 | 160 | (defun assoc (item lst) 161 | (cond ((atom lst) ()) 162 | ((eq (caar lst) item) (car lst)) 163 | (t (assoc item (cdr lst))))) 164 | 165 | (defun sum-to-n (n) 166 | (cond 167 | ((< n 0) 0) 168 | (t (+ n (sum-to-n (- n 1)))))) 169 | 170 | (defun gauss (n) 171 | (/ (* n (+ n 1)) 2)) 172 | 173 | (defun abs (x) (if (< x 0) (- 0 x) x)) 174 | 175 | (defun reverse- (zero lst) 176 | (if (null lst) zero 177 | (reverse- (cons (car lst) zero) (cdr lst)))) 178 | 179 | (defun reverse (lst) (reverse- () lst)) 180 | 181 | (defun last (l) 182 | (cond ((atom l) l) 183 | ((atom (cdr l)) l) 184 | (t (last (cdr l))))) 185 | 186 | (defun foldr (f zero lst) 187 | (if (null lst) zero 188 | (f (car lst) (foldr f zero (cdr lst))))) 189 | 190 | (defun foldl (f zero lst) 191 | (if (null lst) zero 192 | (foldl f (f (car lst) zero) (cdr lst)))) 193 | 194 | (defun reverse2 (lst) (foldl cons nil lst)) 195 | 196 | (defun append (a b) (foldr cons b a)) 197 | 198 | (defun identity (x) x) 199 | (defun copy-list (l) (map identity l)) 200 | (defun copy-tree (l) 201 | (if (atom l) l 202 | (cons (copy-tree (car l)) 203 | (copy-tree (cdr l))))) 204 | 205 | (defun every (pred lst) 206 | (or (atom lst) 207 | (and (funcall pred (car lst)) 208 | (every pred (cdr lst))))) 209 | 210 | (defun any (pred lst) 211 | (and (consp lst) 212 | (or (funcall pred (car lst)) 213 | (any pred (cdr lst))))) 214 | 215 | (length '(0 1 2 3 4 5 6 7 8 9)) 216 | (reverse '(1 2 3 4 5 6 7 8 9)) 217 | (pow 234 0) 218 | (intersect '(a b c d e f) '(d e f)) 219 | (sum-to-n 100) 220 | (reverse '(1 2 3 4 5 6 7)) 221 | (mapcar 'mycar '( (1 2) (3 4) (5 6))) 222 | (assoc 'five '((one two) (three four) (five six) (seven eight))) 223 | 224 | (nth '(1 2 3 4 5) 1) 225 | -------------------------------------------------------------------------------- /plisp-gc/code/p6.lisp: -------------------------------------------------------------------------------- 1 | 2 | (defun nfibs (n) 3 | (if (< n 2) n 4 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 5 | ) 6 | ) 7 | 8 | (defun member (a lat) 9 | (cond ((null lat) nil) 10 | ((eq (car lat) a) t) 11 | (t (member a (cdr lat))) 12 | ) 13 | ) 14 | 15 | (defun rember (a lat) 16 | (cond ((null lat) ()) 17 | ((eq (car lat) a) (cdr lat)) 18 | (t (cons (car lat) (rember a (cdr lat)))) 19 | ) 20 | ) 21 | 22 | (defun eqn (n1 n2) 23 | (cond ((zerop n2) (zerop n1)) 24 | ((zerop n1) nil) 25 | (t (eqn (sub1 n1) (sub1 n2))) 26 | ) 27 | ) 28 | 29 | (defun multiins (old new lat) 30 | (cond ((null lat) ()) 31 | ((eq (car lat) old) (cons (car lat) 32 | (cons new (multiins old new (cdr lat))))) 33 | (t (cons (car lat) (multiins old new (cdr lat)))) 34 | ) 35 | ) 36 | 37 | (defun mapcar (fn x) 38 | (cond ((null x) nil) 39 | (t (cons (funcall fn (car x)) (mapcar fn (cdr x)))) 40 | ) 41 | ) 42 | 43 | (defun maplist (fn x) 44 | (cond ((null x) nil) 45 | (t (cons (funcall fn x) (maplist fn (cdr x)))) 46 | ) 47 | ) 48 | 49 | (defun map (f lst) 50 | (if (atom lst) lst 51 | (cons (f (car lst)) (map f (cdr lst))))) 52 | 53 | (defun mycar (x) (car x)) 54 | (defun mycdr (x) (cdr x)) 55 | 56 | (defun pow (n1 n2) 57 | (cond ((zerop n2) 1) 58 | (t (times n1 (pow n1 (sub1 n2)))) 59 | ) 60 | ) 61 | 62 | (defun double (n) (times n 2)) 63 | (defun square (n) (times n n)) 64 | (defun testfun (n) 65 | (funcall (cond ((greaterp n 100) 'double) 66 | (t 'square) ) 67 | n) 68 | ) 69 | 70 | (defun subst (old new lat) 71 | (cond ((null lat) ()) 72 | ((eq (car lat) old) (cons new (cdr lat))) 73 | (t (cons (car lat) (subst old new (cdr lat)))) 74 | ) 75 | ) 76 | 77 | (defun length (lat) 78 | (cond ((null lat) 0) 79 | (t (add1 (length (cdr lat)))) 80 | ) 81 | ) 82 | 83 | (defun intersect (set1 set2) 84 | (cond ((null set1) ()) 85 | ((member (car set1) set2) (cons (car set1) (intersect (cdr set1) set2))) 86 | (t (intersect (cdr set1) set2)) 87 | ) 88 | ) 89 | 90 | (defun factorial (n) 91 | (cond ((= n 1) 1) 92 | (t (* n (factorial (- n 1)))) 93 | ) 94 | ) 95 | 96 | (defun rem (x d) 97 | (- x (* (/ x d) d))) 98 | 99 | (defun is-even (x) 100 | (if (= 0 (rem x 2)) 101 | t 102 | nil)) 103 | 104 | (defun is-odd (x) 105 | (if (is-even x) 106 | nil 107 | t)) 108 | 109 | (defun is-divisible (x y) 110 | (if (= y 1) 111 | nil 112 | (if (>= y x) 113 | nil 114 | (if (= 0 (rem x y)) 115 | t 116 | nil)))) 117 | 118 | (defun is-prime (x) 119 | (if (is-even x) 120 | nil 121 | (is-prime-rec x 1))) 122 | 123 | (defun is-prime-rec 124 | (x y) 125 | (if (is-divisible x y) 126 | nil 127 | (if (>= y x) 128 | t 129 | (is-prime-rec x (+ 2 y))))) 130 | 131 | (defun gcd (x y) 132 | (cond 133 | ((= y 0) x) 134 | (t (gcd y (rem x y))))) 135 | 136 | (defun lcm (x y) 137 | (/ (abs (* x y)) (gcd x y))) 138 | 139 | (defun nth (lis n) 140 | (if (= n 0) 141 | (car lis) 142 | (nth (cdr lis) (- n 1)) 143 | ) 144 | ) 145 | 146 | (defun nthcdr (lst n) 147 | (if (<= n 0) lst 148 | (nthcdr (cdr lst) (- n 1)))) 149 | 150 | (defun list-ref (lst n) 151 | (car (nthcdr lst n))) 152 | 153 | (defun filter (pred lst) 154 | (cond ((null lst) ()) 155 | ((not (pred (car lst))) (filter pred (cdr lst))) 156 | (t (cons (car lst) (filter pred (cdr lst)))))) 157 | 158 | (defun caar (x) (car (car x))) 159 | 160 | (defun assoc (item lst) 161 | (cond ((atom lst) ()) 162 | ((eq (caar lst) item) (car lst)) 163 | (t (assoc item (cdr lst))))) 164 | 165 | (defun sum-to-n (n) 166 | (cond 167 | ((< n 0) 0) 168 | (t (+ n (sum-to-n (- n 1)))))) 169 | 170 | (defun gauss (n) 171 | (/ (* n (+ n 1)) 2)) 172 | 173 | (defun abs (x) (if (< x 0) (- 0 x) x)) 174 | 175 | (defun reverse- (zero lst) 176 | (if (null lst) zero 177 | (reverse- (cons (car lst) zero) (cdr lst)))) 178 | 179 | (defun reverse (lst) (reverse- () lst)) 180 | 181 | (defun last (l) 182 | (cond ((atom l) l) 183 | ((atom (cdr l)) l) 184 | (t (last (cdr l))))) 185 | 186 | (defun foldr (f zero lst) 187 | (if (null lst) zero 188 | (f (car lst) (foldr f zero (cdr lst))))) 189 | 190 | (defun foldl (f zero lst) 191 | (if (null lst) zero 192 | (foldl f (f (car lst) zero) (cdr lst)))) 193 | 194 | (defun reverse2 (lst) (foldl cons nil lst)) 195 | 196 | (defun append (a b) (foldr cons b a)) 197 | 198 | (defun identity (x) x) 199 | (defun copy-list (l) (map identity l)) 200 | (defun copy-tree (l) 201 | (if (atom l) l 202 | (cons (copy-tree (car l)) 203 | (copy-tree (cdr l))))) 204 | 205 | (defun every (pred lst) 206 | (or (atom lst) 207 | (and (funcall pred (car lst)) 208 | (every pred (cdr lst))))) 209 | 210 | (defun any (pred lst) 211 | (and (consp lst) 212 | (or (funcall pred (car lst)) 213 | (any pred (cdr lst))))) 214 | 215 | (any numberp '(1 a)) 216 | (nfibs 10) 217 | (rember 'me '(please remove me)) 218 | (append '(1 2 3 4) '(5 6 7 8 9)) 219 | (gauss 100) 220 | (subst 'me 'you '(a list with me)) 221 | (testfun 13) 222 | (mapcar 'mycar '( (1 2) (3 4) (5 6))) 223 | (pow 234 0) 224 | (every numberp '(1 a)) 225 | -------------------------------------------------------------------------------- /plisp-gc/code/p9.lisp: -------------------------------------------------------------------------------- 1 | 2 | (defun nfibs (n) 3 | (if (< n 2) n 4 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 5 | ) 6 | ) 7 | 8 | (defun member (a lat) 9 | (cond ((null lat) nil) 10 | ((eq (car lat) a) t) 11 | (t (member a (cdr lat))) 12 | ) 13 | ) 14 | 15 | (defun rember (a lat) 16 | (cond ((null lat) ()) 17 | ((eq (car lat) a) (cdr lat)) 18 | (t (cons (car lat) (rember a (cdr lat)))) 19 | ) 20 | ) 21 | 22 | (defun eqn (n1 n2) 23 | (cond ((zerop n2) (zerop n1)) 24 | ((zerop n1) nil) 25 | (t (eqn (sub1 n1) (sub1 n2))) 26 | ) 27 | ) 28 | 29 | (defun multiins (old new lat) 30 | (cond ((null lat) ()) 31 | ((eq (car lat) old) (cons (car lat) 32 | (cons new (multiins old new (cdr lat))))) 33 | (t (cons (car lat) (multiins old new (cdr lat)))) 34 | ) 35 | ) 36 | 37 | (defun mapcar (fn x) 38 | (cond ((null x) nil) 39 | (t (cons (funcall fn (car x)) (mapcar fn (cdr x)))) 40 | ) 41 | ) 42 | 43 | (defun maplist (fn x) 44 | (cond ((null x) nil) 45 | (t (cons (funcall fn x) (maplist fn (cdr x)))) 46 | ) 47 | ) 48 | 49 | (defun map (f lst) 50 | (if (atom lst) lst 51 | (cons (f (car lst)) (map f (cdr lst))))) 52 | 53 | (defun mycar (x) (car x)) 54 | (defun mycdr (x) (cdr x)) 55 | 56 | (defun pow (n1 n2) 57 | (cond ((zerop n2) 1) 58 | (t (times n1 (pow n1 (sub1 n2)))) 59 | ) 60 | ) 61 | 62 | (defun double (n) (times n 2)) 63 | (defun square (n) (times n n)) 64 | (defun testfun (n) 65 | (funcall (cond ((greaterp n 100) 'double) 66 | (t 'square) ) 67 | n) 68 | ) 69 | 70 | (defun subst (old new lat) 71 | (cond ((null lat) ()) 72 | ((eq (car lat) old) (cons new (cdr lat))) 73 | (t (cons (car lat) (subst old new (cdr lat)))) 74 | ) 75 | ) 76 | 77 | (defun length (lat) 78 | (cond ((null lat) 0) 79 | (t (add1 (length (cdr lat)))) 80 | ) 81 | ) 82 | 83 | (defun intersect (set1 set2) 84 | (cond ((null set1) ()) 85 | ((member (car set1) set2) (cons (car set1) (intersect (cdr set1) set2))) 86 | (t (intersect (cdr set1) set2)) 87 | ) 88 | ) 89 | 90 | (defun factorial (n) 91 | (cond ((= n 1) 1) 92 | (t (* n (factorial (- n 1)))) 93 | ) 94 | ) 95 | 96 | (defun rem (x d) 97 | (- x (* (/ x d) d))) 98 | 99 | (defun is-even (x) 100 | (if (= 0 (rem x 2)) 101 | t 102 | nil)) 103 | 104 | (defun is-odd (x) 105 | (if (is-even x) 106 | nil 107 | t)) 108 | 109 | (defun is-divisible (x y) 110 | (if (= y 1) 111 | nil 112 | (if (>= y x) 113 | nil 114 | (if (= 0 (rem x y)) 115 | t 116 | nil)))) 117 | 118 | (defun is-prime (x) 119 | (if (is-even x) 120 | nil 121 | (is-prime-rec x 1))) 122 | 123 | (defun is-prime-rec 124 | (x y) 125 | (if (is-divisible x y) 126 | nil 127 | (if (>= y x) 128 | t 129 | (is-prime-rec x (+ 2 y))))) 130 | 131 | (defun gcd (x y) 132 | (cond 133 | ((= y 0) x) 134 | (t (gcd y (rem x y))))) 135 | 136 | (defun lcm (x y) 137 | (/ (abs (* x y)) (gcd x y))) 138 | 139 | (defun nth (lis n) 140 | (if (= n 0) 141 | (car lis) 142 | (nth (cdr lis) (- n 1)) 143 | ) 144 | ) 145 | 146 | (defun nthcdr (lst n) 147 | (if (<= n 0) lst 148 | (nthcdr (cdr lst) (- n 1)))) 149 | 150 | (defun list-ref (lst n) 151 | (car (nthcdr lst n))) 152 | 153 | (defun filter (pred lst) 154 | (cond ((null lst) ()) 155 | ((not (pred (car lst))) (filter pred (cdr lst))) 156 | (t (cons (car lst) (filter pred (cdr lst)))))) 157 | 158 | (defun caar (x) (car (car x))) 159 | 160 | (defun assoc (item lst) 161 | (cond ((atom lst) ()) 162 | ((eq (caar lst) item) (car lst)) 163 | (t (assoc item (cdr lst))))) 164 | 165 | (defun sum-to-n (n) 166 | (cond 167 | ((< n 0) 0) 168 | (t (+ n (sum-to-n (- n 1)))))) 169 | 170 | (defun gauss (n) 171 | (/ (* n (+ n 1)) 2)) 172 | 173 | (defun abs (x) (if (< x 0) (- 0 x) x)) 174 | 175 | (defun reverse- (zero lst) 176 | (if (null lst) zero 177 | (reverse- (cons (car lst) zero) (cdr lst)))) 178 | 179 | (defun reverse (lst) (reverse- () lst)) 180 | 181 | (defun last (l) 182 | (cond ((atom l) l) 183 | ((atom (cdr l)) l) 184 | (t (last (cdr l))))) 185 | 186 | (defun foldr (f zero lst) 187 | (if (null lst) zero 188 | (f (car lst) (foldr f zero (cdr lst))))) 189 | 190 | (defun foldl (f zero lst) 191 | (if (null lst) zero 192 | (foldl f (f (car lst) zero) (cdr lst)))) 193 | 194 | (defun reverse2 (lst) (foldl cons nil lst)) 195 | 196 | (defun append (a b) (foldr cons b a)) 197 | 198 | (defun identity (x) x) 199 | (defun copy-list (l) (map identity l)) 200 | (defun copy-tree (l) 201 | (if (atom l) l 202 | (cons (copy-tree (car l)) 203 | (copy-tree (cdr l))))) 204 | 205 | (defun every (pred lst) 206 | (or (atom lst) 207 | (and (funcall pred (car lst)) 208 | (every pred (cdr lst))))) 209 | 210 | (defun any (pred lst) 211 | (and (consp lst) 212 | (or (funcall pred (car lst)) 213 | (any pred (cdr lst))))) 214 | 215 | 216 | (any numberp '(1 a)) 217 | (every numberp '(1 2)) 218 | (nfibs 10) 219 | (any numberp '(a b)) 220 | (list-ref '(1 2 3 4) 1) 221 | (testfun 13) 222 | (mapcar 'atom '(list 1 (2) foo t nil)) 223 | (multiins 'one 'two '(one three one three one three one three)) 224 | (rember 'me '(please remove me)) 225 | -------------------------------------------------------------------------------- /plisp-gc/defines.h: -------------------------------------------------------------------------------- 1 | #include "params.h" 2 | 3 | #define BUF_ADDRESS 0x8f000000 4 | 5 | #define is == 6 | #define isnt != 7 | #define not ! 8 | #define and && 9 | #define or || 10 | #define in , 11 | 12 | #define forlist(...) forlist_xp(forlist_in, (__VA_ARGS__)) 13 | #define forlist_in(X, S) for(node *X = S; X isnt NULLPTR; nextptr(X)) 14 | #define forlist_xp(X, A) X A 15 | 16 | #define forlist2(...) forlist_xp(forlist_in2, (__VA_ARGS__)) 17 | #define forlist_in2(X, S, XX, SS) for(node *X = S, *XX = SS; X isnt NULLPTR and XX isnt NULLPTR; nextptr(X), nextptr(XX)) 18 | 19 | #define forheap(...) forlist_xp(forheap_in, (__VA_ARGS__)) 20 | #define forheap_in(X, S) for(node *X = S; X isnt NULLPTR; X = next(X)) 21 | 22 | #define PERMANENT 2 23 | 24 | #define EOS '\0' 25 | #define EOSP(X) ((X) is EOS) 26 | #define nullp(X) ((X) is NULLPTR) 27 | 28 | #define ppval(X) (**(X)) 29 | #define ppdec(X) ((*(X))--) 30 | #define ppvalinc(X) (*(*(X))++) 31 | #define ppinc(X) (*(X))++ 32 | 33 | #define nextptr(X) ((X) = cdr(X)) 34 | #define rplaca(X,Y) ((X)->car = (Y)) 35 | #define rplacd(X,Y) ((X)->cdr = (Y)) 36 | 37 | #define next(X) ((X)->next) 38 | #define type(X) ((X)->type) 39 | #define funcname(X) ((X)->fname->s) 40 | #define funcptr(X) ((X)->fn) 41 | #define largs(X) ((X)->args) 42 | #define lbody(X) ((X)->body) 43 | #define ival(X) ((X)->i) 44 | #define ebindings(X) ((X)->bindings) 45 | 46 | #define consp(X) ((X) and (X)->type is LIST) 47 | #define pairp(X) ((X) and (X)->type is PAIR) 48 | #define symp(X) ((X) and (X)->type is SYM) 49 | #define subrp(X) ((X) and (X)->type is SUBR) 50 | #define fsubrp(X) ((X) and (X)->type is FSUBR) 51 | #define lambdap(X) ((X) and (X)->type is LAMBDA) 52 | #define intp(X) ((X) and (X)->type is INT) 53 | #define nilp(X) ((X) and (X)->type is NIL) 54 | #define teep(X) ((X) and (X)->type is TEE) 55 | 56 | #define car(X) ((X)->car) 57 | #define cdr(X) ((X)->cdr) 58 | #define caar(X) (car(car(X))) 59 | #define cadar(X) (car(cdr(car(X)))) 60 | -------------------------------------------------------------------------------- /plisp-gc/device_main.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include "defines.h" 6 | #include "structures.h" 7 | #define EXTERNAL extern 8 | #include "globals.h" 9 | #include "device_proto.h" 10 | 11 | int main(int argc, char *argv[]) { 12 | unsigned int row, col; 13 | char *input; 14 | 15 | // 16 | // get the core id 17 | // 18 | id = coreID(&row, &col); 19 | // 20 | // Initialize the core 21 | // 22 | input = coreInit(argc, argv, id); 23 | // 24 | // Read, Eval and Print 25 | // 26 | REPL(input); 27 | // 28 | // Print stats and exit 29 | // 30 | setflag("Exited normally!"); 31 | return 0; 32 | } 33 | -------------------------------------------------------------------------------- /plisp-gc/device_proto.h: -------------------------------------------------------------------------------- 1 | /* device_main.c */ 2 | int main(int argc, char *argv[]); 3 | /* libdevice.c */ 4 | char *readFile(char *fileName); 5 | void createFreelist(ememory *memory, int rows, int cols); 6 | void createStringFreelist(ememory *memory, int rows, int cols); 7 | void createNameFreelist(ememory *memory, int rows, int cols); 8 | int coreID(unsigned int *row, unsigned int *col); 9 | char *coreInit(int argc, char *argv[], int cid); 10 | void nl(void); 11 | void prpair(node *l); 12 | void print(node *l); 13 | void prGlobals(ememory *memory, int id); 14 | void setflag(char *message); 15 | /* libplisp.c */ 16 | void pr(node *cell); 17 | void addInt(long long i); 18 | void addString(char *s); 19 | void addValue(char *s, long long i); 20 | char *scpy(char *s1, const char *s2); 21 | long long stoi(const char *c); 22 | int slen(char *s); 23 | void saveGlobals(char *message); 24 | string *smalloc(void); 25 | string *string_malloc(void); 26 | void string_free(string *n); 27 | namestr *nmalloc(void); 28 | namestr *name_malloc(void); 29 | void name_free(namestr *n); 30 | node *omalloc(void); 31 | node *node_malloc(void); 32 | void node_free(node *n); 33 | void pushFree(stack *ptr, stack **stk); 34 | stack *popFree(stack **stk); 35 | void mark_expr(node *o, unsigned char persistence); 36 | void release_node(node *o); 37 | void free_unmarked(node **allocated); 38 | node *newnode(enum ltype type); 39 | node *sym(char *val); 40 | node *cons(node *head, node *tail); 41 | node *pair(node *head, node *tail); 42 | node *func(node *(*fn)(node *, node *), enum ltype type); 43 | node *lambda(node *args, node *sexp); 44 | node *integer(long long num); 45 | node *newcontext(node *bindings, node *top); 46 | void clear_bindings(node *env); 47 | node *lastcell(node *list); 48 | node *append(node *list, node *obj); 49 | node *concat(node *l1, node *l2); 50 | void atl(node **l, node *item); 51 | void add_pair(node *head, node *tail, node **list); 52 | void pushNode(node *item, node **stk); 53 | node *popNode(node **stk); 54 | node *nextarg(node **pargs); 55 | char *name(node *o); 56 | int strequal(char *s1, char *s2); 57 | node *assq(char *key, node *list); 58 | node *lookupsym(char *name, node *env); 59 | node *make_env(node *vars, node *vals, node *env); 60 | node *el_car(node *args, node *env); 61 | node *el_cdr(node *args, node *env); 62 | node *el_nilp(node *args, node *env); 63 | node *el_quote(node *args, node *env); 64 | node *el_cons(node *args, node *env); 65 | node *el_cond(node *args, node *env); 66 | node *el_if(node *args, node *env); 67 | node *el_lambda(node *args, node *env); 68 | node *el_label(node *args, node *env); 69 | node *el_ldefine(node *args, node *env); 70 | node *el_loop(node *args, node *env); 71 | node *el_block(node *args, node *env); 72 | node *el_progn(node *args, node *env); 73 | node *el_print(node *args, node *env); 74 | node *el_terpri(node *args, node *env); 75 | node *binary(node *args, int fcn); 76 | node *compare(node *args, int fcn); 77 | node *el_lessthan(node *args, node *env); 78 | node *el_greaterthan(node *args, node *env); 79 | node *el_eq(node *args, node *env); 80 | node *el_plus(node *args, node *env); 81 | node *el_minus(node *args, node *env); 82 | node *el_times(node *args, node *env); 83 | node *el_divide(node *args, node *env); 84 | node *el_atom(node *args, node *env); 85 | node *el_equal(node *args, node *env); 86 | node *el_lessthanequal(node *args, node *env); 87 | node *el_greaterthanequal(node *args, node *env); 88 | node *el_defun(node *args, node *env); 89 | node *el_consp(node *args, node *env); 90 | node *el_funcall(node *args, node *env); 91 | node *el_zerop(node *args, node *env); 92 | node *el_sub1(node *args, node *env); 93 | node *el_add1(node *args, node *env); 94 | node *el_numberp(node *args, node *env); 95 | node *el_or(node *args, node *env); 96 | node *el_and(node *args, node *env); 97 | node *el_not(node *args, node *env); 98 | node *el_setflag(node *args, node *env); 99 | node *el_id(node *args, node *env); 100 | node *el_setyc(node *args, node *env); 101 | node *el_unsetyc(node *args, node *env); 102 | node *init_lisp(void); 103 | int getChar(char **s); 104 | int ungetChar(char **s); 105 | char *getToken(char **s, char *token); 106 | node *tokenize(char **code); 107 | int equal(node *sym, char *s2); 108 | int is_valid_int(char *str); 109 | node *makeNode(node *n); 110 | node *_parse(node **code, char *terminator); 111 | node *parse(node **code); 112 | node *parse_string(char **input); 113 | int length(node *l); 114 | node *bind_variables(node *expr, node *env); 115 | node *evlambda(node *vals, node *expr, node *env); 116 | node *evform(node *fnode, node *exp, node *env); 117 | node *evsym(node *exp, node *env); 118 | node *eval_list(node *sexp, node *env); 119 | node *eval(node *input, node *env); 120 | void REPL(char *input); 121 | -------------------------------------------------------------------------------- /plisp-gc/globals.h: -------------------------------------------------------------------------------- 1 | EXTERNAL node *tee; 2 | EXTERNAL node *nil; 3 | EXTERNAL node *NULLPTR; 4 | EXTERNAL node *globals; 5 | EXTERNAL node *history; 6 | EXTERNAL node *freelist; 7 | EXTERNAL string *stringfreelist; 8 | EXTERNAL namestr *namefreelist; 9 | EXTERNAL node *allocated; 10 | 11 | EXTERNAL int nnodes; 12 | EXTERNAL int nodemem; 13 | EXTERNAL int nnames; 14 | EXTERNAL int namemem; 15 | EXTERNAL int nstrings; 16 | EXTERNAL int stringmem; 17 | 18 | EXTERNAL ememory *memory; 19 | EXTERNAL int id; 20 | -------------------------------------------------------------------------------- /plisp-gc/host_main.c: -------------------------------------------------------------------------------- 1 | #define EPIPHANY 1 2 | 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include "libhost.h" 10 | #include "structures.h" 11 | #include "host_proto.h" 12 | #define EXTERNAL extern 13 | #include "globals.h" 14 | 15 | int e_load_group(char *executable, e_epiphany_t *dev, unsigned row, unsigned col, unsigned rows, unsigned cols, e_bool_t start); 16 | 17 | // 18 | // Lets go! 19 | // 20 | int main(int argc, char *argv[]) { 21 | int rows, cols, result; 22 | char *code, filename[64]; 23 | e_platform_t platform; 24 | e_epiphany_t dev; 25 | e_mem_t emem; 26 | // 27 | // init the device and get platform data 28 | // 29 | if (E_OK != e_init(NULL)) { 30 | fprintf(stderr, "\nERROR: epiphinay initialization failed!\n\n"); 31 | exit(1); 32 | } 33 | if (E_OK != e_reset_system() ) { 34 | fprintf(stderr, "\nWARNING: epiphinay system rest failed!\n\n"); 35 | } 36 | fprintf(stderr, "Getting platform info\n"); 37 | if ( E_OK != e_get_platform_info(&platform) ) { 38 | fprintf(stderr, "Failed to get Epiphany platform info\n"); 39 | exit(1); 40 | } 41 | fprintf(stderr, "Platform version: %s, HAL version 0x%08x\n", 42 | platform.version, platform.hal_ver); 43 | rows = platform.rows; 44 | cols = platform.cols; 45 | memory = init_ememory(argc, argv, rows, cols); 46 | // 47 | // open the device 48 | // 49 | if (E_OK != e_open(&dev, 0, 0, rows, cols)) { 50 | fprintf(stderr, "\nERROR: Can't establish connection to Epiphany device!\n\n"); 51 | exit(1); 52 | } 53 | // 54 | // Write the ememory data structure to device memory 55 | // 56 | write_ememory(&emem, memory); 57 | // 58 | // Load the code 59 | // 60 | clear_done_flags(&dev, rows, cols); 61 | result = e_load_group("./fl-device.srec", &dev, 0, 0, rows, cols, E_TRUE); 62 | if (result == E_ERR) { 63 | printf("Error loading Epiphany program.\n"); 64 | exit(1); 65 | } 66 | // 67 | // Poll the device waiting for all cores to finish 68 | // 69 | poll_device(&dev, rows, cols); 70 | // 71 | // Process the results of device processing 72 | // 73 | process_ememory(&emem, memory, rows, cols); 74 | // 75 | // Close and finalize the device 76 | // 77 | if (e_close(&dev)) { 78 | printf( "\nERROR: Can't close connection to Epiphany device!\n\n"); 79 | exit(1); 80 | } 81 | if (e_free(&emem)) { 82 | printf( "\nERROR: Can't release Epiphany DRAM!\n\n"); 83 | exit(1); 84 | } 85 | e_finalize(); 86 | } 87 | -------------------------------------------------------------------------------- /plisp-gc/host_proto.h: -------------------------------------------------------------------------------- 1 | /* host_main.c */ 2 | int main(int argc, char *argv[]); 3 | /* libhost.c */ 4 | char *host_ptr(char *ptr); 5 | node *dr_node(node *cell); 6 | node *car(node *cell); 7 | node *cdr(node *cell); 8 | node *largs(node *cell); 9 | node *lbody(node *cell); 10 | char *dr_name(node *cell); 11 | long long ival(node *cell); 12 | void prpair(node *l); 13 | void print(node *l); 14 | char *readFile(char *fileName); 15 | void *device_ptr(char *base, char *ptr); 16 | void createFreelist(ememory *memory, int rows, int cols); 17 | void createStringFreelist(ememory *memory, int rows, int cols); 18 | void createNameFreelist(ememory *memory, int rows, int cols); 19 | ememory *init_ememory(int argc, char *argv[], int rows, int cols); 20 | void write_ememory(e_mem_t *emem, ememory *memory); 21 | void clear_done_flags(e_epiphany_t *dev, int rows, int cols); 22 | void poll_device(e_epiphany_t *dev, int rows, int cols); 23 | void prGlobals(ememory *memory, int id); 24 | void process_ememory(e_mem_t *emem, ememory *memory, int rows, int cols); 25 | -------------------------------------------------------------------------------- /plisp-gc/includes.h: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #if EPIPHANY 7 | #include "e-lib.h" 8 | #endif 9 | #include "defines.h" 10 | #include "structures.h" 11 | #define EXTERNAL 12 | #include "globals.h" 13 | #include "device_proto.h" 14 | 15 | #define BUF_ADDRESS 0x8f000000 16 | -------------------------------------------------------------------------------- /plisp-gc/libhost.h: -------------------------------------------------------------------------------- 1 | #include "params.h" 2 | 3 | #define type(X) ((X)->type) 4 | 5 | #define nullp(X) ((X) == NULLPTR) 6 | #define consp(X) ((X) && (X)->type == LIST) 7 | #define pairp(X) ((X) && (X)->type == PAIR) 8 | #define symp(X) ((X) && (X)->type == SYM) 9 | #define subrp(X) ((X) && (X)->type == SUBR) 10 | #define fsubrp(X) ((X) && (X)->type == FSUBR) 11 | #define lambdap(X) ((X) && (X)->type == LAMBDA) 12 | #define intp(X) ((X) && (X)->type == INT) 13 | #define nilp(X) ((X) && (X)->type == NIL) 14 | #define teep(X) ((X) && (X)->type == TEE) 15 | 16 | #define caar(X) (car(car(X))) 17 | #define cadar(X) (car(cdr(car(X)))) 18 | -------------------------------------------------------------------------------- /plisp-gc/onefile.py: -------------------------------------------------------------------------------- 1 | 2 | def cat(filename, skip): 3 | fp = open(filename, "r") 4 | lines = fp.readlines() 5 | for line in lines[skip:]: 6 | print(line.rstrip()) 7 | 8 | 9 | if __name__ == "__main__": 10 | 11 | cat("includes.h", 0) 12 | cat("libplisp.c", 10) 13 | cat("libdevice.c", 14) 14 | cat("device_main.c", 9) 15 | -------------------------------------------------------------------------------- /plisp-gc/params.h: -------------------------------------------------------------------------------- 1 | #if EPIPHANY 2 | #define DIRECTIVE __attribute__((aligned(8))) 3 | #else 4 | #define DIRECTIVE 5 | #endif 6 | 7 | #define TRUE 1 8 | #define FALSE 0 9 | 10 | #define NCORES 16 11 | #define BANKSIZE 8192 12 | #define STRINGMAX BANKSIZE 13 | #define NAMESTRMAX 32 14 | #define LINELENGTH 1024 15 | 16 | #define FREESTRING 10 17 | #define FREEOBJECT 20000 18 | #define FREENAME 8000 19 | -------------------------------------------------------------------------------- /plisp-gc/plisp: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | ESDK=${EPIPHANY_HOME} 4 | ELIBS=${ESDK}/tools/host/lib:${LD_LIBRARY_PATH} 5 | EHDF=${EPIPHANY_HDF} 6 | ELDF=${ESDK}/bsps/current/internal.ldf 7 | 8 | SCRIPT=$(readlink -f "$0") 9 | EXEPATH=$(dirname "$SCRIPT") 10 | 11 | { 12 | $EXEPATH/fl-host.elf $* 13 | } || { 14 | sudo -E LD_LIBRARY_PATH=${ELIBS} EPIPHANY_HDF=${EHDF} $EXEPATH/fl-host.elf $* 15 | } 16 | 17 | if [ $? -ne 0 ] 18 | then 19 | echo "$SCRIPT FAILED" 20 | else 21 | echo "$SCRIPT PASSED" 22 | fi 23 | -------------------------------------------------------------------------------- /plisp-gc/prog.lisp: -------------------------------------------------------------------------------- 1 | (defun foldr (f zero lst) 2 | (if (null lst) zero 3 | (funcall f (car lst) (foldr f zero (cdr lst))) 4 | ) 5 | ) 6 | 7 | (defun foldl (f zero lst) 8 | (if (null lst) zero 9 | (foldl f (funcall f (car lst) zero) (cdr lst)))) 10 | 11 | (defun reverse (lst) (foldl cons nil lst)) 12 | 13 | (defun append (a b) (foldr cons b a)) 14 | 15 | (defun iota (start end) 16 | (if (< start end) 17 | (cons start (iota (+ 1 start) end)) 18 | nil 19 | ) 20 | ) 21 | 22 | (defun flatten (lst) 23 | (if (null lst) nil 24 | (if (consp (car lst)) 25 | (append (flatten (car lst)) 26 | (flatten (cdr lst))) 27 | (cons (car lst) 28 | (flatten (cdr lst)))))) 29 | 30 | (define length 31 | (lambda (L) 32 | (if L 33 | (+ 1 (length (cdr L))) 34 | 0))) 35 | 36 | (define factorial-iter 37 | (lambda (n) 38 | (define fact-iter 39 | (lambda (n count acc) 40 | (if (> count n) 41 | acc 42 | (fact-iter n (+ count 1) (* count acc))))) 43 | (fact-iter n 1 1))) 44 | 45 | (label fibonacci 46 | (lambda (n) 47 | (label fibo 48 | (lambda (n a b) 49 | (if (= n 0) 50 | nil 51 | (cons a (fibo (- n 1) b (+ a b)))))) 52 | (fibo n 0 1))) 53 | 54 | (label square 55 | (lambda (x) (* x x))) 56 | 57 | (label cube 58 | (lambda (x) (* x x x))) 59 | 60 | (iota 0 10) 61 | 62 | (define l '((1 2 3) (4 5 6) (7 8 9) (10 11 12) (13 14 15) (16 17 18) (19 20 21))) 63 | (reverse l) 64 | (flatten l) 65 | 66 | (length '(1 2 3 4)) 67 | (square 3) 68 | (cube 3) 69 | (fibonacci 11) 70 | (factorial-iter 3) 71 | 72 | '(hello world from core (id)) 73 | -------------------------------------------------------------------------------- /plisp-gc/run.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | ESDK=${EPIPHANY_HOME} 4 | ELIBS=${ESDK}/tools/host/lib:${LD_LIBRARY_PATH} 5 | EHDF=${EPIPHANY_HDF} 6 | ELDF=${ESDK}/bsps/current/internal.ldf 7 | 8 | SCRIPT=$(readlink -f "$0") 9 | EXEPATH=$(dirname "$SCRIPT") 10 | 11 | { 12 | $EXEPATH/fl-host.elf $* 13 | } || { 14 | sudo -E LD_LIBRARY_PATH=${ELIBS} EPIPHANY_HDF=${EHDF} $EXEPATH/fl-host.elf $* 15 | } 16 | 17 | if [ $? -ne 0 ] 18 | then 19 | echo "$SCRIPT FAILED" 20 | else 21 | echo "$SCRIPT PASSED" 22 | fi 23 | -------------------------------------------------------------------------------- /plisp-gc/structures.h: -------------------------------------------------------------------------------- 1 | enum ltype {PAIR, LIST, SYM, SUBR, FSUBR, LAMBDA, INT, NIL, TEE, ENV, FREE}; 2 | 3 | typedef struct DIRECTIVE fdef fdef; 4 | typedef struct DIRECTIVE node node; 5 | 6 | typedef struct DIRECTIVE string string; 7 | typedef struct DIRECTIVE namestr namestr; 8 | typedef struct DIRECTIVE edata edata; 9 | typedef struct DIRECTIVE ememory ememory; 10 | 11 | typedef struct DIRECTIVE stack stack; 12 | 13 | struct DIRECTIVE node { 14 | node *next; 15 | unsigned char type; 16 | unsigned char marked; 17 | union { 18 | namestr *name; 19 | struct { 20 | node *car; 21 | node *cdr; 22 | }; 23 | struct { 24 | namestr *fname; 25 | node *(*fn)(node *, node *); 26 | }; 27 | struct { 28 | node *args; 29 | node *body; 30 | }; 31 | long long i; 32 | double r; 33 | struct { 34 | node *top; 35 | node *bindings; 36 | }; 37 | }; 38 | }; 39 | 40 | struct DIRECTIVE string { 41 | string *next; 42 | char s[STRINGMAX]; 43 | }; 44 | 45 | struct DIRECTIVE namestr { 46 | namestr *next; 47 | char s[NAMESTRMAX]; 48 | }; 49 | 50 | struct DIRECTIVE stack { 51 | void *next; 52 | }; 53 | 54 | struct DIRECTIVE edata { 55 | int id; 56 | int ememory_size; 57 | int node_size; 58 | int nnodes; 59 | int nodemem; 60 | int nnames; 61 | int namemem; 62 | int nstrings; 63 | int stringmem; 64 | int finished; 65 | char message[1024]; 66 | char code[BANKSIZE]; 67 | node *NULLPTR; 68 | node *history; 69 | node *freelist; 70 | namestr *namefreelist; 71 | string *stringfreelist; 72 | string freeStringArray[FREESTRING]; 73 | node freeNodeArray[FREEOBJECT]; 74 | namestr freeNameArray[FREENAME]; 75 | }; 76 | 77 | struct DIRECTIVE ememory { 78 | edata data[NCORES]; 79 | }; 80 | -------------------------------------------------------------------------------- /plisp-initial/Makefile: -------------------------------------------------------------------------------- 1 | 2 | all: clean fl onefile 3 | rm -f Trace.out 4 | 5 | build: 6 | (cd code; python gencode.py) 7 | bash ./build.sh 8 | 9 | run: 10 | (cd code; python gencode.py) 11 | bash ./run.sh 12 | 13 | fl: force 14 | (cd code; python gencode.py) 15 | gcc -std=gnu99 -o fl fl-device.c 16 | 17 | onefile: force 18 | python onefile.py 19 | gcc -std=gnu99 -o onefile onefile.c 20 | wc -l onefile.c 21 | 22 | proto: 23 | cproto fl-device.c > proto.h 24 | 25 | force: 26 | 27 | clean: 28 | rm -f fl onefile *.elf *.srec *.exe* 29 | -------------------------------------------------------------------------------- /plisp-initial/build.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | set -e 4 | 5 | ESDK=${EPIPHANY_HOME} 6 | ELIBS=${ESDK}/tools/host/lib 7 | EINCS=${ESDK}/tools/host/include 8 | ELDF=${ESDK}/bsps/current/fast.ldf 9 | 10 | SCRIPT=$(readlink -f "$0") 11 | EXEPATH=$(dirname "$SCRIPT") 12 | cd $EXEPATH 13 | 14 | CROSS_PREFIX= 15 | case $(uname -p) in 16 | arm*) 17 | # Use native arm compiler (no cross prefix) 18 | CROSS_PREFIX= 19 | ;; 20 | *) 21 | # Use cross compiler 22 | CROSS_PREFIX="arm-linux-gnueabihf-" 23 | ;; 24 | esac 25 | 26 | ${CROSS_PREFIX}gcc -O3 -std=gnu99 -Wno-format-security fl-host.c -o fl-host.elf -I ${EINCS} -L ${ELIBS} -le-hal -le-loader -lpthread 27 | 28 | e-gcc -O -DEPIPHANY=1 -std=gnu99 -T ${ELDF} fl-device.c -o fl-device.elf -le-lib 29 | 30 | e-objcopy --srec-forceS3 --output-target srec fl-device.elf fl-device.srec 31 | 32 | -------------------------------------------------------------------------------- /plisp-initial/code/Makefile: -------------------------------------------------------------------------------- 1 | 2 | all: 3 | python gencode.py 4 | -------------------------------------------------------------------------------- /plisp-initial/code/gencode.py: -------------------------------------------------------------------------------- 1 | import random 2 | 3 | setup=""" 4 | (label ff (lambda (x y) 5 | (cons (car x) y) 6 | ) 7 | ) 8 | (label xx '(a b)) 9 | (label nfibs (lambda (n) 10 | (if (< n 2) n 11 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 12 | ) 13 | ) 14 | ) 15 | (label recurse (lambda (x) 16 | (cond ((nilp x) (quote stop)) 17 | (t (recurse (cdr x))) 18 | ) 19 | ) 20 | ) 21 | (recurse (a b c d e f)) 22 | (nfibs 10) 23 | (define n 5) 24 | (loop (> n 0) 25 | (progn 26 | (print n) 27 | (define n (- n 1)) 28 | (terpri 1) 29 | ) 30 | ) 31 | (ff '(a b) (cdr '(c d))) 32 | ((lambda (x y) (cons (car x) y)) '(a b) (cdr '(c d))) 33 | (atom "a") 34 | (atom 1) 35 | (atom nil) 36 | (equal "a" "a") 37 | (equal "a" "b") 38 | (equal "1" 1) 39 | (car '(a b c)) 40 | (cdr '(a b c)) 41 | (cons "a" (cons "b" nil)) 42 | (quote (car '(a b c))) 43 | (cond ((= 1 1) (quote stop)) 44 | (t (quote hi )) 45 | ) 46 | (label n 1) 47 | (eval 'n) 48 | (nilp nil) 49 | (nilp "a") 50 | (append '(1 2 3) '(4 5 6)) 51 | (concat '(1 2) '(3 4)) 52 | (block (+ 1 2) (+ 2 3) (+ 3 4)) 53 | (progn (+ 1 2) (+ 2 3) (+ 3 4)) 54 | (if (= 1 1) t nil) 55 | (if (= 1 2) t nil) 56 | (print '(1 2 3 4)) 57 | (terpri 1) 58 | (< 2 1) 59 | (< 1 2) 60 | (> 1 2) 61 | (> 2 1) 62 | (+ 1 1) 63 | (- 4 2) 64 | (/ 10 5) 65 | (* 3 3) 66 | (= 2 3) 67 | (= 2 2) 68 | """ 69 | 70 | code = """ 71 | 'a 72 | '(a b c) 73 | (car '(a b c)) 74 | (cdr '(a b c)) 75 | (cons 'a '(b c)) 76 | (equal (car '(a b)) 'a) 77 | (equal (car (cdr '(a b))) 'a) 78 | (atom 'a) 79 | (cond ((atom 'a) 'b) (t 'c)) 80 | (cond ( nil (quote b)) (t (quote c))) 81 | (cond ( nil 'b) (t 'c)) 82 | ((lambda (x y) (cons (car x) y)) '(a b) (cdr '(c d))) 83 | (equal nil nil) 84 | (equal t t) 85 | (equal 1 1) 86 | (ff '(a b) (cdr '(c d))) 87 | (cdr xx) 88 | (car xx) 89 | """ 90 | 91 | if __name__ == '__main__': 92 | 93 | lines = code.split("\n"); 94 | 95 | for i in range(16): 96 | sample = random.sample(lines, 10) 97 | fp = open("p" + str(i) + ".lisp", "w") 98 | fp.write(setup + "\n") 99 | for line in sample: 100 | fp.write(line + "\n") 101 | fp.close() 102 | -------------------------------------------------------------------------------- /plisp-initial/code/input.lisp: -------------------------------------------------------------------------------- 1 | (label nfibs 2 | (lambda (n) 3 | (if (< n 2) 4 | n 5 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 6 | ) 7 | ) 8 | ) 9 | (label recurse (lambda (x) 10 | (cond ((equal (car x) end) 'stop) 11 | (t (recurse (cdr x))) 12 | ) 13 | ) 14 | ) 15 | (recurse (a b c d e f end)) 16 | (nfibs 10) 17 | 18 | (label ff (lambda (x y) 19 | (cons (car x) y) 20 | ) 21 | ) 22 | 'a 23 | '(a b c) 24 | (car '(a b c)) 25 | (cdr '(a b c)) 26 | (cons 'a '(b c)) 27 | (equal (car '(a b)) 'a) 28 | (equal (car (cdr '(a b))) 'a) 29 | (atom 'a) 30 | (cond ((atom '(1 2)) 'b) (t 'c)) 31 | (cond (nil 10) (t 20)) 32 | ((lambda (x y) (cons (car x) y)) '(a b) (cdr '(c d))) 33 | (ff '(a b) (cdr '(c d))) 34 | (label xx '(a b)) 35 | (car xx) 36 | (label xx '(c d)) 37 | (car xx) 38 | -------------------------------------------------------------------------------- /plisp-initial/code/input2.lisp: -------------------------------------------------------------------------------- 1 | (label nfibs 2 | (lambda (n) 3 | (if (< n 2) 4 | n 5 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 6 | ) 7 | ) 8 | ) 9 | (label recurse (lambda (x) 10 | (cond ((equal (car x) end) 'stop) 11 | (t (recurse (cdr x))) 12 | ) 13 | ) 14 | ) 15 | (recurse (a b c d e f end)) 16 | (nfibs 10) 17 | 18 | (label ff (lambda (x y) 19 | (cons (car x) y) 20 | ) 21 | ) 22 | 'a 23 | '(a b c) 24 | (car '(a b c)) 25 | (cdr '(a b c)) 26 | (cons 'a '(b c)) 27 | (equal (car '(a b)) 'a) 28 | (equal (car (cdr '(a b))) 'a) 29 | (atom 'a) 30 | (cond ((atom '(1 2)) 'b) (t 'c)) 31 | (cond (nil 10) (t 20)) 32 | ((lambda (x y) (cons (car x) y)) '(a b) (cdr '(c d))) 33 | (ff '(a b) (cdr '(c d))) 34 | (label xx '(a b)) 35 | (car xx) 36 | (label xx '(c d)) 37 | (car xx) 38 | (define n 5) 39 | (loop (> n 0) (printl hello) (define n (- n 1)) (terpri 1) ) -------------------------------------------------------------------------------- /plisp-initial/code/p0.lisp: -------------------------------------------------------------------------------- 1 | 2 | (label ff (lambda (x y) 3 | (cons (car x) y) 4 | ) 5 | ) 6 | (label xx '(a b)) 7 | (label nfibs (lambda (n) 8 | (if (< n 2) n 9 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 10 | ) 11 | ) 12 | ) 13 | (label recurse (lambda (x) 14 | (cond ((nilp x) (quote stop)) 15 | (t (recurse (cdr x))) 16 | ) 17 | ) 18 | ) 19 | (recurse (a b c d e f)) 20 | (nfibs 10) 21 | (define n 5) 22 | (loop (> n 0) 23 | (progn 24 | (print n) 25 | (define n (- n 1)) 26 | (terpri 1) 27 | ) 28 | ) 29 | (ff '(a b) (cdr '(c d))) 30 | ((lambda (x y) (cons (car x) y)) '(a b) (cdr '(c d))) 31 | (atom "a") 32 | (atom 1) 33 | (atom nil) 34 | (equal "a" "a") 35 | (equal "a" "b") 36 | (equal "1" 1) 37 | (car '(a b c)) 38 | (cdr '(a b c)) 39 | (cons "a" (cons "b" nil)) 40 | (quote (car '(a b c))) 41 | (cond ((= 1 1) (quote stop)) 42 | (t (quote hi )) 43 | ) 44 | (label n 1) 45 | (eval 'n) 46 | (nilp nil) 47 | (nilp "a") 48 | (append '(1 2 3) '(4 5 6)) 49 | (concat '(1 2) '(3 4)) 50 | (block (+ 1 2) (+ 2 3) (+ 3 4)) 51 | (progn (+ 1 2) (+ 2 3) (+ 3 4)) 52 | (if (= 1 1) t nil) 53 | (if (= 1 2) t nil) 54 | (print '(1 2 3 4)) 55 | (terpri 1) 56 | (< 2 1) 57 | (< 1 2) 58 | (> 1 2) 59 | (> 2 1) 60 | (+ 1 1) 61 | (- 4 2) 62 | (/ 10 5) 63 | (* 3 3) 64 | (= 2 3) 65 | (= 2 2) 66 | 67 | (equal (car '(a b)) 'a) 68 | (cond ( nil (quote b)) (t (quote c))) 69 | (cons 'a '(b c)) 70 | '(a b c) 71 | 72 | (cond ( nil 'b) (t 'c)) 73 | (cond ((atom 'a) 'b) (t 'c)) 74 | 'a 75 | (ff '(a b) (cdr '(c d))) 76 | (cdr xx) 77 | -------------------------------------------------------------------------------- /plisp-initial/code/p1.lisp: -------------------------------------------------------------------------------- 1 | 2 | (label ff (lambda (x y) 3 | (cons (car x) y) 4 | ) 5 | ) 6 | (label xx '(a b)) 7 | (label nfibs (lambda (n) 8 | (if (< n 2) n 9 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 10 | ) 11 | ) 12 | ) 13 | (label recurse (lambda (x) 14 | (cond ((nilp x) (quote stop)) 15 | (t (recurse (cdr x))) 16 | ) 17 | ) 18 | ) 19 | (recurse (a b c d e f)) 20 | (nfibs 10) 21 | (define n 5) 22 | (loop (> n 0) 23 | (progn 24 | (print n) 25 | (define n (- n 1)) 26 | (terpri 1) 27 | ) 28 | ) 29 | (ff '(a b) (cdr '(c d))) 30 | ((lambda (x y) (cons (car x) y)) '(a b) (cdr '(c d))) 31 | (atom "a") 32 | (atom 1) 33 | (atom nil) 34 | (equal "a" "a") 35 | (equal "a" "b") 36 | (equal "1" 1) 37 | (car '(a b c)) 38 | (cdr '(a b c)) 39 | (cons "a" (cons "b" nil)) 40 | (quote (car '(a b c))) 41 | (cond ((= 1 1) (quote stop)) 42 | (t (quote hi )) 43 | ) 44 | (label n 1) 45 | (eval 'n) 46 | (nilp nil) 47 | (nilp "a") 48 | (append '(1 2 3) '(4 5 6)) 49 | (concat '(1 2) '(3 4)) 50 | (block (+ 1 2) (+ 2 3) (+ 3 4)) 51 | (progn (+ 1 2) (+ 2 3) (+ 3 4)) 52 | (if (= 1 1) t nil) 53 | (if (= 1 2) t nil) 54 | (print '(1 2 3 4)) 55 | (terpri 1) 56 | (< 2 1) 57 | (< 1 2) 58 | (> 1 2) 59 | (> 2 1) 60 | (+ 1 1) 61 | (- 4 2) 62 | (/ 10 5) 63 | (* 3 3) 64 | (= 2 3) 65 | (= 2 2) 66 | 67 | (cdr xx) 68 | 'a 69 | (cond ((atom 'a) 'b) (t 'c)) 70 | (cdr '(a b c)) 71 | 72 | (equal nil nil) 73 | (car '(a b c)) 74 | (equal (car '(a b)) 'a) 75 | (equal 1 1) 76 | (equal t t) 77 | -------------------------------------------------------------------------------- /plisp-initial/code/p10.lisp: -------------------------------------------------------------------------------- 1 | 2 | (label ff (lambda (x y) 3 | (cons (car x) y) 4 | ) 5 | ) 6 | (label xx '(a b)) 7 | (label nfibs (lambda (n) 8 | (if (< n 2) n 9 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 10 | ) 11 | ) 12 | ) 13 | (label recurse (lambda (x) 14 | (cond ((nilp x) (quote stop)) 15 | (t (recurse (cdr x))) 16 | ) 17 | ) 18 | ) 19 | (recurse (a b c d e f)) 20 | (nfibs 10) 21 | (define n 5) 22 | (loop (> n 0) 23 | (progn 24 | (print n) 25 | (define n (- n 1)) 26 | (terpri 1) 27 | ) 28 | ) 29 | (ff '(a b) (cdr '(c d))) 30 | ((lambda (x y) (cons (car x) y)) '(a b) (cdr '(c d))) 31 | (atom "a") 32 | (atom 1) 33 | (atom nil) 34 | (equal "a" "a") 35 | (equal "a" "b") 36 | (equal "1" 1) 37 | (car '(a b c)) 38 | (cdr '(a b c)) 39 | (cons "a" (cons "b" nil)) 40 | (quote (car '(a b c))) 41 | (cond ((= 1 1) (quote stop)) 42 | (t (quote hi )) 43 | ) 44 | (label n 1) 45 | (eval 'n) 46 | (nilp nil) 47 | (nilp "a") 48 | (append '(1 2 3) '(4 5 6)) 49 | (concat '(1 2) '(3 4)) 50 | (block (+ 1 2) (+ 2 3) (+ 3 4)) 51 | (progn (+ 1 2) (+ 2 3) (+ 3 4)) 52 | (if (= 1 1) t nil) 53 | (if (= 1 2) t nil) 54 | (print '(1 2 3 4)) 55 | (terpri 1) 56 | (< 2 1) 57 | (< 1 2) 58 | (> 1 2) 59 | (> 2 1) 60 | (+ 1 1) 61 | (- 4 2) 62 | (/ 10 5) 63 | (* 3 3) 64 | (= 2 3) 65 | (= 2 2) 66 | 67 | (cons 'a '(b c)) 68 | (cond ((atom 'a) 'b) (t 'c)) 69 | (equal t t) 70 | (ff '(a b) (cdr '(c d))) 71 | 72 | '(a b c) 73 | (cond ( nil (quote b)) (t (quote c))) 74 | (equal nil nil) 75 | (cdr xx) 76 | ((lambda (x y) (cons (car x) y)) '(a b) (cdr '(c d))) 77 | -------------------------------------------------------------------------------- /plisp-initial/code/p11.lisp: -------------------------------------------------------------------------------- 1 | 2 | (label ff (lambda (x y) 3 | (cons (car x) y) 4 | ) 5 | ) 6 | (label xx '(a b)) 7 | (label nfibs (lambda (n) 8 | (if (< n 2) n 9 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 10 | ) 11 | ) 12 | ) 13 | (label recurse (lambda (x) 14 | (cond ((nilp x) (quote stop)) 15 | (t (recurse (cdr x))) 16 | ) 17 | ) 18 | ) 19 | (recurse (a b c d e f)) 20 | (nfibs 10) 21 | (define n 5) 22 | (loop (> n 0) 23 | (progn 24 | (print n) 25 | (define n (- n 1)) 26 | (terpri 1) 27 | ) 28 | ) 29 | (ff '(a b) (cdr '(c d))) 30 | ((lambda (x y) (cons (car x) y)) '(a b) (cdr '(c d))) 31 | (atom "a") 32 | (atom 1) 33 | (atom nil) 34 | (equal "a" "a") 35 | (equal "a" "b") 36 | (equal "1" 1) 37 | (car '(a b c)) 38 | (cdr '(a b c)) 39 | (cons "a" (cons "b" nil)) 40 | (quote (car '(a b c))) 41 | (cond ((= 1 1) (quote stop)) 42 | (t (quote hi )) 43 | ) 44 | (label n 1) 45 | (eval 'n) 46 | (nilp nil) 47 | (nilp "a") 48 | (append '(1 2 3) '(4 5 6)) 49 | (concat '(1 2) '(3 4)) 50 | (block (+ 1 2) (+ 2 3) (+ 3 4)) 51 | (progn (+ 1 2) (+ 2 3) (+ 3 4)) 52 | (if (= 1 1) t nil) 53 | (if (= 1 2) t nil) 54 | (print '(1 2 3 4)) 55 | (terpri 1) 56 | (< 2 1) 57 | (< 1 2) 58 | (> 1 2) 59 | (> 2 1) 60 | (+ 1 1) 61 | (- 4 2) 62 | (/ 10 5) 63 | (* 3 3) 64 | (= 2 3) 65 | (= 2 2) 66 | 67 | (cdr '(a b c)) 68 | (atom 'a) 69 | (equal (car (cdr '(a b))) 'a) 70 | (cond ((atom 'a) 'b) (t 'c)) 71 | (car xx) 72 | (cond ( nil (quote b)) (t (quote c))) 73 | (ff '(a b) (cdr '(c d))) 74 | 75 | (equal (car '(a b)) 'a) 76 | (equal t t) 77 | -------------------------------------------------------------------------------- /plisp-initial/code/p12.lisp: -------------------------------------------------------------------------------- 1 | 2 | (label ff (lambda (x y) 3 | (cons (car x) y) 4 | ) 5 | ) 6 | (label xx '(a b)) 7 | (label nfibs (lambda (n) 8 | (if (< n 2) n 9 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 10 | ) 11 | ) 12 | ) 13 | (label recurse (lambda (x) 14 | (cond ((nilp x) (quote stop)) 15 | (t (recurse (cdr x))) 16 | ) 17 | ) 18 | ) 19 | (recurse (a b c d e f)) 20 | (nfibs 10) 21 | (define n 5) 22 | (loop (> n 0) 23 | (progn 24 | (print n) 25 | (define n (- n 1)) 26 | (terpri 1) 27 | ) 28 | ) 29 | (ff '(a b) (cdr '(c d))) 30 | ((lambda (x y) (cons (car x) y)) '(a b) (cdr '(c d))) 31 | (atom "a") 32 | (atom 1) 33 | (atom nil) 34 | (equal "a" "a") 35 | (equal "a" "b") 36 | (equal "1" 1) 37 | (car '(a b c)) 38 | (cdr '(a b c)) 39 | (cons "a" (cons "b" nil)) 40 | (quote (car '(a b c))) 41 | (cond ((= 1 1) (quote stop)) 42 | (t (quote hi )) 43 | ) 44 | (label n 1) 45 | (eval 'n) 46 | (nilp nil) 47 | (nilp "a") 48 | (append '(1 2 3) '(4 5 6)) 49 | (concat '(1 2) '(3 4)) 50 | (block (+ 1 2) (+ 2 3) (+ 3 4)) 51 | (progn (+ 1 2) (+ 2 3) (+ 3 4)) 52 | (if (= 1 1) t nil) 53 | (if (= 1 2) t nil) 54 | (print '(1 2 3 4)) 55 | (terpri 1) 56 | (< 2 1) 57 | (< 1 2) 58 | (> 1 2) 59 | (> 2 1) 60 | (+ 1 1) 61 | (- 4 2) 62 | (/ 10 5) 63 | (* 3 3) 64 | (= 2 3) 65 | (= 2 2) 66 | 67 | (cdr xx) 68 | (equal 1 1) 69 | (cond ( nil (quote b)) (t (quote c))) 70 | '(a b c) 71 | ((lambda (x y) (cons (car x) y)) '(a b) (cdr '(c d))) 72 | 73 | (atom 'a) 74 | 75 | (car '(a b c)) 76 | (ff '(a b) (cdr '(c d))) 77 | -------------------------------------------------------------------------------- /plisp-initial/code/p13.lisp: -------------------------------------------------------------------------------- 1 | 2 | (label ff (lambda (x y) 3 | (cons (car x) y) 4 | ) 5 | ) 6 | (label xx '(a b)) 7 | (label nfibs (lambda (n) 8 | (if (< n 2) n 9 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 10 | ) 11 | ) 12 | ) 13 | (label recurse (lambda (x) 14 | (cond ((nilp x) (quote stop)) 15 | (t (recurse (cdr x))) 16 | ) 17 | ) 18 | ) 19 | (recurse (a b c d e f)) 20 | (nfibs 10) 21 | (define n 5) 22 | (loop (> n 0) 23 | (progn 24 | (print n) 25 | (define n (- n 1)) 26 | (terpri 1) 27 | ) 28 | ) 29 | (ff '(a b) (cdr '(c d))) 30 | ((lambda (x y) (cons (car x) y)) '(a b) (cdr '(c d))) 31 | (atom "a") 32 | (atom 1) 33 | (atom nil) 34 | (equal "a" "a") 35 | (equal "a" "b") 36 | (equal "1" 1) 37 | (car '(a b c)) 38 | (cdr '(a b c)) 39 | (cons "a" (cons "b" nil)) 40 | (quote (car '(a b c))) 41 | (cond ((= 1 1) (quote stop)) 42 | (t (quote hi )) 43 | ) 44 | (label n 1) 45 | (eval 'n) 46 | (nilp nil) 47 | (nilp "a") 48 | (append '(1 2 3) '(4 5 6)) 49 | (concat '(1 2) '(3 4)) 50 | (block (+ 1 2) (+ 2 3) (+ 3 4)) 51 | (progn (+ 1 2) (+ 2 3) (+ 3 4)) 52 | (if (= 1 1) t nil) 53 | (if (= 1 2) t nil) 54 | (print '(1 2 3 4)) 55 | (terpri 1) 56 | (< 2 1) 57 | (< 1 2) 58 | (> 1 2) 59 | (> 2 1) 60 | (+ 1 1) 61 | (- 4 2) 62 | (/ 10 5) 63 | (* 3 3) 64 | (= 2 3) 65 | (= 2 2) 66 | 67 | ((lambda (x y) (cons (car x) y)) '(a b) (cdr '(c d))) 68 | '(a b c) 69 | (cons 'a '(b c)) 70 | (car xx) 71 | (cdr xx) 72 | (car '(a b c)) 73 | (cond ( nil (quote b)) (t (quote c))) 74 | (equal nil nil) 75 | (cond ((atom 'a) 'b) (t 'c)) 76 | 77 | -------------------------------------------------------------------------------- /plisp-initial/code/p14.lisp: -------------------------------------------------------------------------------- 1 | 2 | (label ff (lambda (x y) 3 | (cons (car x) y) 4 | ) 5 | ) 6 | (label xx '(a b)) 7 | (label nfibs (lambda (n) 8 | (if (< n 2) n 9 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 10 | ) 11 | ) 12 | ) 13 | (label recurse (lambda (x) 14 | (cond ((nilp x) (quote stop)) 15 | (t (recurse (cdr x))) 16 | ) 17 | ) 18 | ) 19 | (recurse (a b c d e f)) 20 | (nfibs 10) 21 | (define n 5) 22 | (loop (> n 0) 23 | (progn 24 | (print n) 25 | (define n (- n 1)) 26 | (terpri 1) 27 | ) 28 | ) 29 | (ff '(a b) (cdr '(c d))) 30 | ((lambda (x y) (cons (car x) y)) '(a b) (cdr '(c d))) 31 | (atom "a") 32 | (atom 1) 33 | (atom nil) 34 | (equal "a" "a") 35 | (equal "a" "b") 36 | (equal "1" 1) 37 | (car '(a b c)) 38 | (cdr '(a b c)) 39 | (cons "a" (cons "b" nil)) 40 | (quote (car '(a b c))) 41 | (cond ((= 1 1) (quote stop)) 42 | (t (quote hi )) 43 | ) 44 | (label n 1) 45 | (eval 'n) 46 | (nilp nil) 47 | (nilp "a") 48 | (append '(1 2 3) '(4 5 6)) 49 | (concat '(1 2) '(3 4)) 50 | (block (+ 1 2) (+ 2 3) (+ 3 4)) 51 | (progn (+ 1 2) (+ 2 3) (+ 3 4)) 52 | (if (= 1 1) t nil) 53 | (if (= 1 2) t nil) 54 | (print '(1 2 3 4)) 55 | (terpri 1) 56 | (< 2 1) 57 | (< 1 2) 58 | (> 1 2) 59 | (> 2 1) 60 | (+ 1 1) 61 | (- 4 2) 62 | (/ 10 5) 63 | (* 3 3) 64 | (= 2 3) 65 | (= 2 2) 66 | 67 | (cond ((atom 'a) 'b) (t 'c)) 68 | (equal (car (cdr '(a b))) 'a) 69 | 'a 70 | (equal nil nil) 71 | ((lambda (x y) (cons (car x) y)) '(a b) (cdr '(c d))) 72 | (equal 1 1) 73 | (cons 'a '(b c)) 74 | (car '(a b c)) 75 | (cdr xx) 76 | (cond ( nil (quote b)) (t (quote c))) 77 | -------------------------------------------------------------------------------- /plisp-initial/code/p15.lisp: -------------------------------------------------------------------------------- 1 | 2 | (label ff (lambda (x y) 3 | (cons (car x) y) 4 | ) 5 | ) 6 | (label xx '(a b)) 7 | (label nfibs (lambda (n) 8 | (if (< n 2) n 9 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 10 | ) 11 | ) 12 | ) 13 | (label recurse (lambda (x) 14 | (cond ((nilp x) (quote stop)) 15 | (t (recurse (cdr x))) 16 | ) 17 | ) 18 | ) 19 | (recurse (a b c d e f)) 20 | (nfibs 10) 21 | (define n 5) 22 | (loop (> n 0) 23 | (progn 24 | (print n) 25 | (define n (- n 1)) 26 | (terpri 1) 27 | ) 28 | ) 29 | (ff '(a b) (cdr '(c d))) 30 | ((lambda (x y) (cons (car x) y)) '(a b) (cdr '(c d))) 31 | (atom "a") 32 | (atom 1) 33 | (atom nil) 34 | (equal "a" "a") 35 | (equal "a" "b") 36 | (equal "1" 1) 37 | (car '(a b c)) 38 | (cdr '(a b c)) 39 | (cons "a" (cons "b" nil)) 40 | (quote (car '(a b c))) 41 | (cond ((= 1 1) (quote stop)) 42 | (t (quote hi )) 43 | ) 44 | (label n 1) 45 | (eval 'n) 46 | (nilp nil) 47 | (nilp "a") 48 | (append '(1 2 3) '(4 5 6)) 49 | (concat '(1 2) '(3 4)) 50 | (block (+ 1 2) (+ 2 3) (+ 3 4)) 51 | (progn (+ 1 2) (+ 2 3) (+ 3 4)) 52 | (if (= 1 1) t nil) 53 | (if (= 1 2) t nil) 54 | (print '(1 2 3 4)) 55 | (terpri 1) 56 | (< 2 1) 57 | (< 1 2) 58 | (> 1 2) 59 | (> 2 1) 60 | (+ 1 1) 61 | (- 4 2) 62 | (/ 10 5) 63 | (* 3 3) 64 | (= 2 3) 65 | (= 2 2) 66 | 67 | 68 | (equal nil nil) 69 | (atom 'a) 70 | (cond ((atom 'a) 'b) (t 'c)) 71 | (car xx) 72 | ((lambda (x y) (cons (car x) y)) '(a b) (cdr '(c d))) 73 | (equal (car '(a b)) 'a) 74 | (cond ( nil 'b) (t 'c)) 75 | (ff '(a b) (cdr '(c d))) 76 | '(a b c) 77 | -------------------------------------------------------------------------------- /plisp-initial/code/p2.lisp: -------------------------------------------------------------------------------- 1 | 2 | (label ff (lambda (x y) 3 | (cons (car x) y) 4 | ) 5 | ) 6 | (label xx '(a b)) 7 | (label nfibs (lambda (n) 8 | (if (< n 2) n 9 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 10 | ) 11 | ) 12 | ) 13 | (label recurse (lambda (x) 14 | (cond ((nilp x) (quote stop)) 15 | (t (recurse (cdr x))) 16 | ) 17 | ) 18 | ) 19 | (recurse (a b c d e f)) 20 | (nfibs 10) 21 | (define n 5) 22 | (loop (> n 0) 23 | (progn 24 | (print n) 25 | (define n (- n 1)) 26 | (terpri 1) 27 | ) 28 | ) 29 | (ff '(a b) (cdr '(c d))) 30 | ((lambda (x y) (cons (car x) y)) '(a b) (cdr '(c d))) 31 | (atom "a") 32 | (atom 1) 33 | (atom nil) 34 | (equal "a" "a") 35 | (equal "a" "b") 36 | (equal "1" 1) 37 | (car '(a b c)) 38 | (cdr '(a b c)) 39 | (cons "a" (cons "b" nil)) 40 | (quote (car '(a b c))) 41 | (cond ((= 1 1) (quote stop)) 42 | (t (quote hi )) 43 | ) 44 | (label n 1) 45 | (eval 'n) 46 | (nilp nil) 47 | (nilp "a") 48 | (append '(1 2 3) '(4 5 6)) 49 | (concat '(1 2) '(3 4)) 50 | (block (+ 1 2) (+ 2 3) (+ 3 4)) 51 | (progn (+ 1 2) (+ 2 3) (+ 3 4)) 52 | (if (= 1 1) t nil) 53 | (if (= 1 2) t nil) 54 | (print '(1 2 3 4)) 55 | (terpri 1) 56 | (< 2 1) 57 | (< 1 2) 58 | (> 1 2) 59 | (> 2 1) 60 | (+ 1 1) 61 | (- 4 2) 62 | (/ 10 5) 63 | (* 3 3) 64 | (= 2 3) 65 | (= 2 2) 66 | 67 | (cond ( nil (quote b)) (t (quote c))) 68 | (equal t t) 69 | (atom 'a) 70 | ((lambda (x y) (cons (car x) y)) '(a b) (cdr '(c d))) 71 | (equal (car '(a b)) 'a) 72 | (ff '(a b) (cdr '(c d))) 73 | 74 | (cond ( nil 'b) (t 'c)) 75 | (cdr '(a b c)) 76 | (cdr xx) 77 | -------------------------------------------------------------------------------- /plisp-initial/code/p3.lisp: -------------------------------------------------------------------------------- 1 | 2 | (label ff (lambda (x y) 3 | (cons (car x) y) 4 | ) 5 | ) 6 | (label xx '(a b)) 7 | (label nfibs (lambda (n) 8 | (if (< n 2) n 9 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 10 | ) 11 | ) 12 | ) 13 | (label recurse (lambda (x) 14 | (cond ((nilp x) (quote stop)) 15 | (t (recurse (cdr x))) 16 | ) 17 | ) 18 | ) 19 | (recurse (a b c d e f)) 20 | (nfibs 10) 21 | (define n 5) 22 | (loop (> n 0) 23 | (progn 24 | (print n) 25 | (define n (- n 1)) 26 | (terpri 1) 27 | ) 28 | ) 29 | (ff '(a b) (cdr '(c d))) 30 | ((lambda (x y) (cons (car x) y)) '(a b) (cdr '(c d))) 31 | (atom "a") 32 | (atom 1) 33 | (atom nil) 34 | (equal "a" "a") 35 | (equal "a" "b") 36 | (equal "1" 1) 37 | (car '(a b c)) 38 | (cdr '(a b c)) 39 | (cons "a" (cons "b" nil)) 40 | (quote (car '(a b c))) 41 | (cond ((= 1 1) (quote stop)) 42 | (t (quote hi )) 43 | ) 44 | (label n 1) 45 | (eval 'n) 46 | (nilp nil) 47 | (nilp "a") 48 | (append '(1 2 3) '(4 5 6)) 49 | (concat '(1 2) '(3 4)) 50 | (block (+ 1 2) (+ 2 3) (+ 3 4)) 51 | (progn (+ 1 2) (+ 2 3) (+ 3 4)) 52 | (if (= 1 1) t nil) 53 | (if (= 1 2) t nil) 54 | (print '(1 2 3 4)) 55 | (terpri 1) 56 | (< 2 1) 57 | (< 1 2) 58 | (> 1 2) 59 | (> 2 1) 60 | (+ 1 1) 61 | (- 4 2) 62 | (/ 10 5) 63 | (* 3 3) 64 | (= 2 3) 65 | (= 2 2) 66 | 67 | 68 | (cond ((atom 'a) 'b) (t 'c)) 69 | (equal (car '(a b)) 'a) 70 | (equal 1 1) 71 | (cons 'a '(b c)) 72 | (cond ( nil 'b) (t 'c)) 73 | 74 | (cond ( nil (quote b)) (t (quote c))) 75 | (equal t t) 76 | (ff '(a b) (cdr '(c d))) 77 | -------------------------------------------------------------------------------- /plisp-initial/code/p4.lisp: -------------------------------------------------------------------------------- 1 | 2 | (label ff (lambda (x y) 3 | (cons (car x) y) 4 | ) 5 | ) 6 | (label xx '(a b)) 7 | (label nfibs (lambda (n) 8 | (if (< n 2) n 9 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 10 | ) 11 | ) 12 | ) 13 | (label recurse (lambda (x) 14 | (cond ((nilp x) (quote stop)) 15 | (t (recurse (cdr x))) 16 | ) 17 | ) 18 | ) 19 | (recurse (a b c d e f)) 20 | (nfibs 10) 21 | (define n 5) 22 | (loop (> n 0) 23 | (progn 24 | (print n) 25 | (define n (- n 1)) 26 | (terpri 1) 27 | ) 28 | ) 29 | (ff '(a b) (cdr '(c d))) 30 | ((lambda (x y) (cons (car x) y)) '(a b) (cdr '(c d))) 31 | (atom "a") 32 | (atom 1) 33 | (atom nil) 34 | (equal "a" "a") 35 | (equal "a" "b") 36 | (equal "1" 1) 37 | (car '(a b c)) 38 | (cdr '(a b c)) 39 | (cons "a" (cons "b" nil)) 40 | (quote (car '(a b c))) 41 | (cond ((= 1 1) (quote stop)) 42 | (t (quote hi )) 43 | ) 44 | (label n 1) 45 | (eval 'n) 46 | (nilp nil) 47 | (nilp "a") 48 | (append '(1 2 3) '(4 5 6)) 49 | (concat '(1 2) '(3 4)) 50 | (block (+ 1 2) (+ 2 3) (+ 3 4)) 51 | (progn (+ 1 2) (+ 2 3) (+ 3 4)) 52 | (if (= 1 1) t nil) 53 | (if (= 1 2) t nil) 54 | (print '(1 2 3 4)) 55 | (terpri 1) 56 | (< 2 1) 57 | (< 1 2) 58 | (> 1 2) 59 | (> 2 1) 60 | (+ 1 1) 61 | (- 4 2) 62 | (/ 10 5) 63 | (* 3 3) 64 | (= 2 3) 65 | (= 2 2) 66 | 67 | (equal nil nil) 68 | (cdr xx) 69 | (car xx) 70 | (car '(a b c)) 71 | (cdr '(a b c)) 72 | (equal t t) 73 | (atom 'a) 74 | 75 | 'a 76 | (equal (car (cdr '(a b))) 'a) 77 | -------------------------------------------------------------------------------- /plisp-initial/code/p5.lisp: -------------------------------------------------------------------------------- 1 | 2 | (label ff (lambda (x y) 3 | (cons (car x) y) 4 | ) 5 | ) 6 | (label xx '(a b)) 7 | (label nfibs (lambda (n) 8 | (if (< n 2) n 9 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 10 | ) 11 | ) 12 | ) 13 | (label recurse (lambda (x) 14 | (cond ((nilp x) (quote stop)) 15 | (t (recurse (cdr x))) 16 | ) 17 | ) 18 | ) 19 | (recurse (a b c d e f)) 20 | (nfibs 10) 21 | (define n 5) 22 | (loop (> n 0) 23 | (progn 24 | (print n) 25 | (define n (- n 1)) 26 | (terpri 1) 27 | ) 28 | ) 29 | (ff '(a b) (cdr '(c d))) 30 | ((lambda (x y) (cons (car x) y)) '(a b) (cdr '(c d))) 31 | (atom "a") 32 | (atom 1) 33 | (atom nil) 34 | (equal "a" "a") 35 | (equal "a" "b") 36 | (equal "1" 1) 37 | (car '(a b c)) 38 | (cdr '(a b c)) 39 | (cons "a" (cons "b" nil)) 40 | (quote (car '(a b c))) 41 | (cond ((= 1 1) (quote stop)) 42 | (t (quote hi )) 43 | ) 44 | (label n 1) 45 | (eval 'n) 46 | (nilp nil) 47 | (nilp "a") 48 | (append '(1 2 3) '(4 5 6)) 49 | (concat '(1 2) '(3 4)) 50 | (block (+ 1 2) (+ 2 3) (+ 3 4)) 51 | (progn (+ 1 2) (+ 2 3) (+ 3 4)) 52 | (if (= 1 1) t nil) 53 | (if (= 1 2) t nil) 54 | (print '(1 2 3 4)) 55 | (terpri 1) 56 | (< 2 1) 57 | (< 1 2) 58 | (> 1 2) 59 | (> 2 1) 60 | (+ 1 1) 61 | (- 4 2) 62 | (/ 10 5) 63 | (* 3 3) 64 | (= 2 3) 65 | (= 2 2) 66 | 67 | 'a 68 | (equal t t) 69 | ((lambda (x y) (cons (car x) y)) '(a b) (cdr '(c d))) 70 | (cond ((atom 'a) 'b) (t 'c)) 71 | 72 | 73 | (equal nil nil) 74 | (equal (car (cdr '(a b))) 'a) 75 | (cons 'a '(b c)) 76 | (equal 1 1) 77 | -------------------------------------------------------------------------------- /plisp-initial/code/p6.lisp: -------------------------------------------------------------------------------- 1 | 2 | (label ff (lambda (x y) 3 | (cons (car x) y) 4 | ) 5 | ) 6 | (label xx '(a b)) 7 | (label nfibs (lambda (n) 8 | (if (< n 2) n 9 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 10 | ) 11 | ) 12 | ) 13 | (label recurse (lambda (x) 14 | (cond ((nilp x) (quote stop)) 15 | (t (recurse (cdr x))) 16 | ) 17 | ) 18 | ) 19 | (recurse (a b c d e f)) 20 | (nfibs 10) 21 | (define n 5) 22 | (loop (> n 0) 23 | (progn 24 | (print n) 25 | (define n (- n 1)) 26 | (terpri 1) 27 | ) 28 | ) 29 | (ff '(a b) (cdr '(c d))) 30 | ((lambda (x y) (cons (car x) y)) '(a b) (cdr '(c d))) 31 | (atom "a") 32 | (atom 1) 33 | (atom nil) 34 | (equal "a" "a") 35 | (equal "a" "b") 36 | (equal "1" 1) 37 | (car '(a b c)) 38 | (cdr '(a b c)) 39 | (cons "a" (cons "b" nil)) 40 | (quote (car '(a b c))) 41 | (cond ((= 1 1) (quote stop)) 42 | (t (quote hi )) 43 | ) 44 | (label n 1) 45 | (eval 'n) 46 | (nilp nil) 47 | (nilp "a") 48 | (append '(1 2 3) '(4 5 6)) 49 | (concat '(1 2) '(3 4)) 50 | (block (+ 1 2) (+ 2 3) (+ 3 4)) 51 | (progn (+ 1 2) (+ 2 3) (+ 3 4)) 52 | (if (= 1 1) t nil) 53 | (if (= 1 2) t nil) 54 | (print '(1 2 3 4)) 55 | (terpri 1) 56 | (< 2 1) 57 | (< 1 2) 58 | (> 1 2) 59 | (> 2 1) 60 | (+ 1 1) 61 | (- 4 2) 62 | (/ 10 5) 63 | (* 3 3) 64 | (= 2 3) 65 | (= 2 2) 66 | 67 | ((lambda (x y) (cons (car x) y)) '(a b) (cdr '(c d))) 68 | (cdr xx) 69 | (cond ((atom 'a) 'b) (t 'c)) 70 | (equal t t) 71 | 72 | (cdr '(a b c)) 73 | (equal (car '(a b)) 'a) 74 | (car xx) 75 | (ff '(a b) (cdr '(c d))) 76 | 'a 77 | -------------------------------------------------------------------------------- /plisp-initial/code/p7.lisp: -------------------------------------------------------------------------------- 1 | 2 | (label ff (lambda (x y) 3 | (cons (car x) y) 4 | ) 5 | ) 6 | (label xx '(a b)) 7 | (label nfibs (lambda (n) 8 | (if (< n 2) n 9 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 10 | ) 11 | ) 12 | ) 13 | (label recurse (lambda (x) 14 | (cond ((nilp x) (quote stop)) 15 | (t (recurse (cdr x))) 16 | ) 17 | ) 18 | ) 19 | (recurse (a b c d e f)) 20 | (nfibs 10) 21 | (define n 5) 22 | (loop (> n 0) 23 | (progn 24 | (print n) 25 | (define n (- n 1)) 26 | (terpri 1) 27 | ) 28 | ) 29 | (ff '(a b) (cdr '(c d))) 30 | ((lambda (x y) (cons (car x) y)) '(a b) (cdr '(c d))) 31 | (atom "a") 32 | (atom 1) 33 | (atom nil) 34 | (equal "a" "a") 35 | (equal "a" "b") 36 | (equal "1" 1) 37 | (car '(a b c)) 38 | (cdr '(a b c)) 39 | (cons "a" (cons "b" nil)) 40 | (quote (car '(a b c))) 41 | (cond ((= 1 1) (quote stop)) 42 | (t (quote hi )) 43 | ) 44 | (label n 1) 45 | (eval 'n) 46 | (nilp nil) 47 | (nilp "a") 48 | (append '(1 2 3) '(4 5 6)) 49 | (concat '(1 2) '(3 4)) 50 | (block (+ 1 2) (+ 2 3) (+ 3 4)) 51 | (progn (+ 1 2) (+ 2 3) (+ 3 4)) 52 | (if (= 1 1) t nil) 53 | (if (= 1 2) t nil) 54 | (print '(1 2 3 4)) 55 | (terpri 1) 56 | (< 2 1) 57 | (< 1 2) 58 | (> 1 2) 59 | (> 2 1) 60 | (+ 1 1) 61 | (- 4 2) 62 | (/ 10 5) 63 | (* 3 3) 64 | (= 2 3) 65 | (= 2 2) 66 | 67 | '(a b c) 68 | (cons 'a '(b c)) 69 | (ff '(a b) (cdr '(c d))) 70 | (cond ( nil 'b) (t 'c)) 71 | (cdr xx) 72 | (cdr '(a b c)) 73 | (equal (car '(a b)) 'a) 74 | (cond ((atom 'a) 'b) (t 'c)) 75 | (equal (car (cdr '(a b))) 'a) 76 | 77 | -------------------------------------------------------------------------------- /plisp-initial/code/p8.lisp: -------------------------------------------------------------------------------- 1 | 2 | (label ff (lambda (x y) 3 | (cons (car x) y) 4 | ) 5 | ) 6 | (label xx '(a b)) 7 | (label nfibs (lambda (n) 8 | (if (< n 2) n 9 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 10 | ) 11 | ) 12 | ) 13 | (label recurse (lambda (x) 14 | (cond ((nilp x) (quote stop)) 15 | (t (recurse (cdr x))) 16 | ) 17 | ) 18 | ) 19 | (recurse (a b c d e f)) 20 | (nfibs 10) 21 | (define n 5) 22 | (loop (> n 0) 23 | (progn 24 | (print n) 25 | (define n (- n 1)) 26 | (terpri 1) 27 | ) 28 | ) 29 | (ff '(a b) (cdr '(c d))) 30 | ((lambda (x y) (cons (car x) y)) '(a b) (cdr '(c d))) 31 | (atom "a") 32 | (atom 1) 33 | (atom nil) 34 | (equal "a" "a") 35 | (equal "a" "b") 36 | (equal "1" 1) 37 | (car '(a b c)) 38 | (cdr '(a b c)) 39 | (cons "a" (cons "b" nil)) 40 | (quote (car '(a b c))) 41 | (cond ((= 1 1) (quote stop)) 42 | (t (quote hi )) 43 | ) 44 | (label n 1) 45 | (eval 'n) 46 | (nilp nil) 47 | (nilp "a") 48 | (append '(1 2 3) '(4 5 6)) 49 | (concat '(1 2) '(3 4)) 50 | (block (+ 1 2) (+ 2 3) (+ 3 4)) 51 | (progn (+ 1 2) (+ 2 3) (+ 3 4)) 52 | (if (= 1 1) t nil) 53 | (if (= 1 2) t nil) 54 | (print '(1 2 3 4)) 55 | (terpri 1) 56 | (< 2 1) 57 | (< 1 2) 58 | (> 1 2) 59 | (> 2 1) 60 | (+ 1 1) 61 | (- 4 2) 62 | (/ 10 5) 63 | (* 3 3) 64 | (= 2 3) 65 | (= 2 2) 66 | 67 | (equal (car '(a b)) 'a) 68 | (cond ((atom 'a) 'b) (t 'c)) 69 | (equal t t) 70 | (atom 'a) 71 | (ff '(a b) (cdr '(c d))) 72 | (equal (car (cdr '(a b))) 'a) 73 | (equal nil nil) 74 | (cond ( nil (quote b)) (t (quote c))) 75 | (car '(a b c)) 76 | (cons 'a '(b c)) 77 | -------------------------------------------------------------------------------- /plisp-initial/code/p9.lisp: -------------------------------------------------------------------------------- 1 | 2 | (label ff (lambda (x y) 3 | (cons (car x) y) 4 | ) 5 | ) 6 | (label xx '(a b)) 7 | (label nfibs (lambda (n) 8 | (if (< n 2) n 9 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 10 | ) 11 | ) 12 | ) 13 | (label recurse (lambda (x) 14 | (cond ((nilp x) (quote stop)) 15 | (t (recurse (cdr x))) 16 | ) 17 | ) 18 | ) 19 | (recurse (a b c d e f)) 20 | (nfibs 10) 21 | (define n 5) 22 | (loop (> n 0) 23 | (progn 24 | (print n) 25 | (define n (- n 1)) 26 | (terpri 1) 27 | ) 28 | ) 29 | (ff '(a b) (cdr '(c d))) 30 | ((lambda (x y) (cons (car x) y)) '(a b) (cdr '(c d))) 31 | (atom "a") 32 | (atom 1) 33 | (atom nil) 34 | (equal "a" "a") 35 | (equal "a" "b") 36 | (equal "1" 1) 37 | (car '(a b c)) 38 | (cdr '(a b c)) 39 | (cons "a" (cons "b" nil)) 40 | (quote (car '(a b c))) 41 | (cond ((= 1 1) (quote stop)) 42 | (t (quote hi )) 43 | ) 44 | (label n 1) 45 | (eval 'n) 46 | (nilp nil) 47 | (nilp "a") 48 | (append '(1 2 3) '(4 5 6)) 49 | (concat '(1 2) '(3 4)) 50 | (block (+ 1 2) (+ 2 3) (+ 3 4)) 51 | (progn (+ 1 2) (+ 2 3) (+ 3 4)) 52 | (if (= 1 1) t nil) 53 | (if (= 1 2) t nil) 54 | (print '(1 2 3 4)) 55 | (terpri 1) 56 | (< 2 1) 57 | (< 1 2) 58 | (> 1 2) 59 | (> 2 1) 60 | (+ 1 1) 61 | (- 4 2) 62 | (/ 10 5) 63 | (* 3 3) 64 | (= 2 3) 65 | (= 2 2) 66 | 67 | 'a 68 | (equal (car '(a b)) 'a) 69 | (cond ( nil 'b) (t 'c)) 70 | (cond ( nil (quote b)) (t (quote c))) 71 | (atom 'a) 72 | ((lambda (x y) (cons (car x) y)) '(a b) (cdr '(c d))) 73 | (ff '(a b) (cdr '(c d))) 74 | (cond ((atom 'a) 'b) (t 'c)) 75 | (equal (car (cdr '(a b))) 'a) 76 | (cons 'a '(b c)) 77 | -------------------------------------------------------------------------------- /plisp-initial/common.h: -------------------------------------------------------------------------------- 1 | #include "defines.h" 2 | #include "structures.h" 3 | #include "globals.h" -------------------------------------------------------------------------------- /plisp-initial/defines.h: -------------------------------------------------------------------------------- 1 | #if EPIPHANY 2 | #define DIRECTIVE __attribute__((aligned(8))) 3 | #else 4 | #define DIRECTIVE 5 | #endif 6 | 7 | #define TRUE 1 8 | #define FALSE 0 9 | 10 | #define NCORES 16 11 | #define BANKSIZE 8192 12 | #define STRINGMAX BANKSIZE 13 | #define NAMESTRMAX 22 14 | #define LINELENGTH 1024 15 | 16 | #define FREESTRING 10 17 | #define FREEOBJECT 10000 18 | #define FREENAME 10000 19 | 20 | #define BUF_ADDRESS 0x8f000000 21 | 22 | #define is == 23 | #define isnt != 24 | #define not ! 25 | #define and && 26 | #define or || 27 | #define in , 28 | 29 | #define forlist(...) forlist_xp(forlist_in, (__VA_ARGS__)) 30 | #define forlist_in(X, S) for(node *X = S; X isnt NULLPTR; nextptr(X)) 31 | #define forlist_xp(X, A) X A 32 | 33 | #define forlist2(...) forlist_xp(forlist_in2, (__VA_ARGS__)) 34 | #define forlist_in2(X, S, XX, SS) for(node *X = S, *XX = SS; X isnt NULLPTR and XX isnt NULLPTR; nextptr(X), nextptr(XX)) 35 | 36 | #define forheap(...) forlist_xp(forheap_in, (__VA_ARGS__)) 37 | #define forheap_in(X, S) for(node *X = S; X isnt NULLPTR; X = next(X)) 38 | 39 | #define PERMANENT 2 40 | 41 | #define EOS '\0' 42 | #define EOSP(X) ((X) is EOS) 43 | #define nullp(X) ((X) is NULLPTR) 44 | 45 | #define ppval(X) (**(X)) 46 | #define ppdec(X) ((*(X))--) 47 | #define ppvalinc(X) (*(*(X))++) 48 | #define ppinc(X) (*(X))++ 49 | 50 | #define nextptr(X) ((X) = (X)->cdr) 51 | #define rplaca(X,Y) ((X)->car = (Y)) 52 | #define rplacd(X,Y) ((X)->cdr = (Y)) 53 | 54 | #define next(X) ((X)->next) 55 | #define type(X) ((X)->type) 56 | #define funcname(X) ((X)->fname->s) 57 | #define funcptr(X) ((X)->fn) 58 | #define largs(X) ((X)->args) 59 | #define lbody(X) ((X)->body) 60 | #define ival(X) ((X)->i) 61 | #define ebindings(X) ((X)->bindings) 62 | 63 | #define consp(X) ((X) and (X)->type is LIST) 64 | #define pairp(X) ((X) and (X)->type is PAIR) 65 | #define symp(X) ((X) and (X)->type is SYM) 66 | #define subrp(X) ((X) and (X)->type is SUBR) 67 | #define fsubrp(X) ((X) and (X)->type is FSUBR) 68 | #define lambdap(X) ((X) and (X)->type is LAMBDA) 69 | #define intp(X) ((X) and (X)->type is INT) 70 | #define nilp(X) ((X) and (X)->type is NIL) 71 | #define teep(X) ((X) and (X)->type is TEE) 72 | 73 | #define car(X) ((X)->car) 74 | #define cdr(X) ((X)->cdr) 75 | #define caar(X) (car(car(X))) 76 | #define cadar(X) (car(cdr(car(X)))) 77 | -------------------------------------------------------------------------------- /plisp-initial/fl-device.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | 7 | #if EPIPHANY 8 | #include "e-lib.h" 9 | #endif 10 | 11 | #include "common.h" 12 | #include "proto.h" 13 | 14 | #define BUF_ADDRESS 0x8f000000 15 | 16 | // 17 | // string i/o 18 | // 19 | void itos(int i, char *buf) { 20 | sprintf(buf, "%d", i); 21 | } 22 | 23 | int stoi(char* snum) { 24 | int i; 25 | sscanf(snum, "%d", &i); 26 | return i; 27 | } 28 | 29 | void appendString(char *item) { // add a string to the output 30 | for(char *s = item; *s != '\0'; s++) 31 | *result++ = *s; 32 | *result = '\0'; 33 | } 34 | 35 | void appendStrings(int count, ...) { 36 | va_list args; 37 | va_start(args, count); 38 | while (count--) 39 | appendString(va_arg(args, char *)); 40 | va_end(args); 41 | } 42 | 43 | void appendInt(int num, char bool) { 44 | char buf[NAMESTRMAX + 1]; 45 | itos(num, buf); 46 | appendString(buf); 47 | if (bool) appendString("\n"); 48 | } 49 | 50 | 51 | #if EPIPHANY 52 | void setflag() { 53 | unsigned *d; 54 | 55 | appendString("\nnode size: "); 56 | appendInt(sizeof(node), TRUE); 57 | appendString("strings allocated: "); 58 | appendInt(freeStringIndex, TRUE); 59 | appendString("node allocated: "); 60 | appendInt(freeNodeIndex, TRUE); 61 | appendString("names allocated: "); 62 | appendInt(freeNameIndex, TRUE); 63 | appendString("memory size: "); 64 | appendInt(sizeof(ememory), TRUE); 65 | 66 | memory->data[id].finished = 1; 67 | 68 | d = (unsigned *) 0x7000; 69 | (*(d)) = 0x00000001; 70 | 71 | __asm__ __volatile__("idle"); 72 | } 73 | #else 74 | void setflag() { 75 | 76 | appendString("\nnode size: "); 77 | appendInt(sizeof(node), TRUE); 78 | appendString("strings allocated: "); 79 | appendInt(freeStringIndex, TRUE); 80 | appendString("node allocated: "); 81 | appendInt(freeNodeIndex, TRUE); 82 | appendString("names allocated: "); 83 | appendInt(freeNameIndex, TRUE); 84 | appendString("memory size: "); 85 | appendInt(sizeof(ememory), TRUE); 86 | 87 | printf("%s", output); 88 | exit(0); 89 | } 90 | #endif 91 | 92 | // LISP Code 93 | 94 | #include "lisp.c" 95 | 96 | // End of LISP Code 97 | 98 | #if EPIPHANY 99 | 100 | int coreID(unsigned int *row, unsigned int *col) { 101 | 102 | e_coreid_t coreid; 103 | 104 | coreid = e_get_coreid(); 105 | coreid = coreid - e_group_config.group_id; 106 | *row = (coreid >> 6) & 0x3f; 107 | *col = coreid & 0x3f; 108 | 109 | return((*row * 4) + *col); 110 | } 111 | 112 | void coreInit() { 113 | 114 | memory = (ememory *)(BUF_ADDRESS); 115 | 116 | freeStringArray = &memory->data[id].freeStringArray[0]; 117 | freeNodeArray = &memory->data[id].freeNodeArray[0]; 118 | freeNameArray = &memory->data[id].freeNameArray[0]; 119 | 120 | } 121 | 122 | #else 123 | 124 | char *readFile(char *fileName) { 125 | FILE *file = fopen(fileName, "r"); 126 | string *code; 127 | size_t n = 0; 128 | int c; 129 | if (file == NULL) return NULL; 130 | code = smalloc(); 131 | while ((c = fgetc(file)) != EOF) 132 | code->s[n++] = (char)c; 133 | code->s[n] = '\0'; 134 | return code->s; 135 | } 136 | 137 | int coreID(unsigned int *row, unsigned int *col) { 138 | 139 | *row = 1; 140 | *col = 1; 141 | 142 | return((*row * 4) + *col); 143 | } 144 | 145 | void coreInit(void) { 146 | char *code; 147 | 148 | memory = (ememory *)malloc(sizeof(ememory)); 149 | 150 | freeStringArray = &memory->data[id].freeStringArray[0]; 151 | freeNodeArray = &memory->data[id].freeNodeArray[0]; 152 | freeNameArray = &memory->data[id].freeNameArray[0]; 153 | 154 | code = readFile("code/p2.lisp"); 155 | sprintf(memory->data[id].code, "%s", code); 156 | } 157 | 158 | #endif 159 | 160 | int main(void) { 161 | unsigned int row, col; 162 | char tmpbuf[16]; 163 | 164 | id = coreID(&row, &col); 165 | 166 | coreInit(); 167 | 168 | 169 | input = &memory->data[id].code[0]; 170 | output = &memory->data[id].output[0]; 171 | 172 | result = output; 173 | memset(output, 0, BANKSIZE); 174 | 175 | appendInt(id, TRUE); 176 | sprintf(tmpbuf, "(%d, %d)\n", row + 1, col + 1); 177 | appendString(tmpbuf); 178 | 179 | REPL(input); 180 | 181 | setflag(); 182 | 183 | return 0; 184 | } 185 | -------------------------------------------------------------------------------- /plisp-initial/fl-host.c: -------------------------------------------------------------------------------- 1 | #define EPIPHANY 1 2 | 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include "common.h" 10 | 11 | #define _BufOffset (0x01000000) 12 | 13 | char *readFile(char *fileName) { 14 | FILE *file = fopen(fileName, "r"); 15 | char *code; 16 | size_t n = 0; 17 | int c; 18 | if (file == NULL) return NULL; 19 | code = malloc(BANKSIZE); 20 | while ((c = fgetc(file)) != EOF && n < BANKSIZE-1) 21 | code[n++] = (char)c; 22 | code[n] = '\0'; 23 | fclose(file); 24 | return code; 25 | } 26 | 27 | int main(void) { 28 | char *code, filename[64]; 29 | int done[16], all_done, i, j, rows, cols, id; 30 | e_platform_t platform; 31 | e_epiphany_t dev; 32 | e_mem_t emem; 33 | ememory memory; 34 | unsigned int clr = (unsigned int)0x00000000; 35 | 36 | memset(&memory, 0, sizeof(ememory)); 37 | 38 | for(i=0; i 5 and "e-lib" not in line: 24 | prfile(line) 25 | else: 26 | out.write(line) 27 | fp.close() 28 | out.close() 29 | -------------------------------------------------------------------------------- /plisp-initial/proto.h: -------------------------------------------------------------------------------- 1 | /* fl-device.c */ 2 | void itos(int i, char *buf); 3 | int stoi(char *snum); 4 | void appendString(char *item); 5 | void appendStrings(int count, ...); 6 | void appendInt(int num, char bool); 7 | void setflag(void); 8 | string *smalloc(void); 9 | namestr *nmalloc(void); 10 | node *omalloc(void); 11 | node *newnode(enum ltype type); 12 | node *sym(char *n); 13 | node *cons(node *head, node *tail); 14 | node *pair(node *head, node *tail); 15 | node *func(node *(*fn)(node *, node *), enum ltype type); 16 | node *lambda(node *args, node *sexp); 17 | node *integer(int num); 18 | node *newcontext(node *bindings); 19 | void clear_bindings(node *env); 20 | node *lastcell(node *list); 21 | node *append(node *list, node *obj); 22 | node *concat(node *l1, node *l2); 23 | void atl(node **l, node *item); 24 | void add_pair(node *head, node *tail, node **list); 25 | void pushNode(node *item, node **stk); 26 | node *popNode(node **stk); 27 | node *nextarg(node **pargs); 28 | char *name(node *o); 29 | node *assq(char *key, node *list); 30 | node *lookupsym(char *name, node *env); 31 | node *make_env(node *vars, node *vals, node *env); 32 | node *el_car(node *args, node *env); 33 | node *el_cdr(node *args, node *env); 34 | node *el_nilp(node *args, node *env); 35 | node *el_quote(node *args, node *env); 36 | node *el_cons(node *args, node *env); 37 | node *el_equal(node *args, node *env); 38 | node *el_atom(node *args, node *env); 39 | node *el_cond(node *args, node *env); 40 | node *el_if(node *args, node *env); 41 | node *el_lambda(node *args, node *env); 42 | node *el_label(node *args, node *env); 43 | node *el_ldefine(node *args, node *env); 44 | node *el_append(node *args, node *env); 45 | node *el_concat(node *args, node *env); 46 | node *el_loop(node *args, node *env); 47 | node *el_block(node *args, node *env); 48 | node *el_progn(node *args, node *env); 49 | node *el_print(node *args, node *env); 50 | node *el_terpri(node *args, node *env); 51 | node *binary(node *args, int fcn); 52 | node *compare(node *args, int fcn); 53 | node *el_lessthan(node *args, node *env); 54 | node *el_greaterthan(node *args, node *env); 55 | node *el_eq(node *args, node *env); 56 | node *el_plus(node *args, node *env); 57 | node *el_minus(node *args, node *env); 58 | node *el_times(node *args, node *env); 59 | node *el_divide(node *args, node *env); 60 | node *init_lisp(void); 61 | void nl(void); 62 | void prpair(node *l); 63 | void print(node *l); 64 | int getChar(char **s); 65 | int ungetChar(char **s); 66 | char *getToken(char **s, char *token); 67 | node *tokenize(char **code); 68 | int equal(node *sym, char *s2); 69 | int is_valid_int(char *str); 70 | node *makeNode(node *n); 71 | node *_parse(node **code, char *terminator); 72 | node *parse(node **code); 73 | node *parse_string(char **input); 74 | int length(node *l); 75 | node *evlambda(node *vals, node *expr, node *env); 76 | node *evform(node *fnode, node *exp, node *env); 77 | node *evsym(node *exp, node *env); 78 | node *eval_list(node *sexp, node *env); 79 | node *eval(node *input, node *env); 80 | void REPL(char *input); 81 | char *readFile(char *fileName); 82 | int coreID(unsigned int *row, unsigned int *col); 83 | void coreInit(void); 84 | int main(void); 85 | -------------------------------------------------------------------------------- /plisp-initial/run.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | ESDK=${EPIPHANY_HOME} 4 | ELIBS=${ESDK}/tools/host/lib:${LD_LIBRARY_PATH} 5 | EHDF=${EPIPHANY_HDF} 6 | ELDF=${ESDK}/bsps/current/internal.ldf 7 | 8 | SCRIPT=$(readlink -f "$0") 9 | EXEPATH=$(dirname "$SCRIPT") 10 | 11 | { 12 | $EXEPATH/fl-host.elf $* 13 | } || { 14 | sudo -E LD_LIBRARY_PATH=${ELIBS} EPIPHANY_HDF=${EHDF} $EXEPATH/fl-host.elf $* 15 | } 16 | 17 | if [ $? -ne 0 ] 18 | then 19 | echo "$SCRIPT FAILED" 20 | else 21 | echo "$SCRIPT PASSED" 22 | fi 23 | -------------------------------------------------------------------------------- /plisp-initial/structures.h: -------------------------------------------------------------------------------- 1 | enum ltype {PAIR, LIST, SYM, SUBR, FSUBR, LAMBDA, INT, NIL, TEE, ENV}; 2 | 3 | typedef struct DIRECTIVE fdef fdef; 4 | typedef struct DIRECTIVE node node; 5 | 6 | typedef struct DIRECTIVE string string; 7 | typedef struct DIRECTIVE namestr namestr; 8 | typedef struct DIRECTIVE edata edata; 9 | typedef struct DIRECTIVE ememory ememory; 10 | 11 | struct DIRECTIVE node { 12 | enum ltype type; 13 | union { 14 | namestr *name; 15 | struct { 16 | node *car; 17 | node *cdr; 18 | }; 19 | struct { 20 | namestr *fname; 21 | node *(*fn)(node *, node *); 22 | }; 23 | struct { 24 | node *args; 25 | node *body; 26 | }; 27 | long i; 28 | double r; 29 | struct { 30 | node *top; 31 | node *bindings; 32 | }; 33 | }; 34 | }; 35 | 36 | struct DIRECTIVE string { 37 | char s[STRINGMAX]; 38 | }; 39 | 40 | struct DIRECTIVE namestr { 41 | char s[NAMESTRMAX]; 42 | }; 43 | 44 | struct DIRECTIVE fdef { 45 | const char *fname; 46 | int type; 47 | node *(*fn)(node *, node *); 48 | }; 49 | 50 | struct DIRECTIVE edata { 51 | int row; 52 | int col; 53 | int id; 54 | int finished; 55 | char code[BANKSIZE]; 56 | char output[BANKSIZE]; 57 | string freeStringArray[FREESTRING]; 58 | node freeNodeArray[FREEOBJECT]; 59 | namestr freeNameArray[FREENAME]; 60 | }; 61 | 62 | struct DIRECTIVE ememory { 63 | char code[BANKSIZE]; 64 | edata data[NCORES]; 65 | }; 66 | -------------------------------------------------------------------------------- /plisp/Makefile: -------------------------------------------------------------------------------- 1 | 2 | all: gencode fl onefile 3 | rm -f Trace.out 4 | 5 | build: 6 | (cd code; python gencode.py) 7 | bash ./build.sh 8 | 9 | run: 10 | (cd code; python gencode.py) 11 | bash ./run.sh 12 | 13 | gencode: 14 | (cd code; python gencode.py) 15 | 16 | fl: force 17 | rm -f fl fl.exe 18 | gcc -Os -std=gnu99 -Wall -o fl device_main.c libdevice.c libplisp.c 19 | 20 | onefile: force 21 | python onefile.py > onefile.c 22 | rm -f onefile onefile.exe 23 | gcc -Os -std=gnu99 -o onefile onefile.c 24 | wc -l onefile.c 25 | 26 | proto: 27 | cproto device_main.c libdevice.c libplisp.c > device_proto.h 28 | cproto -I/opt/adapteva/esdk/tools/host.armv7l/include host_main.c libhost.c > host_proto.h 29 | 30 | force: 31 | 32 | clean: 33 | rm -f fl onefile initmem *.elf *.srec *.o *.exe* Trace.out 34 | -------------------------------------------------------------------------------- /plisp/build.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | set -e 4 | 5 | ESDK=${EPIPHANY_HOME} 6 | ELIBS=${ESDK}/tools/host/lib 7 | EINCS=${ESDK}/tools/host/include 8 | ELDF=${ESDK}/bsps/current/fast.ldf 9 | 10 | SCRIPT=$(readlink -f "$0") 11 | EXEPATH=$(dirname "$SCRIPT") 12 | cd $EXEPATH 13 | 14 | CROSS_PREFIX= 15 | case $(uname -p) in 16 | arm*) 17 | # Use native arm compiler (no cross prefix) 18 | CROSS_PREFIX= 19 | ;; 20 | *) 21 | # Use cross compiler 22 | CROSS_PREFIX="arm-linux-gnueabihf-" 23 | ;; 24 | esac 25 | 26 | ${CROSS_PREFIX}gcc -Os -std=gnu99 -Wno-format-security host_main.c libhost.c -o fl-host.elf -I ${EINCS} -L ${ELIBS} -le-hal -le-loader -lpthread 27 | 28 | e-gcc -Os -DEPIPHANY=1 -std=gnu99 -T ${ELDF} device_main.c libdevice.c libplisp.c -o fl-device.elf -le-lib 29 | 30 | e-objcopy --srec-forceS3 --output-target srec fl-device.elf fl-device.srec 31 | 32 | -------------------------------------------------------------------------------- /plisp/code/Makefile: -------------------------------------------------------------------------------- 1 | 2 | all: 3 | python gencode.py 4 | -------------------------------------------------------------------------------- /plisp/code/input.lisp: -------------------------------------------------------------------------------- 1 | (label nfibs 2 | (lambda (n) 3 | (if (< n 2) 4 | n 5 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 6 | ) 7 | ) 8 | ) 9 | (label recurse (lambda (x) 10 | (cond ((equal (car x) end) 'stop) 11 | (t (recurse (cdr x))) 12 | ) 13 | ) 14 | ) 15 | (recurse (a b c d e f end)) 16 | (nfibs 10) 17 | 18 | (label ff (lambda (x y) 19 | (cons (car x) y) 20 | ) 21 | ) 22 | 'a 23 | '(a b c) 24 | (car '(a b c)) 25 | (cdr '(a b c)) 26 | (cons 'a '(b c)) 27 | (equal (car '(a b)) 'a) 28 | (equal (car (cdr '(a b))) 'a) 29 | (atom 'a) 30 | (cond ((atom '(1 2)) 'b) (t 'c)) 31 | (cond (nil 10) (t 20)) 32 | ((lambda (x y) (cons (car x) y)) '(a b) (cdr '(c d))) 33 | (ff '(a b) (cdr '(c d))) 34 | (label xx '(a b)) 35 | (car xx) 36 | (label xx '(c d)) 37 | (car xx) 38 | -------------------------------------------------------------------------------- /plisp/code/p0.lisp: -------------------------------------------------------------------------------- 1 | 2 | (defun nfibs (n) 3 | (if (< n 2) n 4 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 5 | ) 6 | ) 7 | 8 | (defun member (a lat) 9 | (cond ((null lat) nil) 10 | ((eq (car lat) a) t) 11 | (t (member a (cdr lat))) 12 | ) 13 | ) 14 | 15 | (defun rember (a lat) 16 | (cond ((null lat) ()) 17 | ((eq (car lat) a) (cdr lat)) 18 | (t (cons (car lat) (rember a (cdr lat)))) 19 | ) 20 | ) 21 | 22 | (defun eqn (n1 n2) 23 | (cond ((zerop n2) (zerop n1)) 24 | ((zerop n1) nil) 25 | (t (eqn (sub1 n1) (sub1 n2))) 26 | ) 27 | ) 28 | 29 | (defun multiins (old new lat) 30 | (cond ((null lat) ()) 31 | ((eq (car lat) old) (cons (car lat) 32 | (cons new (multiins old new (cdr lat))))) 33 | (t (cons (car lat) (multiins old new (cdr lat)))) 34 | ) 35 | ) 36 | 37 | (defun mapcar (fn x) 38 | (cond ((null x) nil) 39 | (t (cons (funcall fn (car x)) (mapcar fn (cdr x)))) 40 | ) 41 | ) 42 | 43 | (defun maplist (fn x) 44 | (cond ((null x) nil) 45 | (t (cons (funcall fn x) (maplist fn (cdr x)))) 46 | ) 47 | ) 48 | 49 | (defun map (f lst) 50 | (if (atom lst) lst 51 | (cons (f (car lst)) (map f (cdr lst))))) 52 | 53 | (defun mycar (x) (car x)) 54 | (defun mycdr (x) (cdr x)) 55 | 56 | (defun pow (n1 n2) 57 | (cond ((zerop n2) 1) 58 | (t (times n1 (pow n1 (sub1 n2)))) 59 | ) 60 | ) 61 | 62 | (defun double (n) (times n 2)) 63 | (defun square (n) (times n n)) 64 | (defun testfun (n) 65 | (funcall (cond ((greaterp n 100) 'double) 66 | (t 'square) ) 67 | n) 68 | ) 69 | 70 | (defun subst (old new lat) 71 | (cond ((null lat) ()) 72 | ((eq (car lat) old) (cons new (cdr lat))) 73 | (t (cons (car lat) (subst old new (cdr lat)))) 74 | ) 75 | ) 76 | 77 | (defun length (lat) 78 | (cond ((null lat) 0) 79 | (t (add1 (length (cdr lat)))) 80 | ) 81 | ) 82 | 83 | (defun intersect (set1 set2) 84 | (cond ((null set1) ()) 85 | ((member (car set1) set2) (cons (car set1) (intersect (cdr set1) set2))) 86 | (t (intersect (cdr set1) set2)) 87 | ) 88 | ) 89 | 90 | (defun factorial (n) 91 | (cond ((= n 1) 1) 92 | (t (* n (factorial (- n 1)))) 93 | ) 94 | ) 95 | 96 | (defun rem (x d) 97 | (- x (* (/ x d) d))) 98 | 99 | (defun is-even (x) 100 | (if (= 0 (rem x 2)) 101 | t 102 | nil)) 103 | 104 | (defun is-odd (x) 105 | (if (is-even x) 106 | nil 107 | t)) 108 | 109 | (defun is-divisible (x y) 110 | (if (= y 1) 111 | nil 112 | (if (>= y x) 113 | nil 114 | (if (= 0 (rem x y)) 115 | t 116 | nil)))) 117 | 118 | (defun is-prime (x) 119 | (if (is-even x) 120 | nil 121 | (is-prime-rec x 1))) 122 | 123 | (defun is-prime-rec 124 | (x y) 125 | (if (is-divisible x y) 126 | nil 127 | (if (>= y x) 128 | t 129 | (is-prime-rec x (+ 2 y))))) 130 | 131 | (defun gcd (x y) 132 | (cond 133 | ((= y 0) x) 134 | (t (gcd y (rem x y))))) 135 | 136 | (defun lcm (x y) 137 | (/ (abs (* x y)) (gcd x y))) 138 | 139 | (defun nth (lis n) 140 | (if (= n 0) 141 | (car lis) 142 | (nth (cdr lis) (- n 1)) 143 | ) 144 | ) 145 | 146 | (defun nthcdr (lst n) 147 | (if (<= n 0) lst 148 | (nthcdr (cdr lst) (- n 1)))) 149 | 150 | (defun list-ref (lst n) 151 | (car (nthcdr lst n))) 152 | 153 | (defun filter (pred lst) 154 | (cond ((null lst) ()) 155 | ((not (pred (car lst))) (filter pred (cdr lst))) 156 | (t (cons (car lst) (filter pred (cdr lst)))))) 157 | 158 | (defun caar (x) (car (car x))) 159 | 160 | (defun assoc (item lst) 161 | (cond ((atom lst) ()) 162 | ((eq (caar lst) item) (car lst)) 163 | (t (assoc item (cdr lst))))) 164 | 165 | (defun sum-to-n (n) 166 | (cond 167 | ((< n 0) 0) 168 | (t (+ n (sum-to-n (- n 1)))))) 169 | 170 | (defun gauss (n) 171 | (/ (* n (+ n 1)) 2)) 172 | 173 | (defun abs (x) (if (< x 0) (- 0 x) x)) 174 | 175 | (defun reverse- (zero lst) 176 | (if (null lst) zero 177 | (reverse- (cons (car lst) zero) (cdr lst)))) 178 | 179 | (defun reverse (lst) (reverse- () lst)) 180 | 181 | (defun last (l) 182 | (cond ((atom l) l) 183 | ((atom (cdr l)) l) 184 | (t (last (cdr l))))) 185 | 186 | (defun foldr (f zero lst) 187 | (if (null lst) zero 188 | (f (car lst) (foldr f zero (cdr lst))))) 189 | 190 | (defun foldl (f zero lst) 191 | (if (null lst) zero 192 | (foldl f (f (car lst) zero) (cdr lst)))) 193 | 194 | (defun reverse2 (lst) (foldl cons nil lst)) 195 | 196 | (defun append (a b) (foldr cons b a)) 197 | 198 | (defun identity (x) x) 199 | (defun copy-list (l) (map identity l)) 200 | (defun copy-tree (l) 201 | (if (atom l) l 202 | (cons (copy-tree (car l)) 203 | (copy-tree (cdr l))))) 204 | 205 | (defun every (pred lst) 206 | (or (atom lst) 207 | (and (funcall pred (car lst)) 208 | (every pred (cdr lst))))) 209 | 210 | (defun any (pred lst) 211 | (and (consp lst) 212 | (or (funcall pred (car lst)) 213 | (any pred (cdr lst))))) 214 | 215 | (last '(1 2 3 4)) 216 | (mapcar 'mycar '( (1 2) (3 4) (5 6))) 217 | (pow 2 3) 218 | (rember 'me '(please remove me)) 219 | (append '(1 2 3 4) '(5 6 7 8 9)) 220 | (sum-to-n 100) 221 | (nfibs 10) 222 | (nth '(1 2 3 4 5) 1) 223 | (multiins 'one 'two '(one three one three one three one three)) 224 | (filter numberp '(1 2 3 a b c 4 5 6)) 225 | -------------------------------------------------------------------------------- /plisp/code/p10.lisp: -------------------------------------------------------------------------------- 1 | 2 | (defun nfibs (n) 3 | (if (< n 2) n 4 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 5 | ) 6 | ) 7 | 8 | (defun member (a lat) 9 | (cond ((null lat) nil) 10 | ((eq (car lat) a) t) 11 | (t (member a (cdr lat))) 12 | ) 13 | ) 14 | 15 | (defun rember (a lat) 16 | (cond ((null lat) ()) 17 | ((eq (car lat) a) (cdr lat)) 18 | (t (cons (car lat) (rember a (cdr lat)))) 19 | ) 20 | ) 21 | 22 | (defun eqn (n1 n2) 23 | (cond ((zerop n2) (zerop n1)) 24 | ((zerop n1) nil) 25 | (t (eqn (sub1 n1) (sub1 n2))) 26 | ) 27 | ) 28 | 29 | (defun multiins (old new lat) 30 | (cond ((null lat) ()) 31 | ((eq (car lat) old) (cons (car lat) 32 | (cons new (multiins old new (cdr lat))))) 33 | (t (cons (car lat) (multiins old new (cdr lat)))) 34 | ) 35 | ) 36 | 37 | (defun mapcar (fn x) 38 | (cond ((null x) nil) 39 | (t (cons (funcall fn (car x)) (mapcar fn (cdr x)))) 40 | ) 41 | ) 42 | 43 | (defun maplist (fn x) 44 | (cond ((null x) nil) 45 | (t (cons (funcall fn x) (maplist fn (cdr x)))) 46 | ) 47 | ) 48 | 49 | (defun map (f lst) 50 | (if (atom lst) lst 51 | (cons (f (car lst)) (map f (cdr lst))))) 52 | 53 | (defun mycar (x) (car x)) 54 | (defun mycdr (x) (cdr x)) 55 | 56 | (defun pow (n1 n2) 57 | (cond ((zerop n2) 1) 58 | (t (times n1 (pow n1 (sub1 n2)))) 59 | ) 60 | ) 61 | 62 | (defun double (n) (times n 2)) 63 | (defun square (n) (times n n)) 64 | (defun testfun (n) 65 | (funcall (cond ((greaterp n 100) 'double) 66 | (t 'square) ) 67 | n) 68 | ) 69 | 70 | (defun subst (old new lat) 71 | (cond ((null lat) ()) 72 | ((eq (car lat) old) (cons new (cdr lat))) 73 | (t (cons (car lat) (subst old new (cdr lat)))) 74 | ) 75 | ) 76 | 77 | (defun length (lat) 78 | (cond ((null lat) 0) 79 | (t (add1 (length (cdr lat)))) 80 | ) 81 | ) 82 | 83 | (defun intersect (set1 set2) 84 | (cond ((null set1) ()) 85 | ((member (car set1) set2) (cons (car set1) (intersect (cdr set1) set2))) 86 | (t (intersect (cdr set1) set2)) 87 | ) 88 | ) 89 | 90 | (defun factorial (n) 91 | (cond ((= n 1) 1) 92 | (t (* n (factorial (- n 1)))) 93 | ) 94 | ) 95 | 96 | (defun rem (x d) 97 | (- x (* (/ x d) d))) 98 | 99 | (defun is-even (x) 100 | (if (= 0 (rem x 2)) 101 | t 102 | nil)) 103 | 104 | (defun is-odd (x) 105 | (if (is-even x) 106 | nil 107 | t)) 108 | 109 | (defun is-divisible (x y) 110 | (if (= y 1) 111 | nil 112 | (if (>= y x) 113 | nil 114 | (if (= 0 (rem x y)) 115 | t 116 | nil)))) 117 | 118 | (defun is-prime (x) 119 | (if (is-even x) 120 | nil 121 | (is-prime-rec x 1))) 122 | 123 | (defun is-prime-rec 124 | (x y) 125 | (if (is-divisible x y) 126 | nil 127 | (if (>= y x) 128 | t 129 | (is-prime-rec x (+ 2 y))))) 130 | 131 | (defun gcd (x y) 132 | (cond 133 | ((= y 0) x) 134 | (t (gcd y (rem x y))))) 135 | 136 | (defun lcm (x y) 137 | (/ (abs (* x y)) (gcd x y))) 138 | 139 | (defun nth (lis n) 140 | (if (= n 0) 141 | (car lis) 142 | (nth (cdr lis) (- n 1)) 143 | ) 144 | ) 145 | 146 | (defun nthcdr (lst n) 147 | (if (<= n 0) lst 148 | (nthcdr (cdr lst) (- n 1)))) 149 | 150 | (defun list-ref (lst n) 151 | (car (nthcdr lst n))) 152 | 153 | (defun filter (pred lst) 154 | (cond ((null lst) ()) 155 | ((not (pred (car lst))) (filter pred (cdr lst))) 156 | (t (cons (car lst) (filter pred (cdr lst)))))) 157 | 158 | (defun caar (x) (car (car x))) 159 | 160 | (defun assoc (item lst) 161 | (cond ((atom lst) ()) 162 | ((eq (caar lst) item) (car lst)) 163 | (t (assoc item (cdr lst))))) 164 | 165 | (defun sum-to-n (n) 166 | (cond 167 | ((< n 0) 0) 168 | (t (+ n (sum-to-n (- n 1)))))) 169 | 170 | (defun gauss (n) 171 | (/ (* n (+ n 1)) 2)) 172 | 173 | (defun abs (x) (if (< x 0) (- 0 x) x)) 174 | 175 | (defun reverse- (zero lst) 176 | (if (null lst) zero 177 | (reverse- (cons (car lst) zero) (cdr lst)))) 178 | 179 | (defun reverse (lst) (reverse- () lst)) 180 | 181 | (defun last (l) 182 | (cond ((atom l) l) 183 | ((atom (cdr l)) l) 184 | (t (last (cdr l))))) 185 | 186 | (defun foldr (f zero lst) 187 | (if (null lst) zero 188 | (f (car lst) (foldr f zero (cdr lst))))) 189 | 190 | (defun foldl (f zero lst) 191 | (if (null lst) zero 192 | (foldl f (f (car lst) zero) (cdr lst)))) 193 | 194 | (defun reverse2 (lst) (foldl cons nil lst)) 195 | 196 | (defun append (a b) (foldr cons b a)) 197 | 198 | (defun identity (x) x) 199 | (defun copy-list (l) (map identity l)) 200 | (defun copy-tree (l) 201 | (if (atom l) l 202 | (cons (copy-tree (car l)) 203 | (copy-tree (cdr l))))) 204 | 205 | (defun every (pred lst) 206 | (or (atom lst) 207 | (and (funcall pred (car lst)) 208 | (every pred (cdr lst))))) 209 | 210 | (defun any (pred lst) 211 | (and (consp lst) 212 | (or (funcall pred (car lst)) 213 | (any pred (cdr lst))))) 214 | 215 | (mapcar 'mycar '( (1 2) (3 4) (5 6))) 216 | (copy-tree '((a b c d) (e f g) h i j)) 217 | (rember 'me '(please remove me)) 218 | (intersect '(a b c d e f) '(d e f)) 219 | (reverse '(1 2 3 4 5 6 7)) 220 | 221 | (reverse '(1 2 3 4 5 6 7 8 9)) 222 | (nthcdr '(1 2 3 4 5) 2) 223 | (assoc 'five '((one two) (three four) (five six) (seven eight))) 224 | 225 | -------------------------------------------------------------------------------- /plisp/code/p11.lisp: -------------------------------------------------------------------------------- 1 | 2 | (defun nfibs (n) 3 | (if (< n 2) n 4 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 5 | ) 6 | ) 7 | 8 | (defun member (a lat) 9 | (cond ((null lat) nil) 10 | ((eq (car lat) a) t) 11 | (t (member a (cdr lat))) 12 | ) 13 | ) 14 | 15 | (defun rember (a lat) 16 | (cond ((null lat) ()) 17 | ((eq (car lat) a) (cdr lat)) 18 | (t (cons (car lat) (rember a (cdr lat)))) 19 | ) 20 | ) 21 | 22 | (defun eqn (n1 n2) 23 | (cond ((zerop n2) (zerop n1)) 24 | ((zerop n1) nil) 25 | (t (eqn (sub1 n1) (sub1 n2))) 26 | ) 27 | ) 28 | 29 | (defun multiins (old new lat) 30 | (cond ((null lat) ()) 31 | ((eq (car lat) old) (cons (car lat) 32 | (cons new (multiins old new (cdr lat))))) 33 | (t (cons (car lat) (multiins old new (cdr lat)))) 34 | ) 35 | ) 36 | 37 | (defun mapcar (fn x) 38 | (cond ((null x) nil) 39 | (t (cons (funcall fn (car x)) (mapcar fn (cdr x)))) 40 | ) 41 | ) 42 | 43 | (defun maplist (fn x) 44 | (cond ((null x) nil) 45 | (t (cons (funcall fn x) (maplist fn (cdr x)))) 46 | ) 47 | ) 48 | 49 | (defun map (f lst) 50 | (if (atom lst) lst 51 | (cons (f (car lst)) (map f (cdr lst))))) 52 | 53 | (defun mycar (x) (car x)) 54 | (defun mycdr (x) (cdr x)) 55 | 56 | (defun pow (n1 n2) 57 | (cond ((zerop n2) 1) 58 | (t (times n1 (pow n1 (sub1 n2)))) 59 | ) 60 | ) 61 | 62 | (defun double (n) (times n 2)) 63 | (defun square (n) (times n n)) 64 | (defun testfun (n) 65 | (funcall (cond ((greaterp n 100) 'double) 66 | (t 'square) ) 67 | n) 68 | ) 69 | 70 | (defun subst (old new lat) 71 | (cond ((null lat) ()) 72 | ((eq (car lat) old) (cons new (cdr lat))) 73 | (t (cons (car lat) (subst old new (cdr lat)))) 74 | ) 75 | ) 76 | 77 | (defun length (lat) 78 | (cond ((null lat) 0) 79 | (t (add1 (length (cdr lat)))) 80 | ) 81 | ) 82 | 83 | (defun intersect (set1 set2) 84 | (cond ((null set1) ()) 85 | ((member (car set1) set2) (cons (car set1) (intersect (cdr set1) set2))) 86 | (t (intersect (cdr set1) set2)) 87 | ) 88 | ) 89 | 90 | (defun factorial (n) 91 | (cond ((= n 1) 1) 92 | (t (* n (factorial (- n 1)))) 93 | ) 94 | ) 95 | 96 | (defun rem (x d) 97 | (- x (* (/ x d) d))) 98 | 99 | (defun is-even (x) 100 | (if (= 0 (rem x 2)) 101 | t 102 | nil)) 103 | 104 | (defun is-odd (x) 105 | (if (is-even x) 106 | nil 107 | t)) 108 | 109 | (defun is-divisible (x y) 110 | (if (= y 1) 111 | nil 112 | (if (>= y x) 113 | nil 114 | (if (= 0 (rem x y)) 115 | t 116 | nil)))) 117 | 118 | (defun is-prime (x) 119 | (if (is-even x) 120 | nil 121 | (is-prime-rec x 1))) 122 | 123 | (defun is-prime-rec 124 | (x y) 125 | (if (is-divisible x y) 126 | nil 127 | (if (>= y x) 128 | t 129 | (is-prime-rec x (+ 2 y))))) 130 | 131 | (defun gcd (x y) 132 | (cond 133 | ((= y 0) x) 134 | (t (gcd y (rem x y))))) 135 | 136 | (defun lcm (x y) 137 | (/ (abs (* x y)) (gcd x y))) 138 | 139 | (defun nth (lis n) 140 | (if (= n 0) 141 | (car lis) 142 | (nth (cdr lis) (- n 1)) 143 | ) 144 | ) 145 | 146 | (defun nthcdr (lst n) 147 | (if (<= n 0) lst 148 | (nthcdr (cdr lst) (- n 1)))) 149 | 150 | (defun list-ref (lst n) 151 | (car (nthcdr lst n))) 152 | 153 | (defun filter (pred lst) 154 | (cond ((null lst) ()) 155 | ((not (pred (car lst))) (filter pred (cdr lst))) 156 | (t (cons (car lst) (filter pred (cdr lst)))))) 157 | 158 | (defun caar (x) (car (car x))) 159 | 160 | (defun assoc (item lst) 161 | (cond ((atom lst) ()) 162 | ((eq (caar lst) item) (car lst)) 163 | (t (assoc item (cdr lst))))) 164 | 165 | (defun sum-to-n (n) 166 | (cond 167 | ((< n 0) 0) 168 | (t (+ n (sum-to-n (- n 1)))))) 169 | 170 | (defun gauss (n) 171 | (/ (* n (+ n 1)) 2)) 172 | 173 | (defun abs (x) (if (< x 0) (- 0 x) x)) 174 | 175 | (defun reverse- (zero lst) 176 | (if (null lst) zero 177 | (reverse- (cons (car lst) zero) (cdr lst)))) 178 | 179 | (defun reverse (lst) (reverse- () lst)) 180 | 181 | (defun last (l) 182 | (cond ((atom l) l) 183 | ((atom (cdr l)) l) 184 | (t (last (cdr l))))) 185 | 186 | (defun foldr (f zero lst) 187 | (if (null lst) zero 188 | (f (car lst) (foldr f zero (cdr lst))))) 189 | 190 | (defun foldl (f zero lst) 191 | (if (null lst) zero 192 | (foldl f (f (car lst) zero) (cdr lst)))) 193 | 194 | (defun reverse2 (lst) (foldl cons nil lst)) 195 | 196 | (defun append (a b) (foldr cons b a)) 197 | 198 | (defun identity (x) x) 199 | (defun copy-list (l) (map identity l)) 200 | (defun copy-tree (l) 201 | (if (atom l) l 202 | (cons (copy-tree (car l)) 203 | (copy-tree (cdr l))))) 204 | 205 | (defun every (pred lst) 206 | (or (atom lst) 207 | (and (funcall pred (car lst)) 208 | (every pred (cdr lst))))) 209 | 210 | (defun any (pred lst) 211 | (and (consp lst) 212 | (or (funcall pred (car lst)) 213 | (any pred (cdr lst))))) 214 | 215 | (mapcar 'is-prime (3 5 7 11 13 17 19 23 29 31 37 41 43 47)) 216 | (reverse '(1 2 3 4 5 6 7 8 9)) 217 | (any numberp '(1 a)) 218 | (testfun 101) 219 | (every numberp '(1 a)) 220 | 221 | (length '(0 1 2 3 4 5 6 7 8 9)) 222 | (multiins 'one 'two '(one three one three one three one three)) 223 | (last '(1 2 3 4)) 224 | (nfibs 10) 225 | -------------------------------------------------------------------------------- /plisp/code/p12.lisp: -------------------------------------------------------------------------------- 1 | 2 | (defun nfibs (n) 3 | (if (< n 2) n 4 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 5 | ) 6 | ) 7 | 8 | (defun member (a lat) 9 | (cond ((null lat) nil) 10 | ((eq (car lat) a) t) 11 | (t (member a (cdr lat))) 12 | ) 13 | ) 14 | 15 | (defun rember (a lat) 16 | (cond ((null lat) ()) 17 | ((eq (car lat) a) (cdr lat)) 18 | (t (cons (car lat) (rember a (cdr lat)))) 19 | ) 20 | ) 21 | 22 | (defun eqn (n1 n2) 23 | (cond ((zerop n2) (zerop n1)) 24 | ((zerop n1) nil) 25 | (t (eqn (sub1 n1) (sub1 n2))) 26 | ) 27 | ) 28 | 29 | (defun multiins (old new lat) 30 | (cond ((null lat) ()) 31 | ((eq (car lat) old) (cons (car lat) 32 | (cons new (multiins old new (cdr lat))))) 33 | (t (cons (car lat) (multiins old new (cdr lat)))) 34 | ) 35 | ) 36 | 37 | (defun mapcar (fn x) 38 | (cond ((null x) nil) 39 | (t (cons (funcall fn (car x)) (mapcar fn (cdr x)))) 40 | ) 41 | ) 42 | 43 | (defun maplist (fn x) 44 | (cond ((null x) nil) 45 | (t (cons (funcall fn x) (maplist fn (cdr x)))) 46 | ) 47 | ) 48 | 49 | (defun map (f lst) 50 | (if (atom lst) lst 51 | (cons (f (car lst)) (map f (cdr lst))))) 52 | 53 | (defun mycar (x) (car x)) 54 | (defun mycdr (x) (cdr x)) 55 | 56 | (defun pow (n1 n2) 57 | (cond ((zerop n2) 1) 58 | (t (times n1 (pow n1 (sub1 n2)))) 59 | ) 60 | ) 61 | 62 | (defun double (n) (times n 2)) 63 | (defun square (n) (times n n)) 64 | (defun testfun (n) 65 | (funcall (cond ((greaterp n 100) 'double) 66 | (t 'square) ) 67 | n) 68 | ) 69 | 70 | (defun subst (old new lat) 71 | (cond ((null lat) ()) 72 | ((eq (car lat) old) (cons new (cdr lat))) 73 | (t (cons (car lat) (subst old new (cdr lat)))) 74 | ) 75 | ) 76 | 77 | (defun length (lat) 78 | (cond ((null lat) 0) 79 | (t (add1 (length (cdr lat)))) 80 | ) 81 | ) 82 | 83 | (defun intersect (set1 set2) 84 | (cond ((null set1) ()) 85 | ((member (car set1) set2) (cons (car set1) (intersect (cdr set1) set2))) 86 | (t (intersect (cdr set1) set2)) 87 | ) 88 | ) 89 | 90 | (defun factorial (n) 91 | (cond ((= n 1) 1) 92 | (t (* n (factorial (- n 1)))) 93 | ) 94 | ) 95 | 96 | (defun rem (x d) 97 | (- x (* (/ x d) d))) 98 | 99 | (defun is-even (x) 100 | (if (= 0 (rem x 2)) 101 | t 102 | nil)) 103 | 104 | (defun is-odd (x) 105 | (if (is-even x) 106 | nil 107 | t)) 108 | 109 | (defun is-divisible (x y) 110 | (if (= y 1) 111 | nil 112 | (if (>= y x) 113 | nil 114 | (if (= 0 (rem x y)) 115 | t 116 | nil)))) 117 | 118 | (defun is-prime (x) 119 | (if (is-even x) 120 | nil 121 | (is-prime-rec x 1))) 122 | 123 | (defun is-prime-rec 124 | (x y) 125 | (if (is-divisible x y) 126 | nil 127 | (if (>= y x) 128 | t 129 | (is-prime-rec x (+ 2 y))))) 130 | 131 | (defun gcd (x y) 132 | (cond 133 | ((= y 0) x) 134 | (t (gcd y (rem x y))))) 135 | 136 | (defun lcm (x y) 137 | (/ (abs (* x y)) (gcd x y))) 138 | 139 | (defun nth (lis n) 140 | (if (= n 0) 141 | (car lis) 142 | (nth (cdr lis) (- n 1)) 143 | ) 144 | ) 145 | 146 | (defun nthcdr (lst n) 147 | (if (<= n 0) lst 148 | (nthcdr (cdr lst) (- n 1)))) 149 | 150 | (defun list-ref (lst n) 151 | (car (nthcdr lst n))) 152 | 153 | (defun filter (pred lst) 154 | (cond ((null lst) ()) 155 | ((not (pred (car lst))) (filter pred (cdr lst))) 156 | (t (cons (car lst) (filter pred (cdr lst)))))) 157 | 158 | (defun caar (x) (car (car x))) 159 | 160 | (defun assoc (item lst) 161 | (cond ((atom lst) ()) 162 | ((eq (caar lst) item) (car lst)) 163 | (t (assoc item (cdr lst))))) 164 | 165 | (defun sum-to-n (n) 166 | (cond 167 | ((< n 0) 0) 168 | (t (+ n (sum-to-n (- n 1)))))) 169 | 170 | (defun gauss (n) 171 | (/ (* n (+ n 1)) 2)) 172 | 173 | (defun abs (x) (if (< x 0) (- 0 x) x)) 174 | 175 | (defun reverse- (zero lst) 176 | (if (null lst) zero 177 | (reverse- (cons (car lst) zero) (cdr lst)))) 178 | 179 | (defun reverse (lst) (reverse- () lst)) 180 | 181 | (defun last (l) 182 | (cond ((atom l) l) 183 | ((atom (cdr l)) l) 184 | (t (last (cdr l))))) 185 | 186 | (defun foldr (f zero lst) 187 | (if (null lst) zero 188 | (f (car lst) (foldr f zero (cdr lst))))) 189 | 190 | (defun foldl (f zero lst) 191 | (if (null lst) zero 192 | (foldl f (f (car lst) zero) (cdr lst)))) 193 | 194 | (defun reverse2 (lst) (foldl cons nil lst)) 195 | 196 | (defun append (a b) (foldr cons b a)) 197 | 198 | (defun identity (x) x) 199 | (defun copy-list (l) (map identity l)) 200 | (defun copy-tree (l) 201 | (if (atom l) l 202 | (cons (copy-tree (car l)) 203 | (copy-tree (cdr l))))) 204 | 205 | (defun every (pred lst) 206 | (or (atom lst) 207 | (and (funcall pred (car lst)) 208 | (every pred (cdr lst))))) 209 | 210 | (defun any (pred lst) 211 | (and (consp lst) 212 | (or (funcall pred (car lst)) 213 | (any pred (cdr lst))))) 214 | 215 | (pow 2 3) 216 | (testfun 13) 217 | (reverse '(1 2 3 4 5 6 7)) 218 | (last '(1 2 3 4)) 219 | (subst 'me 'you '(a list with me)) 220 | (testfun 101) 221 | (reverse2 '(1 2 3 4 5 6 7 8 9)) 222 | (nthcdr '(1 2 3 4 5) 2) 223 | (pow 234 0) 224 | (every numberp '(1 2)) 225 | -------------------------------------------------------------------------------- /plisp/code/p13.lisp: -------------------------------------------------------------------------------- 1 | 2 | (defun nfibs (n) 3 | (if (< n 2) n 4 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 5 | ) 6 | ) 7 | 8 | (defun member (a lat) 9 | (cond ((null lat) nil) 10 | ((eq (car lat) a) t) 11 | (t (member a (cdr lat))) 12 | ) 13 | ) 14 | 15 | (defun rember (a lat) 16 | (cond ((null lat) ()) 17 | ((eq (car lat) a) (cdr lat)) 18 | (t (cons (car lat) (rember a (cdr lat)))) 19 | ) 20 | ) 21 | 22 | (defun eqn (n1 n2) 23 | (cond ((zerop n2) (zerop n1)) 24 | ((zerop n1) nil) 25 | (t (eqn (sub1 n1) (sub1 n2))) 26 | ) 27 | ) 28 | 29 | (defun multiins (old new lat) 30 | (cond ((null lat) ()) 31 | ((eq (car lat) old) (cons (car lat) 32 | (cons new (multiins old new (cdr lat))))) 33 | (t (cons (car lat) (multiins old new (cdr lat)))) 34 | ) 35 | ) 36 | 37 | (defun mapcar (fn x) 38 | (cond ((null x) nil) 39 | (t (cons (funcall fn (car x)) (mapcar fn (cdr x)))) 40 | ) 41 | ) 42 | 43 | (defun maplist (fn x) 44 | (cond ((null x) nil) 45 | (t (cons (funcall fn x) (maplist fn (cdr x)))) 46 | ) 47 | ) 48 | 49 | (defun map (f lst) 50 | (if (atom lst) lst 51 | (cons (f (car lst)) (map f (cdr lst))))) 52 | 53 | (defun mycar (x) (car x)) 54 | (defun mycdr (x) (cdr x)) 55 | 56 | (defun pow (n1 n2) 57 | (cond ((zerop n2) 1) 58 | (t (times n1 (pow n1 (sub1 n2)))) 59 | ) 60 | ) 61 | 62 | (defun double (n) (times n 2)) 63 | (defun square (n) (times n n)) 64 | (defun testfun (n) 65 | (funcall (cond ((greaterp n 100) 'double) 66 | (t 'square) ) 67 | n) 68 | ) 69 | 70 | (defun subst (old new lat) 71 | (cond ((null lat) ()) 72 | ((eq (car lat) old) (cons new (cdr lat))) 73 | (t (cons (car lat) (subst old new (cdr lat)))) 74 | ) 75 | ) 76 | 77 | (defun length (lat) 78 | (cond ((null lat) 0) 79 | (t (add1 (length (cdr lat)))) 80 | ) 81 | ) 82 | 83 | (defun intersect (set1 set2) 84 | (cond ((null set1) ()) 85 | ((member (car set1) set2) (cons (car set1) (intersect (cdr set1) set2))) 86 | (t (intersect (cdr set1) set2)) 87 | ) 88 | ) 89 | 90 | (defun factorial (n) 91 | (cond ((= n 1) 1) 92 | (t (* n (factorial (- n 1)))) 93 | ) 94 | ) 95 | 96 | (defun rem (x d) 97 | (- x (* (/ x d) d))) 98 | 99 | (defun is-even (x) 100 | (if (= 0 (rem x 2)) 101 | t 102 | nil)) 103 | 104 | (defun is-odd (x) 105 | (if (is-even x) 106 | nil 107 | t)) 108 | 109 | (defun is-divisible (x y) 110 | (if (= y 1) 111 | nil 112 | (if (>= y x) 113 | nil 114 | (if (= 0 (rem x y)) 115 | t 116 | nil)))) 117 | 118 | (defun is-prime (x) 119 | (if (is-even x) 120 | nil 121 | (is-prime-rec x 1))) 122 | 123 | (defun is-prime-rec 124 | (x y) 125 | (if (is-divisible x y) 126 | nil 127 | (if (>= y x) 128 | t 129 | (is-prime-rec x (+ 2 y))))) 130 | 131 | (defun gcd (x y) 132 | (cond 133 | ((= y 0) x) 134 | (t (gcd y (rem x y))))) 135 | 136 | (defun lcm (x y) 137 | (/ (abs (* x y)) (gcd x y))) 138 | 139 | (defun nth (lis n) 140 | (if (= n 0) 141 | (car lis) 142 | (nth (cdr lis) (- n 1)) 143 | ) 144 | ) 145 | 146 | (defun nthcdr (lst n) 147 | (if (<= n 0) lst 148 | (nthcdr (cdr lst) (- n 1)))) 149 | 150 | (defun list-ref (lst n) 151 | (car (nthcdr lst n))) 152 | 153 | (defun filter (pred lst) 154 | (cond ((null lst) ()) 155 | ((not (pred (car lst))) (filter pred (cdr lst))) 156 | (t (cons (car lst) (filter pred (cdr lst)))))) 157 | 158 | (defun caar (x) (car (car x))) 159 | 160 | (defun assoc (item lst) 161 | (cond ((atom lst) ()) 162 | ((eq (caar lst) item) (car lst)) 163 | (t (assoc item (cdr lst))))) 164 | 165 | (defun sum-to-n (n) 166 | (cond 167 | ((< n 0) 0) 168 | (t (+ n (sum-to-n (- n 1)))))) 169 | 170 | (defun gauss (n) 171 | (/ (* n (+ n 1)) 2)) 172 | 173 | (defun abs (x) (if (< x 0) (- 0 x) x)) 174 | 175 | (defun reverse- (zero lst) 176 | (if (null lst) zero 177 | (reverse- (cons (car lst) zero) (cdr lst)))) 178 | 179 | (defun reverse (lst) (reverse- () lst)) 180 | 181 | (defun last (l) 182 | (cond ((atom l) l) 183 | ((atom (cdr l)) l) 184 | (t (last (cdr l))))) 185 | 186 | (defun foldr (f zero lst) 187 | (if (null lst) zero 188 | (f (car lst) (foldr f zero (cdr lst))))) 189 | 190 | (defun foldl (f zero lst) 191 | (if (null lst) zero 192 | (foldl f (f (car lst) zero) (cdr lst)))) 193 | 194 | (defun reverse2 (lst) (foldl cons nil lst)) 195 | 196 | (defun append (a b) (foldr cons b a)) 197 | 198 | (defun identity (x) x) 199 | (defun copy-list (l) (map identity l)) 200 | (defun copy-tree (l) 201 | (if (atom l) l 202 | (cons (copy-tree (car l)) 203 | (copy-tree (cdr l))))) 204 | 205 | (defun every (pred lst) 206 | (or (atom lst) 207 | (and (funcall pred (car lst)) 208 | (every pred (cdr lst))))) 209 | 210 | (defun any (pred lst) 211 | (and (consp lst) 212 | (or (funcall pred (car lst)) 213 | (any pred (cdr lst))))) 214 | 215 | 216 | (list-ref '(1 2 3 4) 1) 217 | (every numberp '(1 2)) 218 | (mapcar 'mycar '( (1 2) (3 4) (5 6))) 219 | (intersect '(a b c d e f) '(d e f)) 220 | (last '(1 2 3 4)) 221 | (nthcdr '(1 2 3 4 5) 2) 222 | (member 'me '(please remove me)) 223 | (any numberp '(1 a)) 224 | (assoc 'five '((one two) (three four) (five six) (seven eight))) 225 | -------------------------------------------------------------------------------- /plisp/code/p14.lisp: -------------------------------------------------------------------------------- 1 | 2 | (defun nfibs (n) 3 | (if (< n 2) n 4 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 5 | ) 6 | ) 7 | 8 | (defun member (a lat) 9 | (cond ((null lat) nil) 10 | ((eq (car lat) a) t) 11 | (t (member a (cdr lat))) 12 | ) 13 | ) 14 | 15 | (defun rember (a lat) 16 | (cond ((null lat) ()) 17 | ((eq (car lat) a) (cdr lat)) 18 | (t (cons (car lat) (rember a (cdr lat)))) 19 | ) 20 | ) 21 | 22 | (defun eqn (n1 n2) 23 | (cond ((zerop n2) (zerop n1)) 24 | ((zerop n1) nil) 25 | (t (eqn (sub1 n1) (sub1 n2))) 26 | ) 27 | ) 28 | 29 | (defun multiins (old new lat) 30 | (cond ((null lat) ()) 31 | ((eq (car lat) old) (cons (car lat) 32 | (cons new (multiins old new (cdr lat))))) 33 | (t (cons (car lat) (multiins old new (cdr lat)))) 34 | ) 35 | ) 36 | 37 | (defun mapcar (fn x) 38 | (cond ((null x) nil) 39 | (t (cons (funcall fn (car x)) (mapcar fn (cdr x)))) 40 | ) 41 | ) 42 | 43 | (defun maplist (fn x) 44 | (cond ((null x) nil) 45 | (t (cons (funcall fn x) (maplist fn (cdr x)))) 46 | ) 47 | ) 48 | 49 | (defun map (f lst) 50 | (if (atom lst) lst 51 | (cons (f (car lst)) (map f (cdr lst))))) 52 | 53 | (defun mycar (x) (car x)) 54 | (defun mycdr (x) (cdr x)) 55 | 56 | (defun pow (n1 n2) 57 | (cond ((zerop n2) 1) 58 | (t (times n1 (pow n1 (sub1 n2)))) 59 | ) 60 | ) 61 | 62 | (defun double (n) (times n 2)) 63 | (defun square (n) (times n n)) 64 | (defun testfun (n) 65 | (funcall (cond ((greaterp n 100) 'double) 66 | (t 'square) ) 67 | n) 68 | ) 69 | 70 | (defun subst (old new lat) 71 | (cond ((null lat) ()) 72 | ((eq (car lat) old) (cons new (cdr lat))) 73 | (t (cons (car lat) (subst old new (cdr lat)))) 74 | ) 75 | ) 76 | 77 | (defun length (lat) 78 | (cond ((null lat) 0) 79 | (t (add1 (length (cdr lat)))) 80 | ) 81 | ) 82 | 83 | (defun intersect (set1 set2) 84 | (cond ((null set1) ()) 85 | ((member (car set1) set2) (cons (car set1) (intersect (cdr set1) set2))) 86 | (t (intersect (cdr set1) set2)) 87 | ) 88 | ) 89 | 90 | (defun factorial (n) 91 | (cond ((= n 1) 1) 92 | (t (* n (factorial (- n 1)))) 93 | ) 94 | ) 95 | 96 | (defun rem (x d) 97 | (- x (* (/ x d) d))) 98 | 99 | (defun is-even (x) 100 | (if (= 0 (rem x 2)) 101 | t 102 | nil)) 103 | 104 | (defun is-odd (x) 105 | (if (is-even x) 106 | nil 107 | t)) 108 | 109 | (defun is-divisible (x y) 110 | (if (= y 1) 111 | nil 112 | (if (>= y x) 113 | nil 114 | (if (= 0 (rem x y)) 115 | t 116 | nil)))) 117 | 118 | (defun is-prime (x) 119 | (if (is-even x) 120 | nil 121 | (is-prime-rec x 1))) 122 | 123 | (defun is-prime-rec 124 | (x y) 125 | (if (is-divisible x y) 126 | nil 127 | (if (>= y x) 128 | t 129 | (is-prime-rec x (+ 2 y))))) 130 | 131 | (defun gcd (x y) 132 | (cond 133 | ((= y 0) x) 134 | (t (gcd y (rem x y))))) 135 | 136 | (defun lcm (x y) 137 | (/ (abs (* x y)) (gcd x y))) 138 | 139 | (defun nth (lis n) 140 | (if (= n 0) 141 | (car lis) 142 | (nth (cdr lis) (- n 1)) 143 | ) 144 | ) 145 | 146 | (defun nthcdr (lst n) 147 | (if (<= n 0) lst 148 | (nthcdr (cdr lst) (- n 1)))) 149 | 150 | (defun list-ref (lst n) 151 | (car (nthcdr lst n))) 152 | 153 | (defun filter (pred lst) 154 | (cond ((null lst) ()) 155 | ((not (pred (car lst))) (filter pred (cdr lst))) 156 | (t (cons (car lst) (filter pred (cdr lst)))))) 157 | 158 | (defun caar (x) (car (car x))) 159 | 160 | (defun assoc (item lst) 161 | (cond ((atom lst) ()) 162 | ((eq (caar lst) item) (car lst)) 163 | (t (assoc item (cdr lst))))) 164 | 165 | (defun sum-to-n (n) 166 | (cond 167 | ((< n 0) 0) 168 | (t (+ n (sum-to-n (- n 1)))))) 169 | 170 | (defun gauss (n) 171 | (/ (* n (+ n 1)) 2)) 172 | 173 | (defun abs (x) (if (< x 0) (- 0 x) x)) 174 | 175 | (defun reverse- (zero lst) 176 | (if (null lst) zero 177 | (reverse- (cons (car lst) zero) (cdr lst)))) 178 | 179 | (defun reverse (lst) (reverse- () lst)) 180 | 181 | (defun last (l) 182 | (cond ((atom l) l) 183 | ((atom (cdr l)) l) 184 | (t (last (cdr l))))) 185 | 186 | (defun foldr (f zero lst) 187 | (if (null lst) zero 188 | (f (car lst) (foldr f zero (cdr lst))))) 189 | 190 | (defun foldl (f zero lst) 191 | (if (null lst) zero 192 | (foldl f (f (car lst) zero) (cdr lst)))) 193 | 194 | (defun reverse2 (lst) (foldl cons nil lst)) 195 | 196 | (defun append (a b) (foldr cons b a)) 197 | 198 | (defun identity (x) x) 199 | (defun copy-list (l) (map identity l)) 200 | (defun copy-tree (l) 201 | (if (atom l) l 202 | (cons (copy-tree (car l)) 203 | (copy-tree (cdr l))))) 204 | 205 | (defun every (pred lst) 206 | (or (atom lst) 207 | (and (funcall pred (car lst)) 208 | (every pred (cdr lst))))) 209 | 210 | (defun any (pred lst) 211 | (and (consp lst) 212 | (or (funcall pred (car lst)) 213 | (any pred (cdr lst))))) 214 | 215 | (nfibs 10) 216 | (sum-to-n 100) 217 | (last '(1 2 3 4)) 218 | 219 | (mapcar 'mycar '( (1 2) (3 4) (5 6))) 220 | (reverse2 '(1 2 3 4 5 6 7 8 9)) 221 | (every numberp '(1 2)) 222 | 223 | (length '(0 1 2 3 4 5 6 7 8 9)) 224 | (mapcar 'atom '(list 1 (2) foo t nil)) 225 | -------------------------------------------------------------------------------- /plisp/code/p15.lisp: -------------------------------------------------------------------------------- 1 | 2 | (defun nfibs (n) 3 | (if (< n 2) n 4 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 5 | ) 6 | ) 7 | 8 | (defun member (a lat) 9 | (cond ((null lat) nil) 10 | ((eq (car lat) a) t) 11 | (t (member a (cdr lat))) 12 | ) 13 | ) 14 | 15 | (defun rember (a lat) 16 | (cond ((null lat) ()) 17 | ((eq (car lat) a) (cdr lat)) 18 | (t (cons (car lat) (rember a (cdr lat)))) 19 | ) 20 | ) 21 | 22 | (defun eqn (n1 n2) 23 | (cond ((zerop n2) (zerop n1)) 24 | ((zerop n1) nil) 25 | (t (eqn (sub1 n1) (sub1 n2))) 26 | ) 27 | ) 28 | 29 | (defun multiins (old new lat) 30 | (cond ((null lat) ()) 31 | ((eq (car lat) old) (cons (car lat) 32 | (cons new (multiins old new (cdr lat))))) 33 | (t (cons (car lat) (multiins old new (cdr lat)))) 34 | ) 35 | ) 36 | 37 | (defun mapcar (fn x) 38 | (cond ((null x) nil) 39 | (t (cons (funcall fn (car x)) (mapcar fn (cdr x)))) 40 | ) 41 | ) 42 | 43 | (defun maplist (fn x) 44 | (cond ((null x) nil) 45 | (t (cons (funcall fn x) (maplist fn (cdr x)))) 46 | ) 47 | ) 48 | 49 | (defun map (f lst) 50 | (if (atom lst) lst 51 | (cons (f (car lst)) (map f (cdr lst))))) 52 | 53 | (defun mycar (x) (car x)) 54 | (defun mycdr (x) (cdr x)) 55 | 56 | (defun pow (n1 n2) 57 | (cond ((zerop n2) 1) 58 | (t (times n1 (pow n1 (sub1 n2)))) 59 | ) 60 | ) 61 | 62 | (defun double (n) (times n 2)) 63 | (defun square (n) (times n n)) 64 | (defun testfun (n) 65 | (funcall (cond ((greaterp n 100) 'double) 66 | (t 'square) ) 67 | n) 68 | ) 69 | 70 | (defun subst (old new lat) 71 | (cond ((null lat) ()) 72 | ((eq (car lat) old) (cons new (cdr lat))) 73 | (t (cons (car lat) (subst old new (cdr lat)))) 74 | ) 75 | ) 76 | 77 | (defun length (lat) 78 | (cond ((null lat) 0) 79 | (t (add1 (length (cdr lat)))) 80 | ) 81 | ) 82 | 83 | (defun intersect (set1 set2) 84 | (cond ((null set1) ()) 85 | ((member (car set1) set2) (cons (car set1) (intersect (cdr set1) set2))) 86 | (t (intersect (cdr set1) set2)) 87 | ) 88 | ) 89 | 90 | (defun factorial (n) 91 | (cond ((= n 1) 1) 92 | (t (* n (factorial (- n 1)))) 93 | ) 94 | ) 95 | 96 | (defun rem (x d) 97 | (- x (* (/ x d) d))) 98 | 99 | (defun is-even (x) 100 | (if (= 0 (rem x 2)) 101 | t 102 | nil)) 103 | 104 | (defun is-odd (x) 105 | (if (is-even x) 106 | nil 107 | t)) 108 | 109 | (defun is-divisible (x y) 110 | (if (= y 1) 111 | nil 112 | (if (>= y x) 113 | nil 114 | (if (= 0 (rem x y)) 115 | t 116 | nil)))) 117 | 118 | (defun is-prime (x) 119 | (if (is-even x) 120 | nil 121 | (is-prime-rec x 1))) 122 | 123 | (defun is-prime-rec 124 | (x y) 125 | (if (is-divisible x y) 126 | nil 127 | (if (>= y x) 128 | t 129 | (is-prime-rec x (+ 2 y))))) 130 | 131 | (defun gcd (x y) 132 | (cond 133 | ((= y 0) x) 134 | (t (gcd y (rem x y))))) 135 | 136 | (defun lcm (x y) 137 | (/ (abs (* x y)) (gcd x y))) 138 | 139 | (defun nth (lis n) 140 | (if (= n 0) 141 | (car lis) 142 | (nth (cdr lis) (- n 1)) 143 | ) 144 | ) 145 | 146 | (defun nthcdr (lst n) 147 | (if (<= n 0) lst 148 | (nthcdr (cdr lst) (- n 1)))) 149 | 150 | (defun list-ref (lst n) 151 | (car (nthcdr lst n))) 152 | 153 | (defun filter (pred lst) 154 | (cond ((null lst) ()) 155 | ((not (pred (car lst))) (filter pred (cdr lst))) 156 | (t (cons (car lst) (filter pred (cdr lst)))))) 157 | 158 | (defun caar (x) (car (car x))) 159 | 160 | (defun assoc (item lst) 161 | (cond ((atom lst) ()) 162 | ((eq (caar lst) item) (car lst)) 163 | (t (assoc item (cdr lst))))) 164 | 165 | (defun sum-to-n (n) 166 | (cond 167 | ((< n 0) 0) 168 | (t (+ n (sum-to-n (- n 1)))))) 169 | 170 | (defun gauss (n) 171 | (/ (* n (+ n 1)) 2)) 172 | 173 | (defun abs (x) (if (< x 0) (- 0 x) x)) 174 | 175 | (defun reverse- (zero lst) 176 | (if (null lst) zero 177 | (reverse- (cons (car lst) zero) (cdr lst)))) 178 | 179 | (defun reverse (lst) (reverse- () lst)) 180 | 181 | (defun last (l) 182 | (cond ((atom l) l) 183 | ((atom (cdr l)) l) 184 | (t (last (cdr l))))) 185 | 186 | (defun foldr (f zero lst) 187 | (if (null lst) zero 188 | (f (car lst) (foldr f zero (cdr lst))))) 189 | 190 | (defun foldl (f zero lst) 191 | (if (null lst) zero 192 | (foldl f (f (car lst) zero) (cdr lst)))) 193 | 194 | (defun reverse2 (lst) (foldl cons nil lst)) 195 | 196 | (defun append (a b) (foldr cons b a)) 197 | 198 | (defun identity (x) x) 199 | (defun copy-list (l) (map identity l)) 200 | (defun copy-tree (l) 201 | (if (atom l) l 202 | (cons (copy-tree (car l)) 203 | (copy-tree (cdr l))))) 204 | 205 | (defun every (pred lst) 206 | (or (atom lst) 207 | (and (funcall pred (car lst)) 208 | (every pred (cdr lst))))) 209 | 210 | (defun any (pred lst) 211 | (and (consp lst) 212 | (or (funcall pred (car lst)) 213 | (any pred (cdr lst))))) 214 | 215 | (gauss 100) 216 | (mapcar 'is-prime (3 5 7 11 13 17 19 23 29 31 37 41 43 47)) 217 | (nth '(1 2 3 4 5) 1) 218 | (any numberp '(1 a)) 219 | (nfibs 10) 220 | (member 'me '(please remove me)) 221 | (testfun 101) 222 | (mapcar 'atom '(list 1 (2) foo t nil)) 223 | (list-ref '(1 2 3 4) 1) 224 | (copy-tree '((a b c d) (e f g) h i j)) 225 | -------------------------------------------------------------------------------- /plisp/code/p2.lisp: -------------------------------------------------------------------------------- 1 | 2 | (defun nfibs (n) 3 | (if (< n 2) n 4 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 5 | ) 6 | ) 7 | 8 | (defun member (a lat) 9 | (cond ((null lat) nil) 10 | ((eq (car lat) a) t) 11 | (t (member a (cdr lat))) 12 | ) 13 | ) 14 | 15 | (defun rember (a lat) 16 | (cond ((null lat) ()) 17 | ((eq (car lat) a) (cdr lat)) 18 | (t (cons (car lat) (rember a (cdr lat)))) 19 | ) 20 | ) 21 | 22 | (defun eqn (n1 n2) 23 | (cond ((zerop n2) (zerop n1)) 24 | ((zerop n1) nil) 25 | (t (eqn (sub1 n1) (sub1 n2))) 26 | ) 27 | ) 28 | 29 | (defun multiins (old new lat) 30 | (cond ((null lat) ()) 31 | ((eq (car lat) old) (cons (car lat) 32 | (cons new (multiins old new (cdr lat))))) 33 | (t (cons (car lat) (multiins old new (cdr lat)))) 34 | ) 35 | ) 36 | 37 | (defun mapcar (fn x) 38 | (cond ((null x) nil) 39 | (t (cons (funcall fn (car x)) (mapcar fn (cdr x)))) 40 | ) 41 | ) 42 | 43 | (defun maplist (fn x) 44 | (cond ((null x) nil) 45 | (t (cons (funcall fn x) (maplist fn (cdr x)))) 46 | ) 47 | ) 48 | 49 | (defun map (f lst) 50 | (if (atom lst) lst 51 | (cons (f (car lst)) (map f (cdr lst))))) 52 | 53 | (defun mycar (x) (car x)) 54 | (defun mycdr (x) (cdr x)) 55 | 56 | (defun pow (n1 n2) 57 | (cond ((zerop n2) 1) 58 | (t (times n1 (pow n1 (sub1 n2)))) 59 | ) 60 | ) 61 | 62 | (defun double (n) (times n 2)) 63 | (defun square (n) (times n n)) 64 | (defun testfun (n) 65 | (funcall (cond ((greaterp n 100) 'double) 66 | (t 'square) ) 67 | n) 68 | ) 69 | 70 | (defun subst (old new lat) 71 | (cond ((null lat) ()) 72 | ((eq (car lat) old) (cons new (cdr lat))) 73 | (t (cons (car lat) (subst old new (cdr lat)))) 74 | ) 75 | ) 76 | 77 | (defun length (lat) 78 | (cond ((null lat) 0) 79 | (t (add1 (length (cdr lat)))) 80 | ) 81 | ) 82 | 83 | (defun intersect (set1 set2) 84 | (cond ((null set1) ()) 85 | ((member (car set1) set2) (cons (car set1) (intersect (cdr set1) set2))) 86 | (t (intersect (cdr set1) set2)) 87 | ) 88 | ) 89 | 90 | (defun factorial (n) 91 | (cond ((= n 1) 1) 92 | (t (* n (factorial (- n 1)))) 93 | ) 94 | ) 95 | 96 | (defun rem (x d) 97 | (- x (* (/ x d) d))) 98 | 99 | (defun is-even (x) 100 | (if (= 0 (rem x 2)) 101 | t 102 | nil)) 103 | 104 | (defun is-odd (x) 105 | (if (is-even x) 106 | nil 107 | t)) 108 | 109 | (defun is-divisible (x y) 110 | (if (= y 1) 111 | nil 112 | (if (>= y x) 113 | nil 114 | (if (= 0 (rem x y)) 115 | t 116 | nil)))) 117 | 118 | (defun is-prime (x) 119 | (if (is-even x) 120 | nil 121 | (is-prime-rec x 1))) 122 | 123 | (defun is-prime-rec 124 | (x y) 125 | (if (is-divisible x y) 126 | nil 127 | (if (>= y x) 128 | t 129 | (is-prime-rec x (+ 2 y))))) 130 | 131 | (defun gcd (x y) 132 | (cond 133 | ((= y 0) x) 134 | (t (gcd y (rem x y))))) 135 | 136 | (defun lcm (x y) 137 | (/ (abs (* x y)) (gcd x y))) 138 | 139 | (defun nth (lis n) 140 | (if (= n 0) 141 | (car lis) 142 | (nth (cdr lis) (- n 1)) 143 | ) 144 | ) 145 | 146 | (defun nthcdr (lst n) 147 | (if (<= n 0) lst 148 | (nthcdr (cdr lst) (- n 1)))) 149 | 150 | (defun list-ref (lst n) 151 | (car (nthcdr lst n))) 152 | 153 | (defun filter (pred lst) 154 | (cond ((null lst) ()) 155 | ((not (pred (car lst))) (filter pred (cdr lst))) 156 | (t (cons (car lst) (filter pred (cdr lst)))))) 157 | 158 | (defun caar (x) (car (car x))) 159 | 160 | (defun assoc (item lst) 161 | (cond ((atom lst) ()) 162 | ((eq (caar lst) item) (car lst)) 163 | (t (assoc item (cdr lst))))) 164 | 165 | (defun sum-to-n (n) 166 | (cond 167 | ((< n 0) 0) 168 | (t (+ n (sum-to-n (- n 1)))))) 169 | 170 | (defun gauss (n) 171 | (/ (* n (+ n 1)) 2)) 172 | 173 | (defun abs (x) (if (< x 0) (- 0 x) x)) 174 | 175 | (defun reverse- (zero lst) 176 | (if (null lst) zero 177 | (reverse- (cons (car lst) zero) (cdr lst)))) 178 | 179 | (defun reverse (lst) (reverse- () lst)) 180 | 181 | (defun last (l) 182 | (cond ((atom l) l) 183 | ((atom (cdr l)) l) 184 | (t (last (cdr l))))) 185 | 186 | (defun foldr (f zero lst) 187 | (if (null lst) zero 188 | (f (car lst) (foldr f zero (cdr lst))))) 189 | 190 | (defun foldl (f zero lst) 191 | (if (null lst) zero 192 | (foldl f (f (car lst) zero) (cdr lst)))) 193 | 194 | (defun reverse2 (lst) (foldl cons nil lst)) 195 | 196 | (defun append (a b) (foldr cons b a)) 197 | 198 | (defun identity (x) x) 199 | (defun copy-list (l) (map identity l)) 200 | (defun copy-tree (l) 201 | (if (atom l) l 202 | (cons (copy-tree (car l)) 203 | (copy-tree (cdr l))))) 204 | 205 | (defun every (pred lst) 206 | (or (atom lst) 207 | (and (funcall pred (car lst)) 208 | (every pred (cdr lst))))) 209 | 210 | (defun any (pred lst) 211 | (and (consp lst) 212 | (or (funcall pred (car lst)) 213 | (any pred (cdr lst))))) 214 | 215 | (any numberp '(a b)) 216 | (append '(1 2 3 4) '(5 6 7 8 9)) 217 | (copy-tree '((a b c d) (e f g) h i j)) 218 | (nthcdr '(1 2 3 4 5) 2) 219 | (subst 'me 'you '(a list with me)) 220 | (last '(1 2 3 4)) 221 | (pow 2 3) 222 | (nfibs 10) 223 | (assoc 'five '((one two) (three four) (five six) (seven eight))) 224 | (nth '(1 2 3 4 5) 1) 225 | -------------------------------------------------------------------------------- /plisp/code/p3.lisp: -------------------------------------------------------------------------------- 1 | 2 | (defun nfibs (n) 3 | (if (< n 2) n 4 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 5 | ) 6 | ) 7 | 8 | (defun member (a lat) 9 | (cond ((null lat) nil) 10 | ((eq (car lat) a) t) 11 | (t (member a (cdr lat))) 12 | ) 13 | ) 14 | 15 | (defun rember (a lat) 16 | (cond ((null lat) ()) 17 | ((eq (car lat) a) (cdr lat)) 18 | (t (cons (car lat) (rember a (cdr lat)))) 19 | ) 20 | ) 21 | 22 | (defun eqn (n1 n2) 23 | (cond ((zerop n2) (zerop n1)) 24 | ((zerop n1) nil) 25 | (t (eqn (sub1 n1) (sub1 n2))) 26 | ) 27 | ) 28 | 29 | (defun multiins (old new lat) 30 | (cond ((null lat) ()) 31 | ((eq (car lat) old) (cons (car lat) 32 | (cons new (multiins old new (cdr lat))))) 33 | (t (cons (car lat) (multiins old new (cdr lat)))) 34 | ) 35 | ) 36 | 37 | (defun mapcar (fn x) 38 | (cond ((null x) nil) 39 | (t (cons (funcall fn (car x)) (mapcar fn (cdr x)))) 40 | ) 41 | ) 42 | 43 | (defun maplist (fn x) 44 | (cond ((null x) nil) 45 | (t (cons (funcall fn x) (maplist fn (cdr x)))) 46 | ) 47 | ) 48 | 49 | (defun map (f lst) 50 | (if (atom lst) lst 51 | (cons (f (car lst)) (map f (cdr lst))))) 52 | 53 | (defun mycar (x) (car x)) 54 | (defun mycdr (x) (cdr x)) 55 | 56 | (defun pow (n1 n2) 57 | (cond ((zerop n2) 1) 58 | (t (times n1 (pow n1 (sub1 n2)))) 59 | ) 60 | ) 61 | 62 | (defun double (n) (times n 2)) 63 | (defun square (n) (times n n)) 64 | (defun testfun (n) 65 | (funcall (cond ((greaterp n 100) 'double) 66 | (t 'square) ) 67 | n) 68 | ) 69 | 70 | (defun subst (old new lat) 71 | (cond ((null lat) ()) 72 | ((eq (car lat) old) (cons new (cdr lat))) 73 | (t (cons (car lat) (subst old new (cdr lat)))) 74 | ) 75 | ) 76 | 77 | (defun length (lat) 78 | (cond ((null lat) 0) 79 | (t (add1 (length (cdr lat)))) 80 | ) 81 | ) 82 | 83 | (defun intersect (set1 set2) 84 | (cond ((null set1) ()) 85 | ((member (car set1) set2) (cons (car set1) (intersect (cdr set1) set2))) 86 | (t (intersect (cdr set1) set2)) 87 | ) 88 | ) 89 | 90 | (defun factorial (n) 91 | (cond ((= n 1) 1) 92 | (t (* n (factorial (- n 1)))) 93 | ) 94 | ) 95 | 96 | (defun rem (x d) 97 | (- x (* (/ x d) d))) 98 | 99 | (defun is-even (x) 100 | (if (= 0 (rem x 2)) 101 | t 102 | nil)) 103 | 104 | (defun is-odd (x) 105 | (if (is-even x) 106 | nil 107 | t)) 108 | 109 | (defun is-divisible (x y) 110 | (if (= y 1) 111 | nil 112 | (if (>= y x) 113 | nil 114 | (if (= 0 (rem x y)) 115 | t 116 | nil)))) 117 | 118 | (defun is-prime (x) 119 | (if (is-even x) 120 | nil 121 | (is-prime-rec x 1))) 122 | 123 | (defun is-prime-rec 124 | (x y) 125 | (if (is-divisible x y) 126 | nil 127 | (if (>= y x) 128 | t 129 | (is-prime-rec x (+ 2 y))))) 130 | 131 | (defun gcd (x y) 132 | (cond 133 | ((= y 0) x) 134 | (t (gcd y (rem x y))))) 135 | 136 | (defun lcm (x y) 137 | (/ (abs (* x y)) (gcd x y))) 138 | 139 | (defun nth (lis n) 140 | (if (= n 0) 141 | (car lis) 142 | (nth (cdr lis) (- n 1)) 143 | ) 144 | ) 145 | 146 | (defun nthcdr (lst n) 147 | (if (<= n 0) lst 148 | (nthcdr (cdr lst) (- n 1)))) 149 | 150 | (defun list-ref (lst n) 151 | (car (nthcdr lst n))) 152 | 153 | (defun filter (pred lst) 154 | (cond ((null lst) ()) 155 | ((not (pred (car lst))) (filter pred (cdr lst))) 156 | (t (cons (car lst) (filter pred (cdr lst)))))) 157 | 158 | (defun caar (x) (car (car x))) 159 | 160 | (defun assoc (item lst) 161 | (cond ((atom lst) ()) 162 | ((eq (caar lst) item) (car lst)) 163 | (t (assoc item (cdr lst))))) 164 | 165 | (defun sum-to-n (n) 166 | (cond 167 | ((< n 0) 0) 168 | (t (+ n (sum-to-n (- n 1)))))) 169 | 170 | (defun gauss (n) 171 | (/ (* n (+ n 1)) 2)) 172 | 173 | (defun abs (x) (if (< x 0) (- 0 x) x)) 174 | 175 | (defun reverse- (zero lst) 176 | (if (null lst) zero 177 | (reverse- (cons (car lst) zero) (cdr lst)))) 178 | 179 | (defun reverse (lst) (reverse- () lst)) 180 | 181 | (defun last (l) 182 | (cond ((atom l) l) 183 | ((atom (cdr l)) l) 184 | (t (last (cdr l))))) 185 | 186 | (defun foldr (f zero lst) 187 | (if (null lst) zero 188 | (f (car lst) (foldr f zero (cdr lst))))) 189 | 190 | (defun foldl (f zero lst) 191 | (if (null lst) zero 192 | (foldl f (f (car lst) zero) (cdr lst)))) 193 | 194 | (defun reverse2 (lst) (foldl cons nil lst)) 195 | 196 | (defun append (a b) (foldr cons b a)) 197 | 198 | (defun identity (x) x) 199 | (defun copy-list (l) (map identity l)) 200 | (defun copy-tree (l) 201 | (if (atom l) l 202 | (cons (copy-tree (car l)) 203 | (copy-tree (cdr l))))) 204 | 205 | (defun every (pred lst) 206 | (or (atom lst) 207 | (and (funcall pred (car lst)) 208 | (every pred (cdr lst))))) 209 | 210 | (defun any (pred lst) 211 | (and (consp lst) 212 | (or (funcall pred (car lst)) 213 | (any pred (cdr lst))))) 214 | 215 | (last '(1 2 3 4)) 216 | (length '(0 1 2 3 4 5 6 7 8 9)) 217 | (filter numberp '(1 2 3 a b c 4 5 6)) 218 | (testfun 101) 219 | (pow 234 0) 220 | (reverse '(1 2 3 4 5 6 7)) 221 | (list-ref '(1 2 3 4) 1) 222 | (rember 'me '(please remove me)) 223 | (subst 'me 'you '(a list with me)) 224 | (any numberp '(1 a)) 225 | -------------------------------------------------------------------------------- /plisp/code/p7.lisp: -------------------------------------------------------------------------------- 1 | 2 | (defun nfibs (n) 3 | (if (< n 2) n 4 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 5 | ) 6 | ) 7 | 8 | (defun member (a lat) 9 | (cond ((null lat) nil) 10 | ((eq (car lat) a) t) 11 | (t (member a (cdr lat))) 12 | ) 13 | ) 14 | 15 | (defun rember (a lat) 16 | (cond ((null lat) ()) 17 | ((eq (car lat) a) (cdr lat)) 18 | (t (cons (car lat) (rember a (cdr lat)))) 19 | ) 20 | ) 21 | 22 | (defun eqn (n1 n2) 23 | (cond ((zerop n2) (zerop n1)) 24 | ((zerop n1) nil) 25 | (t (eqn (sub1 n1) (sub1 n2))) 26 | ) 27 | ) 28 | 29 | (defun multiins (old new lat) 30 | (cond ((null lat) ()) 31 | ((eq (car lat) old) (cons (car lat) 32 | (cons new (multiins old new (cdr lat))))) 33 | (t (cons (car lat) (multiins old new (cdr lat)))) 34 | ) 35 | ) 36 | 37 | (defun mapcar (fn x) 38 | (cond ((null x) nil) 39 | (t (cons (funcall fn (car x)) (mapcar fn (cdr x)))) 40 | ) 41 | ) 42 | 43 | (defun maplist (fn x) 44 | (cond ((null x) nil) 45 | (t (cons (funcall fn x) (maplist fn (cdr x)))) 46 | ) 47 | ) 48 | 49 | (defun map (f lst) 50 | (if (atom lst) lst 51 | (cons (f (car lst)) (map f (cdr lst))))) 52 | 53 | (defun mycar (x) (car x)) 54 | (defun mycdr (x) (cdr x)) 55 | 56 | (defun pow (n1 n2) 57 | (cond ((zerop n2) 1) 58 | (t (times n1 (pow n1 (sub1 n2)))) 59 | ) 60 | ) 61 | 62 | (defun double (n) (times n 2)) 63 | (defun square (n) (times n n)) 64 | (defun testfun (n) 65 | (funcall (cond ((greaterp n 100) 'double) 66 | (t 'square) ) 67 | n) 68 | ) 69 | 70 | (defun subst (old new lat) 71 | (cond ((null lat) ()) 72 | ((eq (car lat) old) (cons new (cdr lat))) 73 | (t (cons (car lat) (subst old new (cdr lat)))) 74 | ) 75 | ) 76 | 77 | (defun length (lat) 78 | (cond ((null lat) 0) 79 | (t (add1 (length (cdr lat)))) 80 | ) 81 | ) 82 | 83 | (defun intersect (set1 set2) 84 | (cond ((null set1) ()) 85 | ((member (car set1) set2) (cons (car set1) (intersect (cdr set1) set2))) 86 | (t (intersect (cdr set1) set2)) 87 | ) 88 | ) 89 | 90 | (defun factorial (n) 91 | (cond ((= n 1) 1) 92 | (t (* n (factorial (- n 1)))) 93 | ) 94 | ) 95 | 96 | (defun rem (x d) 97 | (- x (* (/ x d) d))) 98 | 99 | (defun is-even (x) 100 | (if (= 0 (rem x 2)) 101 | t 102 | nil)) 103 | 104 | (defun is-odd (x) 105 | (if (is-even x) 106 | nil 107 | t)) 108 | 109 | (defun is-divisible (x y) 110 | (if (= y 1) 111 | nil 112 | (if (>= y x) 113 | nil 114 | (if (= 0 (rem x y)) 115 | t 116 | nil)))) 117 | 118 | (defun is-prime (x) 119 | (if (is-even x) 120 | nil 121 | (is-prime-rec x 1))) 122 | 123 | (defun is-prime-rec 124 | (x y) 125 | (if (is-divisible x y) 126 | nil 127 | (if (>= y x) 128 | t 129 | (is-prime-rec x (+ 2 y))))) 130 | 131 | (defun gcd (x y) 132 | (cond 133 | ((= y 0) x) 134 | (t (gcd y (rem x y))))) 135 | 136 | (defun lcm (x y) 137 | (/ (abs (* x y)) (gcd x y))) 138 | 139 | (defun nth (lis n) 140 | (if (= n 0) 141 | (car lis) 142 | (nth (cdr lis) (- n 1)) 143 | ) 144 | ) 145 | 146 | (defun nthcdr (lst n) 147 | (if (<= n 0) lst 148 | (nthcdr (cdr lst) (- n 1)))) 149 | 150 | (defun list-ref (lst n) 151 | (car (nthcdr lst n))) 152 | 153 | (defun filter (pred lst) 154 | (cond ((null lst) ()) 155 | ((not (pred (car lst))) (filter pred (cdr lst))) 156 | (t (cons (car lst) (filter pred (cdr lst)))))) 157 | 158 | (defun caar (x) (car (car x))) 159 | 160 | (defun assoc (item lst) 161 | (cond ((atom lst) ()) 162 | ((eq (caar lst) item) (car lst)) 163 | (t (assoc item (cdr lst))))) 164 | 165 | (defun sum-to-n (n) 166 | (cond 167 | ((< n 0) 0) 168 | (t (+ n (sum-to-n (- n 1)))))) 169 | 170 | (defun gauss (n) 171 | (/ (* n (+ n 1)) 2)) 172 | 173 | (defun abs (x) (if (< x 0) (- 0 x) x)) 174 | 175 | (defun reverse- (zero lst) 176 | (if (null lst) zero 177 | (reverse- (cons (car lst) zero) (cdr lst)))) 178 | 179 | (defun reverse (lst) (reverse- () lst)) 180 | 181 | (defun last (l) 182 | (cond ((atom l) l) 183 | ((atom (cdr l)) l) 184 | (t (last (cdr l))))) 185 | 186 | (defun foldr (f zero lst) 187 | (if (null lst) zero 188 | (f (car lst) (foldr f zero (cdr lst))))) 189 | 190 | (defun foldl (f zero lst) 191 | (if (null lst) zero 192 | (foldl f (f (car lst) zero) (cdr lst)))) 193 | 194 | (defun reverse2 (lst) (foldl cons nil lst)) 195 | 196 | (defun append (a b) (foldr cons b a)) 197 | 198 | (defun identity (x) x) 199 | (defun copy-list (l) (map identity l)) 200 | (defun copy-tree (l) 201 | (if (atom l) l 202 | (cons (copy-tree (car l)) 203 | (copy-tree (cdr l))))) 204 | 205 | (defun every (pred lst) 206 | (or (atom lst) 207 | (and (funcall pred (car lst)) 208 | (every pred (cdr lst))))) 209 | 210 | (defun any (pred lst) 211 | (and (consp lst) 212 | (or (funcall pred (car lst)) 213 | (any pred (cdr lst))))) 214 | 215 | (nth '(1 2 3 4 5) 1) 216 | (pow 2 3) 217 | (reverse2 '(1 2 3 4 5 6 7 8 9)) 218 | (rember 'me '(please remove me)) 219 | (length '(0 1 2 3 4 5 6 7 8 9)) 220 | (pow 234 0) 221 | (copy-list '(a b c d e f g)) 222 | (sum-to-n 100) 223 | (list-ref '(1 2 3 4) 1) 224 | (append '(1 2 3 4) '(5 6 7 8 9)) 225 | -------------------------------------------------------------------------------- /plisp/code/p8.lisp: -------------------------------------------------------------------------------- 1 | 2 | (defun nfibs (n) 3 | (if (< n 2) n 4 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 5 | ) 6 | ) 7 | 8 | (defun member (a lat) 9 | (cond ((null lat) nil) 10 | ((eq (car lat) a) t) 11 | (t (member a (cdr lat))) 12 | ) 13 | ) 14 | 15 | (defun rember (a lat) 16 | (cond ((null lat) ()) 17 | ((eq (car lat) a) (cdr lat)) 18 | (t (cons (car lat) (rember a (cdr lat)))) 19 | ) 20 | ) 21 | 22 | (defun eqn (n1 n2) 23 | (cond ((zerop n2) (zerop n1)) 24 | ((zerop n1) nil) 25 | (t (eqn (sub1 n1) (sub1 n2))) 26 | ) 27 | ) 28 | 29 | (defun multiins (old new lat) 30 | (cond ((null lat) ()) 31 | ((eq (car lat) old) (cons (car lat) 32 | (cons new (multiins old new (cdr lat))))) 33 | (t (cons (car lat) (multiins old new (cdr lat)))) 34 | ) 35 | ) 36 | 37 | (defun mapcar (fn x) 38 | (cond ((null x) nil) 39 | (t (cons (funcall fn (car x)) (mapcar fn (cdr x)))) 40 | ) 41 | ) 42 | 43 | (defun maplist (fn x) 44 | (cond ((null x) nil) 45 | (t (cons (funcall fn x) (maplist fn (cdr x)))) 46 | ) 47 | ) 48 | 49 | (defun map (f lst) 50 | (if (atom lst) lst 51 | (cons (f (car lst)) (map f (cdr lst))))) 52 | 53 | (defun mycar (x) (car x)) 54 | (defun mycdr (x) (cdr x)) 55 | 56 | (defun pow (n1 n2) 57 | (cond ((zerop n2) 1) 58 | (t (times n1 (pow n1 (sub1 n2)))) 59 | ) 60 | ) 61 | 62 | (defun double (n) (times n 2)) 63 | (defun square (n) (times n n)) 64 | (defun testfun (n) 65 | (funcall (cond ((greaterp n 100) 'double) 66 | (t 'square) ) 67 | n) 68 | ) 69 | 70 | (defun subst (old new lat) 71 | (cond ((null lat) ()) 72 | ((eq (car lat) old) (cons new (cdr lat))) 73 | (t (cons (car lat) (subst old new (cdr lat)))) 74 | ) 75 | ) 76 | 77 | (defun length (lat) 78 | (cond ((null lat) 0) 79 | (t (add1 (length (cdr lat)))) 80 | ) 81 | ) 82 | 83 | (defun intersect (set1 set2) 84 | (cond ((null set1) ()) 85 | ((member (car set1) set2) (cons (car set1) (intersect (cdr set1) set2))) 86 | (t (intersect (cdr set1) set2)) 87 | ) 88 | ) 89 | 90 | (defun factorial (n) 91 | (cond ((= n 1) 1) 92 | (t (* n (factorial (- n 1)))) 93 | ) 94 | ) 95 | 96 | (defun rem (x d) 97 | (- x (* (/ x d) d))) 98 | 99 | (defun is-even (x) 100 | (if (= 0 (rem x 2)) 101 | t 102 | nil)) 103 | 104 | (defun is-odd (x) 105 | (if (is-even x) 106 | nil 107 | t)) 108 | 109 | (defun is-divisible (x y) 110 | (if (= y 1) 111 | nil 112 | (if (>= y x) 113 | nil 114 | (if (= 0 (rem x y)) 115 | t 116 | nil)))) 117 | 118 | (defun is-prime (x) 119 | (if (is-even x) 120 | nil 121 | (is-prime-rec x 1))) 122 | 123 | (defun is-prime-rec 124 | (x y) 125 | (if (is-divisible x y) 126 | nil 127 | (if (>= y x) 128 | t 129 | (is-prime-rec x (+ 2 y))))) 130 | 131 | (defun gcd (x y) 132 | (cond 133 | ((= y 0) x) 134 | (t (gcd y (rem x y))))) 135 | 136 | (defun lcm (x y) 137 | (/ (abs (* x y)) (gcd x y))) 138 | 139 | (defun nth (lis n) 140 | (if (= n 0) 141 | (car lis) 142 | (nth (cdr lis) (- n 1)) 143 | ) 144 | ) 145 | 146 | (defun nthcdr (lst n) 147 | (if (<= n 0) lst 148 | (nthcdr (cdr lst) (- n 1)))) 149 | 150 | (defun list-ref (lst n) 151 | (car (nthcdr lst n))) 152 | 153 | (defun filter (pred lst) 154 | (cond ((null lst) ()) 155 | ((not (pred (car lst))) (filter pred (cdr lst))) 156 | (t (cons (car lst) (filter pred (cdr lst)))))) 157 | 158 | (defun caar (x) (car (car x))) 159 | 160 | (defun assoc (item lst) 161 | (cond ((atom lst) ()) 162 | ((eq (caar lst) item) (car lst)) 163 | (t (assoc item (cdr lst))))) 164 | 165 | (defun sum-to-n (n) 166 | (cond 167 | ((< n 0) 0) 168 | (t (+ n (sum-to-n (- n 1)))))) 169 | 170 | (defun gauss (n) 171 | (/ (* n (+ n 1)) 2)) 172 | 173 | (defun abs (x) (if (< x 0) (- 0 x) x)) 174 | 175 | (defun reverse- (zero lst) 176 | (if (null lst) zero 177 | (reverse- (cons (car lst) zero) (cdr lst)))) 178 | 179 | (defun reverse (lst) (reverse- () lst)) 180 | 181 | (defun last (l) 182 | (cond ((atom l) l) 183 | ((atom (cdr l)) l) 184 | (t (last (cdr l))))) 185 | 186 | (defun foldr (f zero lst) 187 | (if (null lst) zero 188 | (f (car lst) (foldr f zero (cdr lst))))) 189 | 190 | (defun foldl (f zero lst) 191 | (if (null lst) zero 192 | (foldl f (f (car lst) zero) (cdr lst)))) 193 | 194 | (defun reverse2 (lst) (foldl cons nil lst)) 195 | 196 | (defun append (a b) (foldr cons b a)) 197 | 198 | (defun identity (x) x) 199 | (defun copy-list (l) (map identity l)) 200 | (defun copy-tree (l) 201 | (if (atom l) l 202 | (cons (copy-tree (car l)) 203 | (copy-tree (cdr l))))) 204 | 205 | (defun every (pred lst) 206 | (or (atom lst) 207 | (and (funcall pred (car lst)) 208 | (every pred (cdr lst))))) 209 | 210 | (defun any (pred lst) 211 | (and (consp lst) 212 | (or (funcall pred (car lst)) 213 | (any pred (cdr lst))))) 214 | 215 | (member 'me '(please remove me)) 216 | (rember 'me '(please remove me)) 217 | (last '(1 2 3 4)) 218 | (testfun 13) 219 | (nth '(1 2 3 4 5) 1) 220 | (length '(0 1 2 3 4 5 6 7 8 9)) 221 | (mapcar 'mycar '( (1 2) (3 4) (5 6))) 222 | (gauss 100) 223 | (nthcdr '(1 2 3 4 5) 2) 224 | (testfun 101) 225 | -------------------------------------------------------------------------------- /plisp/code/p9.lisp: -------------------------------------------------------------------------------- 1 | 2 | (defun nfibs (n) 3 | (if (< n 2) n 4 | (+ 0 (nfibs (- n 1)) (nfibs (- n 2))) 5 | ) 6 | ) 7 | 8 | (defun member (a lat) 9 | (cond ((null lat) nil) 10 | ((eq (car lat) a) t) 11 | (t (member a (cdr lat))) 12 | ) 13 | ) 14 | 15 | (defun rember (a lat) 16 | (cond ((null lat) ()) 17 | ((eq (car lat) a) (cdr lat)) 18 | (t (cons (car lat) (rember a (cdr lat)))) 19 | ) 20 | ) 21 | 22 | (defun eqn (n1 n2) 23 | (cond ((zerop n2) (zerop n1)) 24 | ((zerop n1) nil) 25 | (t (eqn (sub1 n1) (sub1 n2))) 26 | ) 27 | ) 28 | 29 | (defun multiins (old new lat) 30 | (cond ((null lat) ()) 31 | ((eq (car lat) old) (cons (car lat) 32 | (cons new (multiins old new (cdr lat))))) 33 | (t (cons (car lat) (multiins old new (cdr lat)))) 34 | ) 35 | ) 36 | 37 | (defun mapcar (fn x) 38 | (cond ((null x) nil) 39 | (t (cons (funcall fn (car x)) (mapcar fn (cdr x)))) 40 | ) 41 | ) 42 | 43 | (defun maplist (fn x) 44 | (cond ((null x) nil) 45 | (t (cons (funcall fn x) (maplist fn (cdr x)))) 46 | ) 47 | ) 48 | 49 | (defun map (f lst) 50 | (if (atom lst) lst 51 | (cons (f (car lst)) (map f (cdr lst))))) 52 | 53 | (defun mycar (x) (car x)) 54 | (defun mycdr (x) (cdr x)) 55 | 56 | (defun pow (n1 n2) 57 | (cond ((zerop n2) 1) 58 | (t (times n1 (pow n1 (sub1 n2)))) 59 | ) 60 | ) 61 | 62 | (defun double (n) (times n 2)) 63 | (defun square (n) (times n n)) 64 | (defun testfun (n) 65 | (funcall (cond ((greaterp n 100) 'double) 66 | (t 'square) ) 67 | n) 68 | ) 69 | 70 | (defun subst (old new lat) 71 | (cond ((null lat) ()) 72 | ((eq (car lat) old) (cons new (cdr lat))) 73 | (t (cons (car lat) (subst old new (cdr lat)))) 74 | ) 75 | ) 76 | 77 | (defun length (lat) 78 | (cond ((null lat) 0) 79 | (t (add1 (length (cdr lat)))) 80 | ) 81 | ) 82 | 83 | (defun intersect (set1 set2) 84 | (cond ((null set1) ()) 85 | ((member (car set1) set2) (cons (car set1) (intersect (cdr set1) set2))) 86 | (t (intersect (cdr set1) set2)) 87 | ) 88 | ) 89 | 90 | (defun factorial (n) 91 | (cond ((= n 1) 1) 92 | (t (* n (factorial (- n 1)))) 93 | ) 94 | ) 95 | 96 | (defun rem (x d) 97 | (- x (* (/ x d) d))) 98 | 99 | (defun is-even (x) 100 | (if (= 0 (rem x 2)) 101 | t 102 | nil)) 103 | 104 | (defun is-odd (x) 105 | (if (is-even x) 106 | nil 107 | t)) 108 | 109 | (defun is-divisible (x y) 110 | (if (= y 1) 111 | nil 112 | (if (>= y x) 113 | nil 114 | (if (= 0 (rem x y)) 115 | t 116 | nil)))) 117 | 118 | (defun is-prime (x) 119 | (if (is-even x) 120 | nil 121 | (is-prime-rec x 1))) 122 | 123 | (defun is-prime-rec 124 | (x y) 125 | (if (is-divisible x y) 126 | nil 127 | (if (>= y x) 128 | t 129 | (is-prime-rec x (+ 2 y))))) 130 | 131 | (defun gcd (x y) 132 | (cond 133 | ((= y 0) x) 134 | (t (gcd y (rem x y))))) 135 | 136 | (defun lcm (x y) 137 | (/ (abs (* x y)) (gcd x y))) 138 | 139 | (defun nth (lis n) 140 | (if (= n 0) 141 | (car lis) 142 | (nth (cdr lis) (- n 1)) 143 | ) 144 | ) 145 | 146 | (defun nthcdr (lst n) 147 | (if (<= n 0) lst 148 | (nthcdr (cdr lst) (- n 1)))) 149 | 150 | (defun list-ref (lst n) 151 | (car (nthcdr lst n))) 152 | 153 | (defun filter (pred lst) 154 | (cond ((null lst) ()) 155 | ((not (pred (car lst))) (filter pred (cdr lst))) 156 | (t (cons (car lst) (filter pred (cdr lst)))))) 157 | 158 | (defun caar (x) (car (car x))) 159 | 160 | (defun assoc (item lst) 161 | (cond ((atom lst) ()) 162 | ((eq (caar lst) item) (car lst)) 163 | (t (assoc item (cdr lst))))) 164 | 165 | (defun sum-to-n (n) 166 | (cond 167 | ((< n 0) 0) 168 | (t (+ n (sum-to-n (- n 1)))))) 169 | 170 | (defun gauss (n) 171 | (/ (* n (+ n 1)) 2)) 172 | 173 | (defun abs (x) (if (< x 0) (- 0 x) x)) 174 | 175 | (defun reverse- (zero lst) 176 | (if (null lst) zero 177 | (reverse- (cons (car lst) zero) (cdr lst)))) 178 | 179 | (defun reverse (lst) (reverse- () lst)) 180 | 181 | (defun last (l) 182 | (cond ((atom l) l) 183 | ((atom (cdr l)) l) 184 | (t (last (cdr l))))) 185 | 186 | (defun foldr (f zero lst) 187 | (if (null lst) zero 188 | (f (car lst) (foldr f zero (cdr lst))))) 189 | 190 | (defun foldl (f zero lst) 191 | (if (null lst) zero 192 | (foldl f (f (car lst) zero) (cdr lst)))) 193 | 194 | (defun reverse2 (lst) (foldl cons nil lst)) 195 | 196 | (defun append (a b) (foldr cons b a)) 197 | 198 | (defun identity (x) x) 199 | (defun copy-list (l) (map identity l)) 200 | (defun copy-tree (l) 201 | (if (atom l) l 202 | (cons (copy-tree (car l)) 203 | (copy-tree (cdr l))))) 204 | 205 | (defun every (pred lst) 206 | (or (atom lst) 207 | (and (funcall pred (car lst)) 208 | (every pred (cdr lst))))) 209 | 210 | (defun any (pred lst) 211 | (and (consp lst) 212 | (or (funcall pred (car lst)) 213 | (any pred (cdr lst))))) 214 | 215 | (reverse '(1 2 3 4 5 6 7 8 9)) 216 | (rember 'me '(please remove me)) 217 | (every numberp '(1 a)) 218 | (length '(0 1 2 3 4 5 6 7 8 9)) 219 | (testfun 101) 220 | (testfun 13) 221 | (every numberp '(1 2)) 222 | (any numberp '(1 a)) 223 | (intersect '(a b c d e f) '(d e f)) 224 | (nfibs 10) 225 | -------------------------------------------------------------------------------- /plisp/defines.h: -------------------------------------------------------------------------------- 1 | #include "params.h" 2 | 3 | #define BUF_ADDRESS 0x8f000000 4 | 5 | #define is == 6 | #define isnt != 7 | #define not ! 8 | #define and && 9 | #define or || 10 | #define in , 11 | 12 | #define forlist(...) forlist_xp(forlist_in, (__VA_ARGS__)) 13 | #define forlist_in(X, S) for(node *X = S; X isnt NULLPTR; nextptr(X)) 14 | #define forlist_xp(X, A) X A 15 | 16 | #define forlist2(...) forlist_xp(forlist_in2, (__VA_ARGS__)) 17 | #define forlist_in2(X, S, XX, SS) for(node *X = S, *XX = SS; X isnt NULLPTR and XX isnt NULLPTR; nextptr(X), nextptr(XX)) 18 | 19 | #define forheap(...) forlist_xp(forheap_in, (__VA_ARGS__)) 20 | #define forheap_in(X, S) for(node *X = S; X isnt NULLPTR; X = next(X)) 21 | 22 | #define PERMANENT 2 23 | 24 | #define EOS '\0' 25 | #define EOSP(X) ((X) is EOS) 26 | #define nullp(X) ((X) is NULLPTR) 27 | 28 | #define ppval(X) (**(X)) 29 | #define ppdec(X) ((*(X))--) 30 | #define ppvalinc(X) (*(*(X))++) 31 | #define ppinc(X) (*(X))++ 32 | 33 | #define nextptr(X) ((X) = cdr(X)) 34 | #define rplaca(X,Y) ((X)->car = (Y)) 35 | #define rplacd(X,Y) ((X)->cdr = (Y)) 36 | 37 | #define next(X) ((X)->next) 38 | #define type(X) ((X)->type) 39 | #define funcname(X) ((X)->fname->s) 40 | #define funcptr(X) ((X)->fn) 41 | #define largs(X) ((X)->args) 42 | #define lbody(X) ((X)->body) 43 | #define ival(X) ((X)->i) 44 | #define ebindings(X) ((X)->bindings) 45 | 46 | #define consp(X) ((X) and (X)->type is LIST) 47 | #define pairp(X) ((X) and (X)->type is PAIR) 48 | #define symp(X) ((X) and (X)->type is SYM) 49 | #define subrp(X) ((X) and (X)->type is SUBR) 50 | #define fsubrp(X) ((X) and (X)->type is FSUBR) 51 | #define lambdap(X) ((X) and (X)->type is LAMBDA) 52 | #define intp(X) ((X) and (X)->type is INT) 53 | #define nilp(X) ((X) and (X)->type is NIL) 54 | #define teep(X) ((X) and (X)->type is TEE) 55 | 56 | #define car(X) ((X)->car) 57 | #define cdr(X) ((X)->cdr) 58 | #define caar(X) (car(car(X))) 59 | #define cadar(X) (car(cdr(car(X)))) 60 | -------------------------------------------------------------------------------- /plisp/device_main.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include "defines.h" 6 | #include "structures.h" 7 | #define EXTERNAL extern 8 | #include "globals.h" 9 | #include "device_proto.h" 10 | 11 | int main(int argc, char *argv[]) { 12 | unsigned int row, col; 13 | char *input; 14 | 15 | // 16 | // get the core id 17 | // 18 | id = coreID(&row, &col); 19 | // 20 | // Initialize the core 21 | // 22 | input = coreInit(argc, argv, id); 23 | // 24 | // Read, Eval and Print 25 | // 26 | REPL(input); 27 | // 28 | // Print stats and exit 29 | // 30 | setflag("Exited normally!"); 31 | return 0; 32 | } 33 | -------------------------------------------------------------------------------- /plisp/device_proto.h: -------------------------------------------------------------------------------- 1 | /* device_main.c */ 2 | int main(int argc, char *argv[]); 3 | /* libdevice.c */ 4 | char *readFile(char *fileName); 5 | void createFreelist(ememory *memory, int rows, int cols); 6 | void createStringFreelist(ememory *memory, int rows, int cols); 7 | void createNameFreelist(ememory *memory, int rows, int cols); 8 | void nl(void); 9 | void prpair(node *l); 10 | void print(node *l); 11 | void prGlobals(ememory *memory, int id); 12 | int coreID(unsigned int *row, unsigned int *col); 13 | char *coreInit(int argc, char *argv[], int cid); 14 | void setflag(char *message); 15 | /* libplisp.c */ 16 | void pr(node *cell); 17 | void addInt(long long i); 18 | void addString(char *s); 19 | void addValue(char *s, long long i); 20 | char *scpy(char *s1, const char *s2); 21 | long long stoi(const char *c); 22 | int slen(char *s); 23 | void saveGlobals(char *message); 24 | string *smalloc(void); 25 | string *string_malloc(void); 26 | void string_free(string *n); 27 | namestr *nmalloc(void); 28 | namestr *name_malloc(void); 29 | void name_free(namestr *n); 30 | node *omalloc(void); 31 | node *node_malloc(void); 32 | void node_free(node *n); 33 | void pushFree(stack *ptr, stack **stk); 34 | stack *popFree(stack **stk); 35 | node *newnode(enum ltype type); 36 | node *sym(char *val); 37 | node *cons(node *head, node *tail); 38 | node *pair(node *head, node *tail); 39 | node *func(node *(*fn)(node *, node *), enum ltype type); 40 | node *lambda(node *args, node *sexp); 41 | node *integer(long long num); 42 | node *newcontext(node *bindings, node *top); 43 | void clear_bindings(node *env); 44 | node *lastcell(node *list); 45 | node *append(node *list, node *obj); 46 | node *concat(node *l1, node *l2); 47 | void atl(node **l, node *item); 48 | void add_pair(node *head, node *tail, node **list); 49 | void pushNode(node *item, node **stk); 50 | node *popNode(node **stk); 51 | node *nextarg(node **pargs); 52 | char *name(node *o); 53 | int strequal(char *s1, char *s2); 54 | node *assq(char *key, node *list); 55 | node *lookupsym(char *name, node *env); 56 | node *make_env(node *vars, node *vals, node *env); 57 | node *el_car(node *args, node *env); 58 | node *el_cdr(node *args, node *env); 59 | node *el_nilp(node *args, node *env); 60 | node *el_quote(node *args, node *env); 61 | node *el_cons(node *args, node *env); 62 | node *el_cond(node *args, node *env); 63 | node *el_if(node *args, node *env); 64 | node *el_lambda(node *args, node *env); 65 | node *el_label(node *args, node *env); 66 | node *el_ldefine(node *args, node *env); 67 | node *el_loop(node *args, node *env); 68 | node *el_block(node *args, node *env); 69 | node *el_progn(node *args, node *env); 70 | node *el_print(node *args, node *env); 71 | node *el_terpri(node *args, node *env); 72 | node *binary(node *args, int fcn); 73 | node *compare(node *args, int fcn); 74 | node *el_lessthan(node *args, node *env); 75 | node *el_greaterthan(node *args, node *env); 76 | node *el_eq(node *args, node *env); 77 | node *el_plus(node *args, node *env); 78 | node *el_minus(node *args, node *env); 79 | node *el_times(node *args, node *env); 80 | node *el_divide(node *args, node *env); 81 | node *el_atom(node *args, node *env); 82 | node *el_equal(node *args, node *env); 83 | node *el_lessthanequal(node *args, node *env); 84 | node *el_greaterthanequal(node *args, node *env); 85 | node *el_defun(node *args, node *env); 86 | node *el_consp(node *args, node *env); 87 | node *el_funcall(node *args, node *env); 88 | node *el_zerop(node *args, node *env); 89 | node *el_sub1(node *args, node *env); 90 | node *el_add1(node *args, node *env); 91 | node *el_numberp(node *args, node *env); 92 | node *el_or(node *args, node *env); 93 | node *el_and(node *args, node *env); 94 | node *el_not(node *args, node *env); 95 | node *el_setflag(node *args, node *env); 96 | node *el_id(node *args, node *env); 97 | node *el_setyc(node *args, node *env); 98 | node *el_unsetyc(node *args, node *env); 99 | node *init_lisp(void); 100 | int getChar(char **s); 101 | int ungetChar(char **s); 102 | char *getToken(char **s, char *token); 103 | node *tokenize(char **code); 104 | int equal(node *sym, char *s2); 105 | int is_valid_int(char *str); 106 | node *makeNode(node *n); 107 | node *_parse(node **code, char *terminator); 108 | node *parse(node **code); 109 | node *parse_string(char **input); 110 | int length(node *l); 111 | node *bind_variables(node *expr, node *env); 112 | node *evlambda(node *vals, node *expr, node *env); 113 | node *evform(node *fnode, node *exp, node *env); 114 | node *evsym(node *exp, node *env); 115 | node *eval_list(node *sexp, node *env); 116 | node *eval(node *input, node *env); 117 | void REPL(char *input); 118 | -------------------------------------------------------------------------------- /plisp/globals.h: -------------------------------------------------------------------------------- 1 | EXTERNAL node *tee; 2 | EXTERNAL node *nil; 3 | EXTERNAL node *NULLPTR; 4 | EXTERNAL node *globals; 5 | EXTERNAL node *history; 6 | EXTERNAL node *freelist; 7 | EXTERNAL string *stringfreelist; 8 | EXTERNAL namestr *namefreelist; 9 | EXTERNAL node *allocated; 10 | 11 | EXTERNAL int nnodes; 12 | EXTERNAL int nodemem; 13 | EXTERNAL int nnames; 14 | EXTERNAL int namemem; 15 | EXTERNAL int nstrings; 16 | EXTERNAL int stringmem; 17 | 18 | EXTERNAL ememory *memory; 19 | EXTERNAL int id; 20 | -------------------------------------------------------------------------------- /plisp/host_main.c: -------------------------------------------------------------------------------- 1 | #define EPIPHANY 1 2 | 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include "libhost.h" 10 | #include "structures.h" 11 | #include "host_proto.h" 12 | #define EXTERNAL extern 13 | #include "globals.h" 14 | 15 | int e_load_group(char *executable, e_epiphany_t *dev, unsigned row, unsigned col, unsigned rows, unsigned cols, e_bool_t start); 16 | 17 | // 18 | // Lets go! 19 | // 20 | int main(int argc, char *argv[]) { 21 | int rows, cols, result; 22 | char *code, filename[64]; 23 | e_platform_t platform; 24 | e_epiphany_t dev; 25 | e_mem_t emem; 26 | // 27 | // init the device and get platform data 28 | // 29 | if (E_OK != e_init(NULL)) { 30 | fprintf(stderr, "\nERROR: epiphinay initialization failed!\n\n"); 31 | exit(1); 32 | } 33 | if (E_OK != e_reset_system() ) { 34 | fprintf(stderr, "\nWARNING: epiphinay system rest failed!\n\n"); 35 | } 36 | fprintf(stderr, "Getting platform info\n"); 37 | if ( E_OK != e_get_platform_info(&platform) ) { 38 | fprintf(stderr, "Failed to get Epiphany platform info\n"); 39 | exit(1); 40 | } 41 | fprintf(stderr, "Platform version: %s, HAL version 0x%08x\n", 42 | platform.version, platform.hal_ver); 43 | rows = platform.rows; 44 | cols = platform.cols; 45 | memory = init_ememory(argc, argv, rows, cols); 46 | // 47 | // open the device 48 | // 49 | if (E_OK != e_open(&dev, 0, 0, rows, cols)) { 50 | fprintf(stderr, "\nERROR: Can't establish connection to Epiphany device!\n\n"); 51 | exit(1); 52 | } 53 | // 54 | // Write the ememory data structure to device memory 55 | // 56 | write_ememory(&emem, memory); 57 | // 58 | // Load the code 59 | // 60 | clear_done_flags(&dev, rows, cols); 61 | result = e_load_group("./fl-device.srec", &dev, 0, 0, rows, cols, E_TRUE); 62 | if (result == E_ERR) { 63 | printf("Error loading Epiphany program.\n"); 64 | exit(1); 65 | } 66 | // 67 | // Poll the device waiting for all cores to finish 68 | // 69 | poll_device(&dev, rows, cols); 70 | // 71 | // Process the results of device processing 72 | // 73 | process_ememory(&emem, memory, rows, cols); 74 | // 75 | // Close and finalize the device 76 | // 77 | if (e_close(&dev)) { 78 | printf( "\nERROR: Can't close connection to Epiphany device!\n\n"); 79 | exit(1); 80 | } 81 | if (e_free(&emem)) { 82 | printf( "\nERROR: Can't release Epiphany DRAM!\n\n"); 83 | exit(1); 84 | } 85 | e_finalize(); 86 | } 87 | -------------------------------------------------------------------------------- /plisp/host_proto.h: -------------------------------------------------------------------------------- 1 | /* host_main.c */ 2 | int main(int argc, char *argv[]); 3 | /* libhost.c */ 4 | char *host_ptr(char *ptr); 5 | node *dr_node(node *cell); 6 | node *car(node *cell); 7 | node *cdr(node *cell); 8 | node *largs(node *cell); 9 | node *lbody(node *cell); 10 | char *dr_name(node *cell); 11 | long long ival(node *cell); 12 | void prpair(node *l); 13 | void print(node *l); 14 | char *readFile(char *fileName); 15 | void *device_ptr(char *base, char *ptr); 16 | void createFreelist(ememory *memory, int rows, int cols); 17 | void createStringFreelist(ememory *memory, int rows, int cols); 18 | void createNameFreelist(ememory *memory, int rows, int cols); 19 | ememory *init_ememory(int argc, char *argv[], int rows, int cols); 20 | void write_ememory(e_mem_t *emem, ememory *memory); 21 | void clear_done_flags(e_epiphany_t *dev, int rows, int cols); 22 | void poll_device(e_epiphany_t *dev, int rows, int cols); 23 | void prGlobals(ememory *memory, int id); 24 | void process_ememory(e_mem_t *emem, ememory *memory, int rows, int cols); 25 | -------------------------------------------------------------------------------- /plisp/includes.h: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #if EPIPHANY 7 | #include "e-lib.h" 8 | #endif 9 | #include "defines.h" 10 | #include "structures.h" 11 | #define EXTERNAL 12 | #include "globals.h" 13 | #include "device_proto.h" 14 | 15 | #define BUF_ADDRESS 0x8f000000 16 | -------------------------------------------------------------------------------- /plisp/libhost.h: -------------------------------------------------------------------------------- 1 | #include "params.h" 2 | 3 | #define type(X) ((X)->type) 4 | 5 | #define nullp(X) ((X) == NULLPTR) 6 | #define consp(X) ((X) && (X)->type == LIST) 7 | #define pairp(X) ((X) && (X)->type == PAIR) 8 | #define symp(X) ((X) && (X)->type == SYM) 9 | #define subrp(X) ((X) && (X)->type == SUBR) 10 | #define fsubrp(X) ((X) && (X)->type == FSUBR) 11 | #define lambdap(X) ((X) && (X)->type == LAMBDA) 12 | #define intp(X) ((X) && (X)->type == INT) 13 | #define nilp(X) ((X) && (X)->type == NIL) 14 | #define teep(X) ((X) && (X)->type == TEE) 15 | 16 | #define caar(X) (car(car(X))) 17 | #define cadar(X) (car(cdr(car(X)))) 18 | -------------------------------------------------------------------------------- /plisp/onefile.py: -------------------------------------------------------------------------------- 1 | 2 | def cat(filename, skip): 3 | fp = open(filename, "r") 4 | lines = fp.readlines() 5 | for line in lines[skip:]: 6 | print(line.rstrip()) 7 | 8 | 9 | if __name__ == "__main__": 10 | 11 | cat("includes.h", 0) 12 | cat("libplisp.c", 10) 13 | cat("libdevice.c", 14) 14 | cat("device_main.c", 9) 15 | -------------------------------------------------------------------------------- /plisp/params.h: -------------------------------------------------------------------------------- 1 | #if EPIPHANY 2 | #define DIRECTIVE __attribute__((aligned(8))) 3 | #else 4 | #define DIRECTIVE 5 | #endif 6 | 7 | #define TRUE 1 8 | #define FALSE 0 9 | 10 | #define NCORES 16 11 | #define BANKSIZE 8192 12 | #define STRINGMAX BANKSIZE 13 | #define NAMESTRMAX 32 14 | #define LINELENGTH 1024 15 | 16 | #define FREESTRING 10 17 | #define FREEOBJECT 20000 18 | #define FREENAME 8000 19 | -------------------------------------------------------------------------------- /plisp/plisp: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | ESDK=${EPIPHANY_HOME} 4 | ELIBS=${ESDK}/tools/host/lib:${LD_LIBRARY_PATH} 5 | EHDF=${EPIPHANY_HDF} 6 | ELDF=${ESDK}/bsps/current/internal.ldf 7 | 8 | SCRIPT=$(readlink -f "$0") 9 | EXEPATH=$(dirname "$SCRIPT") 10 | 11 | { 12 | $EXEPATH/fl-host.elf $* 13 | } || { 14 | sudo -E LD_LIBRARY_PATH=${ELIBS} EPIPHANY_HDF=${EHDF} $EXEPATH/fl-host.elf $* 15 | } 16 | 17 | if [ $? -ne 0 ] 18 | then 19 | echo "$SCRIPT FAILED" 20 | else 21 | echo "$SCRIPT PASSED" 22 | fi 23 | -------------------------------------------------------------------------------- /plisp/prog.lisp: -------------------------------------------------------------------------------- 1 | (defun foldr (f zero lst) 2 | (if (null lst) zero 3 | (funcall f (car lst) (foldr f zero (cdr lst))) 4 | ) 5 | ) 6 | 7 | (defun foldl (f zero lst) 8 | (if (null lst) zero 9 | (foldl f (funcall f (car lst) zero) (cdr lst)))) 10 | 11 | (defun reverse (lst) (foldl cons nil lst)) 12 | 13 | (defun append (a b) (foldr cons b a)) 14 | 15 | (defun iota (start end) 16 | (if (< start end) 17 | (cons start (iota (+ 1 start) end)) 18 | nil 19 | ) 20 | ) 21 | 22 | (defun flatten (lst) 23 | (if (null lst) nil 24 | (if (consp (car lst)) 25 | (append (flatten (car lst)) 26 | (flatten (cdr lst))) 27 | (cons (car lst) 28 | (flatten (cdr lst)))))) 29 | 30 | (define length 31 | (lambda (L) 32 | (if L 33 | (+ 1 (length (cdr L))) 34 | 0))) 35 | 36 | (define factorial-iter 37 | (lambda (n) 38 | (define fact-iter 39 | (lambda (n count acc) 40 | (if (> count n) 41 | acc 42 | (fact-iter n (+ count 1) (* count acc))))) 43 | (fact-iter n 1 1))) 44 | 45 | (label fibonacci 46 | (lambda (n) 47 | (label fibo 48 | (lambda (n a b) 49 | (if (= n 0) 50 | nil 51 | (cons a (fibo (- n 1) b (+ a b)))))) 52 | (fibo n 0 1))) 53 | 54 | (label square 55 | (lambda (x) (* x x))) 56 | 57 | (label cube 58 | (lambda (x) (* x x x))) 59 | 60 | (iota 0 10) 61 | 62 | (define l '((1 2 3) (4 5 6) (7 8 9) (10 11 12) (13 14 15) (16 17 18) (19 20 21))) 63 | (reverse l) 64 | (flatten l) 65 | 66 | (length '(1 2 3 4)) 67 | (square 3) 68 | (cube 3) 69 | (fibonacci 11) 70 | (factorial-iter 3) 71 | 72 | '(hello world from core (id)) 73 | -------------------------------------------------------------------------------- /plisp/run.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | ESDK=${EPIPHANY_HOME} 4 | ELIBS=${ESDK}/tools/host/lib:${LD_LIBRARY_PATH} 5 | EHDF=${EPIPHANY_HDF} 6 | ELDF=${ESDK}/bsps/current/internal.ldf 7 | 8 | SCRIPT=$(readlink -f "$0") 9 | EXEPATH=$(dirname "$SCRIPT") 10 | 11 | { 12 | $EXEPATH/fl-host.elf $* 13 | } || { 14 | sudo -E LD_LIBRARY_PATH=${ELIBS} EPIPHANY_HDF=${EHDF} $EXEPATH/fl-host.elf $* 15 | } 16 | 17 | if [ $? -ne 0 ] 18 | then 19 | echo "$SCRIPT FAILED" 20 | else 21 | echo "$SCRIPT PASSED" 22 | fi 23 | -------------------------------------------------------------------------------- /plisp/structures.h: -------------------------------------------------------------------------------- 1 | enum ltype {PAIR, LIST, SYM, SUBR, FSUBR, LAMBDA, INT, NIL, TEE, ENV, FREE}; 2 | 3 | typedef struct DIRECTIVE fdef fdef; 4 | typedef struct DIRECTIVE node node; 5 | 6 | typedef struct DIRECTIVE string string; 7 | typedef struct DIRECTIVE namestr namestr; 8 | typedef struct DIRECTIVE edata edata; 9 | typedef struct DIRECTIVE ememory ememory; 10 | 11 | typedef struct DIRECTIVE stack stack; 12 | 13 | struct DIRECTIVE node { 14 | node *next; 15 | unsigned char type; 16 | unsigned char marked; 17 | union { 18 | namestr *name; 19 | struct { 20 | node *car; 21 | node *cdr; 22 | }; 23 | struct { 24 | namestr *fname; 25 | node *(*fn)(node *, node *); 26 | }; 27 | struct { 28 | node *args; 29 | node *body; 30 | }; 31 | long long i; 32 | double r; 33 | struct { 34 | node *top; 35 | node *bindings; 36 | }; 37 | }; 38 | }; 39 | 40 | struct DIRECTIVE string { 41 | string *next; 42 | char s[STRINGMAX]; 43 | }; 44 | 45 | struct DIRECTIVE namestr { 46 | namestr *next; 47 | char s[NAMESTRMAX]; 48 | }; 49 | 50 | struct DIRECTIVE stack { 51 | void *next; 52 | }; 53 | 54 | struct DIRECTIVE edata { 55 | int id; 56 | int ememory_size; 57 | int node_size; 58 | int nnodes; 59 | int nodemem; 60 | int nnames; 61 | int namemem; 62 | int nstrings; 63 | int stringmem; 64 | int finished; 65 | char message[1024]; 66 | char code[BANKSIZE]; 67 | node *NULLPTR; 68 | node *history; 69 | node *freelist; 70 | namestr *namefreelist; 71 | string *stringfreelist; 72 | string freeStringArray[FREESTRING]; 73 | node freeNodeArray[FREEOBJECT]; 74 | namestr freeNameArray[FREENAME]; 75 | }; 76 | 77 | struct DIRECTIVE ememory { 78 | edata data[NCORES]; 79 | }; 80 | -------------------------------------------------------------------------------- /tests/eval.lisp: -------------------------------------------------------------------------------- 1 | (defun caar (lst) (car (car lst))) 2 | (defun cddr (lst) (cdr (cdr lst))) 3 | (defun cadr (lst) (car (cdr lst))) 4 | (defun cdar (lst) (cdr (car lst))) 5 | (defun cadar (lst) (car (cdr (car lst)))) 6 | (defun caddr (lst) (car (cdr (cdr lst)))) 7 | (defun caddar (lst) (car (cdr (cdr (car lst))))) 8 | 9 | (defun assoc (var lst) 10 | (cond ((eq (caar lst) var) (cadar lst)) 11 | (t (assoc var (cdr lst))))) 12 | 13 | (defun pair (x y) 14 | (cons x (cons y nil))) 15 | 16 | (defun zip (x y) 17 | (cond ((and (null x) (null y)) nil) 18 | ((and (not (atom x)) (not (atom y))) 19 | (cons (pair (car x) (car y)) 20 | (zip (cdr x) (cdr y)))))) 21 | 22 | (zip '(1 2 3) '(4 5 6)) 23 | 24 | (defun append (x y) 25 | (cond ((null x) y) 26 | (t (cons (car x) (append (cdr x) y))))) 27 | 28 | (append '(1 2 3) '(4 5 6)) 29 | 30 | (defun and (x y) 31 | (cond (x (cond (y t) (t nil))) 32 | (t nil))) 33 | 34 | (defun or (x y) 35 | (cond (x t) 36 | (t (cond (y t) (t nil))))) 37 | 38 | (defun not (x) 39 | (cond (x nil) 40 | (t t))) 41 | 42 | (defun eval (exp env) 43 | (cond 44 | ((atom exp) (assoc exp env)) 45 | ((atom (car exp)) 46 | (cond 47 | ((eq (car exp) 'quote) (cadr exp)) 48 | ((eq (car exp) 'atom) (atom (eval (cadr exp) env))) 49 | ((eq (car exp) 'eq) (eq (eval (cadr exp) env) 50 | (eval (caddr exp) env))) 51 | ((eq (car exp) 'car) (car (eval (cadr exp) env))) 52 | ((eq (car exp) 'cdr) (cdr (eval (cadr exp) env))) 53 | ((eq (car exp) 'cons) (cons (eval (cadr exp) env) 54 | (eval (caddr exp) env))) 55 | ((eq (car exp) 'cond) (evcon (cdr exp) env)) 56 | (t (eval (cons (assoc (car exp) env) (cdr exp)) env)) 57 | ) 58 | ) 59 | ((eq (caar exp) 'label) (bind exp env)) 60 | ((eq (caar exp) 'lambda) (evlambda exp env)) 61 | ) 62 | ) 63 | 64 | (defun evcon (c env) 65 | (cond ((eval (caar c) env) 66 | (eval (cadar c) env)) 67 | (t (evcon (cdr c) env)))) 68 | 69 | (defun evlis (m env) 70 | (cond ((null m) nil) 71 | (t (cons (eval (car m) env) 72 | (evlis (cdr m) env))))) 73 | 74 | (defun evlambda (exp env) 75 | (eval (caddar exp) 76 | (append (zip (cadar exp) (evlis (cdr exp) env)) 77 | env)) 78 | ) 79 | 80 | (defun bind (exp env) 81 | (eval (cons (caddar exp) (cdr exp)) 82 | (cons (pair (cadar exp) (car exp)) env)) 83 | ) 84 | 85 | (eval '(cons x '(b c)) '((x a) (y b))) 86 | (eval '(f '(bar baz)) '((f (lambda (x) (cons 'foo x))))) 87 | -------------------------------------------------------------------------------- /tests/functions.lisp: -------------------------------------------------------------------------------- 1 | (defun foldr (f zero lst) 2 | (if (null lst) zero 3 | (funcall f (car lst) (foldr f zero (cdr lst))) 4 | ) 5 | ) 6 | 7 | (defun foldl (f zero lst) 8 | (if (null lst) zero 9 | (foldl f (funcall f (car lst) zero) (cdr lst)))) 10 | 11 | (defun reverse (lst) (foldl cons nil lst)) 12 | 13 | (defun append (a b) (foldr cons b a)) 14 | 15 | (defun iota (start end) 16 | (if (<= start end) 17 | (cons start (iota (+ 1 start) end)) 18 | nil 19 | ) 20 | ) 21 | 22 | (defun flatten (lst) 23 | (if (null lst) nil 24 | (if (consp (car lst)) 25 | (append (flatten (car lst)) 26 | (flatten (cdr lst))) 27 | (cons (car lst) 28 | (flatten (cdr lst)))))) 29 | 30 | (reverse '(1 2 3 4 5 6 7 8 9)) 31 | (append '(a b c d e f g) '(h i j k l m n)) 32 | (iota -10 10) 33 | (flatten '((1 2 3) (4 5 6) (7 8 9) (10 11 12) (13 14 15) (16 17 18) (19 20 21))) 34 | -------------------------------------------------------------------------------- /tests/hello-world.lisp: -------------------------------------------------------------------------------- 1 | (block 'hello 'world 'from 'core (id)) 2 | -------------------------------------------------------------------------------- /tests/loop.lisp: -------------------------------------------------------------------------------- 1 | (defun foldr (f zero lst) 2 | (if (null lst) zero 3 | (funcall f (car lst) (foldr f zero (cdr lst))) 4 | ) 5 | ) 6 | 7 | (defun append (a b) (foldr cons b a)) 8 | 9 | (define x 2) 10 | (define y 2) 11 | (define result nil) 12 | (define func 13 | (lambda (n1 n2) 14 | (progn 15 | (ldefine y n2) 16 | (loop (> y -1) 17 | (ldefine x n1) 18 | (loop (> x -1) 19 | (define result (append result ((x y)))) 20 | (ldefine x (- x 1)) 21 | ) 22 | (ldefine y (- y 1)) 23 | ) 24 | nil 25 | ) 26 | ) 27 | ) 28 | (func x y) 29 | result 30 | (block x y) 31 | -------------------------------------------------------------------------------- /tests/math.lisp: -------------------------------------------------------------------------------- 1 | (define factorial-iter 2 | (lambda (n) 3 | (ldefine fact-iter 4 | (lambda (n count acc) 5 | (if (> count n) 6 | acc 7 | (fact-iter n (+ count 1) (* count acc))))) 8 | (fact-iter n 1 1))) 9 | 10 | (define fibonacci 11 | (lambda (n) 12 | (ldefine fibo 13 | (lambda (n a b) 14 | (if (= n 0) 15 | nil 16 | (cons a (fibo (- n 1) b (+ a b)))))) 17 | (fibo n 0 1))) 18 | 19 | (label square 20 | (lambda (x) (* x x))) 21 | 22 | (label cube 23 | (lambda (x) (* x x x))) 24 | 25 | (define length 26 | (lambda (L) 27 | (if L 28 | (+ 1 (length (cdr L))) 29 | 0))) 30 | 31 | (fibonacci 90) 32 | (factorial-iter 3) 33 | (square 3) 34 | (cube 3) 35 | (length '(1 2 3 4)) -------------------------------------------------------------------------------- /tests/ycomb.lisp: -------------------------------------------------------------------------------- 1 | (setyc) 2 | 3 | (defun 1- (x) (- x 1)) 4 | 5 | (defun factorial (number) 6 | (if (eq number 0) 1 7 | (* number (funcall factorial (1- number))))) 8 | 9 | (define proto-factorial 10 | (lambda (fun) 11 | (lambda (number) 12 | (if (eq number 0) 13 | 1 14 | (* number (funcall fun (1- number))) 15 | ) 16 | ) 17 | ) 18 | ) 19 | (funcall (proto-factorial factorial) 3) 20 | 21 | (lambda (fun) 22 | (lambda (number) 23 | (if (eq number 0) 24 | 1 25 | (* number (funcall (funcall fun fun) (1- number)))) 26 | ) 27 | ) 28 | 29 | (define meta-factorial 30 | (lambda (fun) 31 | (lambda (number) 32 | (if (eq number 0) 33 | 1 34 | (* number (funcall (funcall fun fun) (1- number))) 35 | ) 36 | ) 37 | ) 38 | ) 39 | 40 | (funcall 41 | (funcall meta-factorial meta-factorial) 42 | 4 43 | ) 44 | 45 | (funcall 46 | (funcall 47 | (lambda (fun) 48 | (lambda (number) 49 | (if (eq number 0) 1 50 | (* number (funcall (funcall fun fun) (1- number)))) 51 | ) 52 | ) 53 | (lambda (fun) 54 | (lambda (number) 55 | (if (eq number 0) 56 | 1 57 | (* number (funcall (funcall fun fun) (1- number))) 58 | ) 59 | ) 60 | ) 61 | ) 62 | 5 63 | ) 64 | 65 | (defun YCombinator (f) 66 | (funcall (lambda (x) 67 | (funcall f (lambda (y) 68 | (funcall (funcall x x) y) 69 | ) 70 | ) 71 | ) 72 | (lambda (x) 73 | (funcall f (lambda (y) 74 | (funcall (funcall x x) y) 75 | ) 76 | ) 77 | ) 78 | ) 79 | ) 80 | 81 | (funcall 82 | (YCombinator 83 | (lambda (f) 84 | (lambda (n) 85 | (if (eq n 0) 86 | 1 87 | (* n (funcall f (1- n))) 88 | ) 89 | ) 90 | ) 91 | ) 92 | 6 93 | ) 94 | 95 | (funcall 96 | (YCombinator 97 | (lambda (f) 98 | (lambda (n) 99 | (if (< n 2) 100 | n 101 | (+ (funcall f (- n 1)) 102 | (funcall f (- n 2)) 103 | ) 104 | ) 105 | ) 106 | ) 107 | ) 108 | 10 109 | ) 110 | 111 | (unsetyc) 112 | --------------------------------------------------------------------------------