├── README ├── compile.sh ├── fib5.lsp ├── lisp.lsp └── lisp2.lsp /README: -------------------------------------------------------------------------------- 1 | == Zick Standard Lisp 2 | 3 | A Lisp evaluator in Lisp. 4 | 5 | 6 | == What's this 7 | 8 | This is a Lisp evaluator for Zick's Lisp implementations. It supports 43 9 | implementations as of 2021-03-14 JST. 10 | - ScratchLisp: http://scratch.mit.edu/projects/18997849/ 11 | - LuaLisp: https://github.com/zick/LuaLisp 12 | - PyLisp: https://github.com/zick/PyLisp 13 | - RbLisp: https://github.com/zick/RbLisp 14 | - RLisp: https://github.com/zick/RLisp 15 | - PerLisp: https://github.com/zick/PerLisp 16 | - FactorLisp: https://github.com/zick/FactorLisp 17 | - IoLisp: https://github.com/zick/IoLisp 18 | - NekoLisp: https://github.com/zick/NekoLisp 19 | - TcLisp: https://github.com/zick/TcLisp 20 | - CoffeeLisp: https://github.com/zick/CoffeeLisp 21 | - TypeLisp: https://github.com/zick/TypeLisp 22 | - DartLisp: https://github.com/zick/DartLisp 23 | - FalconLisp: https://github.com/zick/FalconLisp 24 | - EuphoriaLisp: https://github.com/zick/EuphoriaLisp 25 | - JSXLisp: https://github.com/zick/JSXLIsp 26 | - FantomLisp: https://github.com/zick/FantomLisp 27 | - CeylonLisp: https://github.com/zick/CeylonLisp 28 | - GroovyLisp: https://github.com/zick/GroovyLisp 29 | - SMLisp: https://github.com/zick/SMLisp 30 | - OCamLisp: https://github.com/zick/OCamLisp 31 | - DLisp: https://github.com/zick/DLisp 32 | - JavaLisp: https://github.com/zick/JavaLisp 33 | - C#Lisp: https://github.com/zick/CSharpLIsp 34 | - HaxeLisp: https://github.com/zick/HaxeLisp 35 | - F#Lisp: https://github.com/zick/FSharpLIsp 36 | - KotlinLisp: https://github.com/zick/KotlinLIsp 37 | - JuliaLisp: https://github.com/zick/JuliaLisp 38 | - ScalaLisp: https://github.com/zick/ScalaLisp 39 | - LiveLisp: https://github.com/zick/LiveLisp 40 | - EiffeLisp: https://github.com/zick/EiffeLisp 41 | - SmalltalkLisp: https://github.com/zick/SmalltalkLisp 42 | - IconLisp: https://github.com/zick/IconLisp 43 | - Oberon2Lisp: https://github.com/zick/Oberon2Lisp 44 | - SquirreLisp: https://github.com/zick/SquirreLisp 45 | - DylanLisp: https://github.com/zick/DylanLisp 46 | - IokeLisp: https://github.com/zick/IokeLisp 47 | - ElangLisp: https://github.com/zick/ElangLisp 48 | - PikeLisp: https://github.com/zick/PikeLisp 49 | - ProcessingLisp: https://github.com/zick/ProcessingLisp 50 | - OzLisp: https://github.com/zick/OzLisp 51 | - BooLisp: https://github.com/zick/BooLisp 52 | - TempLisp: https://github.com/zick/TempLisp 53 | 54 | It consists of QUOTE, IF, LAMBDA, DEFUN, SETQ, CAR, CDR, CONS, EQ, ATOM, +, *, 55 | -, /, and MOD. It provides them all, so it can run itself recursively. 56 | 57 | 58 | == How to use 59 | 60 | # From command-line 61 | % ./compile.sh -e "(car '(a b c))" > car.zsl 62 | % lua lualisp.lua < car.zsl 63 | a 64 | # From file 65 | % ./compile.sh < fib5.lsp > fib5.zsl 66 | % python pylisp.py < fib5.zsl 67 | 8 68 | # Run this evaluator itself 69 | % ./compile.sh < car.zsl > car_rec.zsl 70 | % ruby rblisp.rb < car_rec.zsl 71 | a 72 | -------------------------------------------------------------------------------- /compile.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | v="" 3 | while getopts e:hv: OPT; do 4 | case $OPT in 5 | "e") exp=$OPTARG;; 6 | "h") help=1;; 7 | "v") v=$OPTARG;; 8 | esac 9 | done 10 | if [ -z "$exp" -a -z "$help" ]; then 11 | exp=`cat - | tr -d '\n'` 12 | fi 13 | if [ -z "$exp" ]; then 14 | cat < car.zsl 17 | or 18 | ./compile.sh < fib5.lsp > fib5.zsl 19 | EOF 20 | else 21 | source="`dirname $0`/lisp${v}.lsp" 22 | cat $source | sed -e 's/;.*$//g' | tr -d '\n' | sed -e 's/ */ /g' | \ 23 | awk "{sub(\"WRITE_HERE\", \"$exp\")}{print}" 24 | fi 25 | -------------------------------------------------------------------------------- /fib5.lsp: -------------------------------------------------------------------------------- 1 | ((lambda(x) (defun fib (n) (if (eq n 1) 1 (if (eq n 0) 1 (+ (fib(- n 1)) (fib(- n 2)))))) (fib x)) 5) 2 | -------------------------------------------------------------------------------- /lisp.lsp: -------------------------------------------------------------------------------- 1 | ;;; A Lisp evaluator in Lisp. 2 | ;;; 3 | ;;; It consists of QUOTE, IF, LAMBDA, DEFUN, SETQ, CAR, CDR, CONS, EQ, ATOM, +, 4 | ;;; *, -, /, and MOD. It provides them all, so it can run itself recursively. 5 | ;;; This program is for both Zick's Lisp and Common Lisp. 6 | 7 | ((lambda (ge) 8 | ;; HACK: Common Lisp treats this as (setq) but my implementations treat #+nil 9 | ;; as just a symbol so it defines funcall. Please modify this line if you 10 | ;; want to run this evaluator with itself recursively in Common Lisp. CL's 11 | ;; reader skips the defun of funcall but it's necessary for this evaluator. 12 | (setq #+nil (defun funcall (f x) (f x))) 13 | 14 | ;; Makes mutable cons using lambda. 15 | ;; Example: 16 | ;; (setq x (mcon% 1 2)) 17 | ;; (x 'car) ;=> 1 18 | ;; (x 'cdr) ;=> 2 19 | ;; (x (cons 'cdr 99)) ;=> 99 (mutation) 20 | ;; (x 'cdr) ;=> 99 21 | (defun mcon% (a d) 22 | (lambda (c) (if (eq c 'car) a 23 | (if (eq c 'cdr) d 24 | (if (eq (car c) 'car) (setq a (cdr c)) 25 | (if (eq (car c) 'cdr) (setq d (cdr c)))))))) 26 | 27 | ;; Initialize the global environment. An environment consists of a list of 28 | ;; alist. 29 | (setq ge (mcon% (mcon% (mcon% 't 't) ()) ())) 30 | 31 | (defun cadr% (x) (car (cdr x))) 32 | (defun cddr% (x) (cdr (cdr x))) 33 | 34 | ;; assoc for mutable cons. 35 | (defun assoc% (k l) 36 | (if l (if (eq k (funcall (funcall l 'car) 'car)) (funcall l 'car) 37 | (assoc% k (funcall l 'cdr))) ())) 38 | 39 | ;; Finds a variable from environment. 40 | (defun fv% (k a) (if a ((lambda (r) (if r r (fv% k (funcall a 'cdr)))) 41 | (assoc% k (funcall a 'car))) ())) 42 | 43 | ;; Evaluates an atom. It returns the corresponding value when the given 44 | ;; environment has a bind. Otherwise returns the given atom itself. 45 | (defun ea% (e a) ((lambda (b) (if b (funcall b 'cdr) e)) (fv% e a))) 46 | 47 | ;; Makes an EXPR from lambda or defun. 48 | (defun el% (e a) (cons '%e% (cons (car e) (cons (cdr e) a)))) 49 | 50 | ;; Adds a bind to the global environment. 51 | (defun ae% (s v) (funcall ge 52 | (cons 'car 53 | (mcon% (mcon% s v) 54 | (funcall ge 'car)))) s) 55 | 56 | (defun eval% (e a) 57 | (if (atom e) (ea% e a) 58 | (if (eq (car e) 'quote) (cadr% e) 59 | (if (eq (car e) 'if) 60 | (if (eval% (cadr% e) a) 61 | (eval% (cadr% (cdr e)) a) (eval% (cadr% (cddr% e)) a)) 62 | (if (eq (car e) 'lambda) (el% (cdr e) a) 63 | (if (eq (car e) 'defun) 64 | (ae% (cadr% e) (el% (cddr% e) a)) 65 | (if (eq (car e) 'setq) 66 | ((lambda (b v) 67 | (if b (funcall b (cons 'cdr v)) 68 | (ae% (cadr% e) v)) 69 | v) 70 | (fv% (cadr% e) a) (eval% (cadr% (cdr e)) a)) 71 | (apply% (eval% (car e) a) 72 | (evlis% (cdr e) a))))))))) 73 | 74 | (defun pairlis% (x y) 75 | (if x (if y (mcon% (mcon% (car x) (car y)) 76 | (pairlis% (cdr x) (cdr y))) ()) ())) 77 | 78 | (defun evlis% (l a) (if l (cons (eval% (car l) a) (evlis% (cdr l) a)) ())) 79 | 80 | (defun progn% (l a r) (if l (progn% (cdr l) a (eval% (car l) a)) r)) 81 | 82 | (defun apply% (f a) 83 | (if (eq (car f) '%e%) 84 | (progn% (cadr% (cdr f)) 85 | (mcon% (pairlis% (cadr% f) a) (cddr% (cdr f))) ()) 86 | (if (eq (car f) '%s%) 87 | (funcall (cdr f) a) 88 | f))) 89 | 90 | ;; Makes SUBR and EXPR more readable. 91 | (defun es% (e) 92 | (if (atom e) e 93 | (if (eq (car e) '%s%) ' (if (eq (car e) '%e%) ' e)))) 94 | 95 | (defun eval%% (e) (es% (eval% e ge))) 96 | 97 | (ae% 'car (cons '%s% (lambda(x)(car(car x))))) 98 | (ae% 'cdr (cons '%s% (lambda(x)(cdr(car x))))) 99 | (ae% 'cons (cons '%s% (lambda(x)(cons(car x)(cadr% x))))) 100 | (ae% 'eq (cons '%s% (lambda(x)(eq(car x)(cadr% x))))) 101 | (ae% 'atom (cons '%s% (lambda(x)(atom(car x))))) 102 | (ae% '+ (cons '%s% (lambda(x)(+(car x)(cadr% x))))) 103 | (ae% '* (cons '%s% (lambda(x)(*(car x)(cadr% x))))) 104 | (ae% '- (cons '%s% (lambda(x)(-(car x)(cadr% x))))) 105 | (ae% '/ (cons '%s% (lambda(x)(*(car x)(cadr% x))))) 106 | (ae% 'mod (cons '%s% (lambda(x)(mod(car x)(cadr% x))))) 107 | (eval%% 'WRITE_HERE)) 108 | ()) 109 | -------------------------------------------------------------------------------- /lisp2.lsp: -------------------------------------------------------------------------------- 1 | ;;; A Lisp evaluator in Lisp. 2 | ;;; 3 | ;;; It consists of QUOTE, IF, LAMBDA, DEFUN, SETQ, CAR, CDR, CONS, EQ, ATOM, +, 4 | ;;; *, -, /, MOD, LOOP, and RETURN. It provides them all, so it can run itself 5 | ;;; recursively. 6 | ;;; This program is for both Zick's Lisp and Common Lisp. 7 | 8 | ((lambda (ge err lv) 9 | ;; HACK: Common Lisp treats this as (setq) but my implementations treat #+nil 10 | ;; as just a symbol so it defines funcall. Please modify this line if you 11 | ;; want to run this evaluator with itself recursively in Common Lisp. CL's 12 | ;; reader skips the defun of funcall but it's necessary for this evaluator. 13 | (setq #+nil (defun funcall (f x) (f x))) 14 | 15 | ;; Makes mutable cons using lambda. 16 | ;; Example: 17 | ;; (setq x (mcon% 1 2)) 18 | ;; (x 'car) ;=> 1 19 | ;; (x 'cdr) ;=> 2 20 | ;; (x (cons 'cdr 99)) ;=> 99 (mutation) 21 | ;; (x 'cdr) ;=> 99 22 | (defun mcon% (a d) 23 | (lambda (c) (if (eq c 'car) a 24 | (if (eq c 'cdr) d 25 | (if (eq (car c) 'car) (setq a (cdr c)) 26 | (if (eq (car c) 'cdr) (setq d (cdr c)))))))) 27 | 28 | ;; Initialize the global environment. An environment consists of a list of 29 | ;; alist. 30 | (setq ge (mcon% (mcon% (mcon% 't 't) ()) ())) 31 | 32 | (defun cadr% (x) (car (cdr x))) 33 | (defun cddr% (x) (cdr (cdr x))) 34 | 35 | ;; assoc for mutable cons. 36 | (defun assoc% (k l) 37 | (loop 38 | (if (eq l ()) (return)) 39 | (if (eq k (funcall (funcall l 'car) 'car)) (return (funcall l 'car))) 40 | (setq l (funcall l 'cdr)))) 41 | 42 | ;; Finds a variable from environment. 43 | (defun fv% (k a) 44 | ((lambda (r) 45 | (loop 46 | (if (eq a ()) (return)) 47 | (setq r (assoc% k (funcall a 'car))) 48 | (if r (return r)) 49 | (setq a (funcall a 'cdr)))) 50 | ())) 51 | 52 | ;; Evaluates an atom. It returns the corresponding value when the given 53 | ;; environment has a bind. Otherwise returns the given atom itself. 54 | (defun ea% (e a) ((lambda (b) (if b (funcall b 'cdr) e)) (fv% e a))) 55 | 56 | ;; Makes an EXPR from lambda or defun. 57 | (defun el% (e a) (cons '%e% (cons (car e) (cons (cdr e) a)))) 58 | 59 | ;; Adds a bind to the global environment. 60 | (defun ae% (s v) (funcall ge 61 | (cons 'car 62 | (mcon% (mcon% s v) 63 | (funcall ge 'car)))) s) 64 | 65 | (defun eval% (e a) 66 | (loop 67 | (if (eq e err) (return e)) 68 | (if (atom e) (return (ea% e a))) 69 | (if (eq (car e) 'quote) (return (cadr% e))) 70 | (if (eq (car e) 'if) 71 | (if (eval% (cadr% e) a) 72 | (return (eval% (cadr% (cdr e)) a)) 73 | (return (eval% (cadr% (cddr% e)) a)))) 74 | (if (eq (car e) 'lambda) (return (el% (cdr e) a))) 75 | (if (eq (car e) 'defun) 76 | (return (ae% (cadr% e) (el% (cddr% e) a)))) 77 | (if (eq (car e) 'setq) 78 | (return 79 | ((lambda (b v) 80 | (if b (funcall b (cons 'cdr v)) 81 | (ae% (cadr% e) v)) 82 | v) 83 | (fv% (cadr% e) a) (eval% (cadr% (cdr e)) a)))) 84 | (if (eq (car e) 'loop) (return (loop% (cdr e) a ()))) 85 | (if (eq (car e) 'return) 86 | (return (loop (setq lv (eval% (cadr% e) a)) (return err)))) 87 | (return (apply% (eval% (car e) a) (evlis% (cdr e) a))))) 88 | 89 | (defun pairlis% (x y) 90 | (if x (if y (mcon% (mcon% (car x) (car y)) 91 | (pairlis% (cdr x) (cdr y))) ()) ())) 92 | 93 | (defun evlis% (l a) (if l (cons (eval% (car l) a) (evlis% (cdr l) a)) ())) 94 | 95 | (defun progn% (l a r) 96 | (loop 97 | (if (eq l ()) (return r)) 98 | (setq r (eval% (car l) a)) 99 | (if (eq r err) (return r)) 100 | (setq l (cdr l)))) 101 | 102 | (defun loop% (l a r) 103 | (loop 104 | (setq r (progn% l a ())) 105 | (if (eq r err) (return lv)))) 106 | 107 | (defun apply% (f a) 108 | (if (eq (car f) '%e%) 109 | (progn% (cadr% (cdr f)) 110 | (mcon% (pairlis% (cadr% f) a) (cddr% (cdr f))) ()) 111 | (if (eq (car f) '%s%) 112 | (funcall (cdr f) a) 113 | f))) 114 | 115 | ;; Makes SUBR and EXPR more readable. 116 | (defun es% (e) 117 | (if (atom e) e 118 | (if (eq (car e) '%s%) ' (if (eq (car e) '%e%) ' e)))) 119 | 120 | (defun eval%% (e) (es% (eval% e ge))) 121 | 122 | (ae% 'car (cons '%s% (lambda(x)(car(car x))))) 123 | (ae% 'cdr (cons '%s% (lambda(x)(cdr(car x))))) 124 | (ae% 'cons (cons '%s% (lambda(x)(cons(car x)(cadr% x))))) 125 | (ae% 'eq (cons '%s% (lambda(x)(eq(car x)(cadr% x))))) 126 | (ae% 'atom (cons '%s% (lambda(x)(atom(car x))))) 127 | (ae% '+ (cons '%s% (lambda(x)(+(car x)(cadr% x))))) 128 | (ae% '* (cons '%s% (lambda(x)(*(car x)(cadr% x))))) 129 | (ae% '- (cons '%s% (lambda(x)(-(car x)(cadr% x))))) 130 | (ae% '/ (cons '%s% (lambda(x)(*(car x)(cadr% x))))) 131 | (ae% 'mod (cons '%s% (lambda(x)(mod(car x)(cadr% x))))) 132 | (eval%% 'WRITE_HERE)) 133 | () (cons 1 1) ()) 134 | --------------------------------------------------------------------------------