3 require_once 'readline.php';
4 require_once 'types.php';
5 require_once 'reader.php';
6 require_once 'printer.php';
7 require_once 'env.php';
8 require_once 'core.php';
12 return read_str($str);
16 function is_pair($x) {
17 return _sequential_Q($x) and count($x) > 0;
20 function quasiquote($ast) {
22 return _list(_symbol("quote"), $ast);
23 } elseif (_symbol_Q($ast[0]) && $ast[0]->value
=== 'unquote') {
25 } elseif (is_pair($ast[0]) && _symbol_Q($ast[0][0]) &&
26 $ast[0][0]->value
=== 'splice-unquote') {
27 return _list(_symbol("concat"), $ast[0][1],
28 quasiquote($ast->slice(1)));
30 return _list(_symbol("cons"), quasiquote($ast[0]),
31 quasiquote($ast->slice(1)));
35 function is_macro_call($ast, $env) {
36 return is_pair($ast) &&
38 $env->find($ast[0]) &&
39 $env->get($ast[0])->ismacro
;
42 function macroexpand($ast, $env) {
43 while (is_macro_call($ast, $env)) {
44 $mac = $env->get($ast[0]);
45 $args = array_slice($ast->getArrayCopy(),1);
46 $ast = $mac->apply($args);
51 function eval_ast($ast, $env) {
52 if (_symbol_Q($ast)) {
53 return $env->get($ast);
54 } elseif (_sequential_Q($ast)) {
60 foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); }
62 } elseif (_hash_map_Q($ast)) {
63 $new_hm = _hash_map();
64 foreach (array_keys($ast->getArrayCopy()) as $key) {
65 $new_hm[$key] = MAL_EVAL($ast[$key], $env);
73 function MAL_EVAL($ast, $env) {
76 #echo "MAL_EVAL: " . _pr_str($ast) . "\n";
78 return eval_ast($ast, $env);
82 $ast = macroexpand($ast, $env);
84 return eval_ast($ast, $env);
86 if ($ast->count() === 0) {
91 $a0v = (_symbol_Q($a0) ?
$a0->value
: $a0);
94 $res = MAL_EVAL($ast[2], $env);
95 return $env->set($ast[1], $res);
98 $let_env = new Env($env);
99 for ($i=0; $i < count($a1); $i+
=2) {
100 $let_env->set($a1[$i], MAL_EVAL($a1[$i+
1], $let_env));
104 break; // Continue loop (TCO)
108 $ast = quasiquote($ast[1]);
109 break; // Continue loop (TCO)
111 $func = MAL_EVAL($ast[2], $env);
112 $func->ismacro
= true;
113 return $env->set($ast[1], $func);
115 return macroexpand($ast[1], $env);
119 if ($a2[0]->value
=== "catch*") {
121 return MAL_EVAL($a1, $env);
122 } catch (_Error
$e) {
123 $catch_env = new Env($env, array($a2[1]),
125 return MAL_EVAL($a2[2], $catch_env);
126 } catch (Exception
$e) {
127 $catch_env = new Env($env, array($a2[1]),
128 array($e->getMessage()));
129 return MAL_EVAL($a2[2], $catch_env);
132 return MAL_EVAL($a1, $env);
135 eval_ast($ast->slice(1, -1), $env);
136 $ast = $ast[count($ast)-1];
137 break; // Continue loop (TCO)
139 $cond = MAL_EVAL($ast[1], $env);
140 if ($cond === NULL ||
$cond === false) {
141 if (count($ast) === 4) { $ast = $ast[3]; }
142 else { $ast = NULL; }
146 break; // Continue loop (TCO)
148 return _function('MAL_EVAL', 'native',
149 $ast[2], $env, $ast[1]);
151 $el = eval_ast($ast, $env);
153 $args = array_slice($el->getArrayCopy(), 1);
154 if ($f->type
=== 'native') {
156 $env = $f->gen_env($args);
157 // Continue loop (TCO)
159 return $f->apply($args);
167 function MAL_PRINT($exp) {
168 return _pr_str($exp, True);
172 $repl_env = new Env(NULL);
175 return MAL_PRINT(MAL_EVAL(READ($str), $repl_env));
178 // core.php: defined using PHP
179 foreach ($core_ns as $k=>$v) {
180 $repl_env->set(_symbol($k), _function($v));
182 $repl_env->set(_symbol('eval'), _function(function($ast) {
183 global $repl_env; return MAL_EVAL($ast, $repl_env);
186 for ($i=2; $i < count($argv); $i++
) {
187 $_argv->append($argv[$i]);
189 $repl_env->set(_symbol('*ARGV*'), $_argv);
191 // core.mal: defined using the language itself
192 rep("(def! not (fn* (a) (if a false true)))");
193 rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
194 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)))))))");
195 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))))))))");
197 if (count($argv) > 1) {
198 rep('(load-file "' . $argv[1] . '")');
205 $line = mal_readline("user> ");
206 if ($line === NULL) { break; }
208 print(rep($line) . "\n");
210 } catch (BlankException
$e) {
212 } catch (_Error
$e) {
213 echo "Error: " . _pr_str($e->obj
, True) . "\n";
214 } catch (Exception
$e) {
215 echo "Error: " . $e->getMessage() . "\n";
216 echo $e->getTraceAsString() . "\n";