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 eval_ast($ast, $env) { | |
ea81a808 | 36 | if (_symbol_Q($ast)) { |
31690700 | 37 | return $env->get($ast->value); |
ea81a808 JM |
38 | } elseif (_sequential_Q($ast)) { |
39 | if (_list_Q($ast)) { | |
40 | $el = _list(); | |
31690700 | 41 | } else { |
ea81a808 | 42 | $el = _vector(); |
31690700 JM |
43 | } |
44 | foreach ($ast as $a) { $el[] = MAL_EVAL($a, $env); } | |
45 | return $el; | |
ea81a808 JM |
46 | } elseif (_hash_map_Q($ast)) { |
47 | $new_hm = _hash_map(); | |
31690700 JM |
48 | foreach (array_keys($ast->getArrayCopy()) as $key) { |
49 | $new_hm[$key] = MAL_EVAL($ast[$key], $env); | |
50 | } | |
51 | return $new_hm; | |
52 | } else { | |
53 | return $ast; | |
54 | } | |
55 | } | |
56 | ||
57 | function MAL_EVAL($ast, $env) { | |
58 | while (true) { | |
31690700 | 59 | |
ea81a808 JM |
60 | #echo "MAL_EVAL: " . _pr_str($ast) . "\n"; |
61 | if (!_list_Q($ast)) { | |
62 | return eval_ast($ast, $env); | |
63 | } | |
64 | ||
65 | // apply list | |
66 | $a0 = $ast[0]; | |
67 | $a0v = (_symbol_Q($a0) ? $a0->value : $a0); | |
68 | switch ($a0v) { | |
69 | case "def!": | |
70 | $res = MAL_EVAL($ast[2], $env); | |
71 | return $env->set($ast[1]->value, $res); | |
72 | case "let*": | |
73 | $a1 = $ast[1]; | |
74 | $let_env = new Env($env); | |
75 | for ($i=0; $i < count($a1); $i+=2) { | |
76 | $let_env->set($a1[$i]->value, MAL_EVAL($a1[$i+1], $let_env)); | |
31690700 | 77 | } |
ea81a808 JM |
78 | return MAL_EVAL($ast[2], $let_env); |
79 | case "quote": | |
80 | return $ast[1]; | |
81 | case "quasiquote": | |
82 | return MAL_EVAL(quasiquote($ast[1]), $env); | |
83 | case "do": | |
84 | eval_ast($ast->slice(1, -1), $env); | |
85 | $ast = $ast[count($ast)-1]; | |
86 | break; | |
87 | case "if": | |
88 | $cond = MAL_EVAL($ast[1], $env); | |
89 | if ($cond === NULL || $cond === false) { | |
90 | if (count($ast) === 4) { $ast = $ast[3]; } | |
91 | else { $ast = NULL; } | |
92 | } else { | |
93 | $ast = $ast[2]; | |
94 | } | |
95 | break; | |
96 | case "fn*": | |
97 | return _function('MAL_EVAL', 'native', | |
a34b0200 | 98 | $ast[2], $env, $ast[1]); |
ea81a808 JM |
99 | default: |
100 | $el = eval_ast($ast, $env); | |
101 | $f = $el[0]; | |
102 | $args = array_slice($el->getArrayCopy(), 1); | |
103 | if ($f->type === 'native') { | |
a34b0200 JM |
104 | $ast = $f->ast; |
105 | $env = $f->gen_env($args); | |
ea81a808 JM |
106 | } else { |
107 | return $f->apply($args); | |
108 | } | |
109 | } | |
110 | ||
31690700 JM |
111 | } |
112 | } | |
113 | ||
114 | ||
115 | function MAL_PRINT($exp) { | |
116 | return _pr_str($exp, True) . "\n"; | |
117 | } | |
118 | ||
119 | // repl | |
120 | $repl_env = new Env(NULL); | |
121 | function rep($str) { | |
122 | global $repl_env; | |
123 | return MAL_PRINT(MAL_EVAL(READ($str), $repl_env)); | |
124 | } | |
8cb5cda4 JM |
125 | |
126 | // core.php: defined using PHP | |
127 | foreach ($core_ns as $k=>$v) { | |
ea81a808 | 128 | $repl_env->set($k, _function($v)); |
31690700 | 129 | } |
8cb5cda4 | 130 | $repl_env->set('eval', _function(function($ast) { |
31690700 | 131 | global $repl_env; return MAL_EVAL($ast, $repl_env); |
8cb5cda4 | 132 | })); |
31690700 | 133 | |
8cb5cda4 | 134 | // core.mal: defined using the language itself |
31690700 | 135 | rep("(def! not (fn* (a) (if a false true)))"); |
1617910a | 136 | rep("(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); |
31690700 JM |
137 | |
138 | if (count($argv) > 1) { | |
139 | for ($i=1; $i < count($argv); $i++) { | |
140 | rep('(load-file "' . $argv[$i] . '")'); | |
141 | } | |
8cb5cda4 | 142 | exit(0); |
31690700 JM |
143 | } |
144 | ||
8cb5cda4 JM |
145 | do { |
146 | try { | |
147 | $line = mal_readline("user> "); | |
148 | if ($line === NULL) { break; } | |
149 | if ($line !== "") { | |
150 | print(rep($line)); | |
151 | } | |
152 | } catch (BlankException $e) { | |
153 | continue; | |
154 | } catch (Exception $e) { | |
155 | echo "Error: " . $e->getMessage() . "\n"; | |
156 | echo $e->getTraceAsString() . "\n"; | |
157 | } | |
158 | } while (true); | |
159 | ||
31690700 | 160 | ?> |