Commit | Line | Data |
---|---|---|
31690700 JM |
1 | <?php |
2 | ||
3 | require_once 'readline.php'; | |
4 | require_once 'types.php'; | |
5 | require_once 'reader.php'; | |
ea81a808 JM |
6 | require_once 'printer.php'; |
7 | require_once 'env.php'; | |
8 | require_once 'core.php'; | |
31690700 JM |
9 | |
10 | // read | |
11 | function READ($str) { | |
12 | return read_str($str); | |
13 | } | |
14 | ||
15 | // eval | |
16 | function is_pair($x) { | |
ea81a808 | 17 | return _sequential_Q($x) and count($x) > 0; |
31690700 JM |
18 | } |
19 | ||
20 | function quasiquote($ast) { | |
21 | if (!is_pair($ast)) { | |
ea81a808 JM |
22 | return _list(_symbol("quote"), $ast); |
23 | } elseif (_symbol_Q($ast[0]) && $ast[0]->value === 'unquote') { | |
31690700 | 24 | return $ast[1]; |
ea81a808 | 25 | } elseif (is_pair($ast[0]) && _symbol_Q($ast[0][0]) && |
31690700 | 26 | $ast[0][0]->value === 'splice-unquote') { |
ea81a808 JM |
27 | return _list(_symbol("concat"), $ast[0][1], |
28 | quasiquote($ast->slice(1))); | |
31690700 | 29 | } else { |
ea81a808 JM |
30 | return _list(_symbol("cons"), quasiquote($ast[0]), |
31 | quasiquote($ast->slice(1))); | |
31690700 JM |
32 | } |
33 | } | |
34 | ||
35 | function is_macro_call($ast, $env) { | |
36 | return is_pair($ast) && | |
ea81a808 | 37 | _symbol_Q($ast[0]) && |
b8ee29b2 JM |
38 | $env->find($ast[0]) && |
39 | $env->get($ast[0])->ismacro; | |
31690700 JM |
40 | } |
41 | ||
42 | function macroexpand($ast, $env) { | |
43 | while (is_macro_call($ast, $env)) { | |
b8ee29b2 | 44 | $mac = $env->get($ast[0]); |
31690700 JM |
45 | $args = array_slice($ast->getArrayCopy(),1); |
46 | $ast = $mac->apply($args); | |
47 | } | |
48 | return $ast; | |
49 | } | |
50 | ||
51 | function eval_ast($ast, $env) { | |
ea81a808 | 52 | if (_symbol_Q($ast)) { |
b8ee29b2 | 53 | return $env->get($ast); |
ea81a808 JM |
54 | } elseif (_sequential_Q($ast)) { |
55 | if (_list_Q($ast)) { | |
56 | $el = _list(); | |
31690700 | 57 | } else { |
ea81a808 | 58 | $el = _vector(); |
31690700 JM |
59 | } |
60 | foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } | |
61 | return $el; | |
ea81a808 JM |
62 | } elseif (_hash_map_Q($ast)) { |
63 | $new_hm = _hash_map(); | |
31690700 JM |
64 | foreach (array_keys($ast->getArrayCopy()) as $key) { |
65 | $new_hm[$key] = MAL_EVAL($ast[$key], $env); | |
66 | } | |
67 | return $new_hm; | |
68 | } else { | |
69 | return $ast; | |
70 | } | |
71 | } | |
72 | ||
73 | function MAL_EVAL($ast, $env) { | |
74 | while (true) { | |
31690700 | 75 | |
ea81a808 JM |
76 | #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; |
77 | if (!_list_Q($ast)) { | |
78 | return eval_ast($ast, $env); | |
79 | } | |
80 | ||
81 | // apply list | |
82 | $ast = macroexpand($ast, $env); | |
83 | if (!_list_Q($ast)) { return $ast; } | |
84 | ||
85 | $a0 = $ast[0]; | |
86 | $a0v = (_symbol_Q($a0) ? $a0->value : $a0); | |
87 | switch ($a0v) { | |
88 | case "def!": | |
89 | $res = MAL_EVAL($ast[2], $env); | |
b8ee29b2 | 90 | return $env->set($ast[1], $res); |
ea81a808 JM |
91 | case "let*": |
92 | $a1 = $ast[1]; | |
93 | $let_env = new Env($env); | |
94 | for ($i=0; $i < count($a1); $i+=2) { | |
b8ee29b2 | 95 | $let_env->set($a1[$i], MAL_EVAL($a1[$i+1], $let_env)); |
ea81a808 | 96 | } |
6301e0b6 JM |
97 | $ast = $ast[2]; |
98 | $env = $let_env; | |
99 | break; // Continue loop (TCO) | |
ea81a808 JM |
100 | case "quote": |
101 | return $ast[1]; | |
102 | case "quasiquote": | |
6301e0b6 JM |
103 | $ast = quasiquote($ast[1]); |
104 | break; // Continue loop (TCO) | |
ea81a808 JM |
105 | case "defmacro!": |
106 | $func = MAL_EVAL($ast[2], $env); | |
107 | $func->ismacro = true; | |
b8ee29b2 | 108 | return $env->set($ast[1], $func); |
ea81a808 JM |
109 | case "macroexpand": |
110 | return macroexpand($ast[1], $env); | |
ea81a808 JM |
111 | case "try*": |
112 | $a1 = $ast[1]; | |
113 | $a2 = $ast[2]; | |
114 | if ($a2[0]->value === "catch*") { | |
115 | try { | |
31690700 | 116 | return MAL_EVAL($a1, $env); |
ea81a808 JM |
117 | } catch (Error $e) { |
118 | $catch_env = new Env($env, array($a2[1]), | |
119 | array($e->obj)); | |
120 | return MAL_EVAL($a2[2], $catch_env); | |
121 | } catch (Exception $e) { | |
122 | $catch_env = new Env($env, array($a2[1]), | |
123 | array($e->getMessage())); | |
124 | return MAL_EVAL($a2[2], $catch_env); | |
31690700 | 125 | } |
ea81a808 JM |
126 | } else { |
127 | return MAL_EVAL($a1, $env); | |
128 | } | |
129 | case "do": | |
130 | eval_ast($ast->slice(1, -1), $env); | |
131 | $ast = $ast[count($ast)-1]; | |
6301e0b6 | 132 | break; // Continue loop (TCO) |
ea81a808 JM |
133 | case "if": |
134 | $cond = MAL_EVAL($ast[1], $env); | |
135 | if ($cond === NULL || $cond === false) { | |
136 | if (count($ast) === 4) { $ast = $ast[3]; } | |
137 | else { $ast = NULL; } | |
138 | } else { | |
139 | $ast = $ast[2]; | |
31690700 | 140 | } |
6301e0b6 | 141 | break; // Continue loop (TCO) |
ea81a808 JM |
142 | case "fn*": |
143 | return _function('MAL_EVAL', 'native', | |
a34b0200 | 144 | $ast[2], $env, $ast[1]); |
ea81a808 JM |
145 | default: |
146 | $el = eval_ast($ast, $env); | |
147 | $f = $el[0]; | |
148 | $args = array_slice($el->getArrayCopy(), 1); | |
149 | if ($f->type === 'native') { | |
a34b0200 JM |
150 | $ast = $f->ast; |
151 | $env = $f->gen_env($args); | |
6301e0b6 | 152 | // Continue loop (TCO) |
ea81a808 JM |
153 | } else { |
154 | return $f->apply($args); | |
155 | } | |
156 | } | |
157 | ||
31690700 JM |
158 | } |
159 | } | |
160 | ||
161 | ||
162 | function MAL_PRINT($exp) { | |
10b07148 | 163 | return _pr_str($exp, True); |
31690700 JM |
164 | } |
165 | ||
166 | // repl | |
167 | $repl_env = new Env(NULL); | |
168 | function rep($str) { | |
169 | global $repl_env; | |
170 | return MAL_PRINT(MAL_EVAL(READ($str), $repl_env)); | |
171 | } | |
8cb5cda4 JM |
172 | |
173 | // core.php: defined using PHP | |
174 | foreach ($core_ns as $k=>$v) { | |
b8ee29b2 | 175 | $repl_env->set(_symbol($k), _function($v)); |
31690700 | 176 | } |
b8ee29b2 | 177 | $repl_env->set(_symbol('eval'), _function(function($ast) { |
31690700 | 178 | global $repl_env; return MAL_EVAL($ast, $repl_env); |
8cb5cda4 | 179 | })); |
86b689f3 JM |
180 | $_argv = _list(); |
181 | for ($i=2; $i < count($argv); $i++) { | |
182 | $_argv->append($argv[$i]); | |
183 | } | |
b8ee29b2 | 184 | $repl_env->set(_symbol('*ARGV*'), $_argv); |
31690700 | 185 | |
8cb5cda4 | 186 | // core.mal: defined using the language itself |
31690700 | 187 | rep("(def! not (fn* (a) (if a false true)))"); |
8cb5cda4 | 188 | rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); |
31690700 JM |
189 | rep("(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); |
190 | rep("(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); | |
31690700 JM |
191 | |
192 | if (count($argv) > 1) { | |
86b689f3 | 193 | rep('(load-file "' . $argv[1] . '")'); |
8cb5cda4 | 194 | exit(0); |
31690700 JM |
195 | } |
196 | ||
86b689f3 | 197 | // repl loop |
8cb5cda4 JM |
198 | do { |
199 | try { | |
200 | $line = mal_readline("user> "); | |
201 | if ($line === NULL) { break; } | |
202 | if ($line !== "") { | |
10b07148 | 203 | print(rep($line) . "\n"); |
8cb5cda4 JM |
204 | } |
205 | } catch (BlankException $e) { | |
206 | continue; | |
207 | } catch (Exception $e) { | |
208 | echo "Error: " . $e->getMessage() . "\n"; | |
209 | echo $e->getTraceAsString() . "\n"; | |
210 | } | |
211 | } while (true); | |
212 | ||
86b689f3 | 213 | ?> |