Commit | Line | Data |
---|---|---|
3ea09886 JM |
1 | (module $step5_tco |
2 | ||
3 | (global $repl_env (mut i32) (i32.const 0)) | |
4 | ||
5 | ;; READ | |
6 | (func $READ (param $str i32) (result i32) | |
7 | ($read_str $str) | |
8 | ) | |
9 | ||
10 | ;; EVAL | |
11 | (func $EVAL_AST (param $ast i32 $env i32 $skiplast i32) (result i32) | |
349faa83 JM |
12 | (LET $res 0 $val2 0 $val3 0 $type 0 $found 0 |
13 | $ret 0 $empty 0 $current 0) | |
3ea09886 | 14 | |
0a19c2f1 JM |
15 | (if (global.get $error_type) (return 0)) |
16 | (local.set $type ($TYPE $ast)) | |
3ea09886 JM |
17 | |
18 | ;;($PR_VALUE ">>> EVAL_AST ast: '%s'\n" $ast) | |
19 | ||
20 | ;;; switch(type) | |
21 | (block $done | |
22 | (block $default (block (block | |
23 | (br_table 2 2 2 2 2 0 1 1 1 2 2 2 2 2 2 2 $type)) | |
24 | ;; symbol | |
25 | ;; found/res returned as hi 32/lo 32 of i64 | |
0a19c2f1 | 26 | (local.set $res ($ENV_GET $env $ast)) |
3ea09886 JM |
27 | (br $done)) |
28 | ;; list, vector, hashmap | |
29 | ;; MAP_LOOP_START | |
0a19c2f1 | 30 | (local.set $res ($MAP_LOOP_START $type)) |
3ea09886 JM |
31 | ;; push MAP_LOOP stack |
32 | ;;; empty = current = ret = res | |
0a19c2f1 JM |
33 | (local.set $ret $res) |
34 | (local.set $current $res) | |
35 | (local.set $empty $res) | |
3ea09886 JM |
36 | |
37 | (block $done | |
38 | (loop $loop | |
39 | ;; check if we are done evaluating the source sequence | |
349faa83 | 40 | (br_if $done (i32.eq ($VAL0 $ast) 0)) |
3ea09886 JM |
41 | |
42 | (if $skiplast | |
77bf4e61 | 43 | (br_if $done (i32.eqz ($VAL0 ($MEM_VAL0_ptr $ast))))) |
3ea09886 | 44 | |
0a19c2f1 | 45 | (if (i32.eq $type (global.get $HASHMAP_T)) |
3ea09886 | 46 | (then |
0a19c2f1 | 47 | (local.set $res ($EVAL ($MEM_VAL2_ptr $ast) $env))) |
3ea09886 | 48 | (else |
0a19c2f1 JM |
49 | (local.set $res ($EVAL ($MEM_VAL1_ptr $ast) $env)))) |
50 | (local.set $val2 $res) | |
3ea09886 JM |
51 | |
52 | ;; if error, release the unattached element | |
0a19c2f1 | 53 | (if (global.get $error_type) |
3ea09886 JM |
54 | (then |
55 | ($RELEASE $res) | |
0a19c2f1 | 56 | (local.set $res 0) |
3ea09886 JM |
57 | (br $done))) |
58 | ||
59 | ;; for hash-maps, copy the key (inc ref since we are going | |
60 | ;; to release it below) | |
0a19c2f1 | 61 | (if (i32.eq $type (global.get $HASHMAP_T)) |
3ea09886 | 62 | (then |
0a19c2f1 JM |
63 | (local.set $val3 $val2) |
64 | (local.set $val2 ($MEM_VAL1_ptr $ast)) | |
3ea09886 JM |
65 | (drop ($INC_REF $val2)))) |
66 | ||
67 | ;; MAP_LOOP_UPDATE | |
0a19c2f1 JM |
68 | (local.set $res ($MAP_LOOP_UPDATE $type $empty $current $val2 $val3)) |
69 | (if (i32.le_u $current (global.get $EMPTY_HASHMAP)) | |
3ea09886 | 70 | ;; if first element, set return to new element |
0a19c2f1 | 71 | (local.set $ret $res)) |
3ea09886 | 72 | ;; update current to point to new element |
0a19c2f1 | 73 | (local.set $current $res) |
3ea09886 | 74 | |
0a19c2f1 | 75 | (local.set $ast ($MEM_VAL0_ptr $ast)) |
3ea09886 JM |
76 | |
77 | (br $loop) | |
78 | ) | |
79 | ) | |
80 | ;; MAP_LOOP_DONE | |
0a19c2f1 | 81 | (local.set $res $ret) |
3ea09886 JM |
82 | ;; EVAL_AST_RETURN: nothing to do |
83 | (br $done)) | |
84 | ;; default | |
0a19c2f1 | 85 | (local.set $res ($INC_REF $ast)) |
3ea09886 JM |
86 | ) |
87 | ||
88 | $res | |
89 | ) | |
90 | ||
91 | (func $MAL_GET_A1 (param $ast i32) (result i32) | |
92 | ($MEM_VAL1_ptr ($MEM_VAL0_ptr $ast))) | |
93 | (func $MAL_GET_A2 (param $ast i32) (result i32) | |
94 | ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast)))) | |
95 | (func $MAL_GET_A3 (param $ast i32) (result i32) | |
96 | ($MEM_VAL1_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr ($MEM_VAL0_ptr $ast))))) | |
97 | ||
98 | (func $EVAL (param $orig_ast i32 $orig_env i32) (result i32) | |
349faa83 JM |
99 | (LET $ast $orig_ast |
100 | $env $orig_env | |
101 | $prev_ast 0 $prev_env 0 $res 0 $el 0 | |
102 | $ftype 0 $f_args 0 $f 0 $args 0 | |
103 | $a0 0 $a0sym 0 $a1 0 $a2 0) | |
3ea09886 JM |
104 | |
105 | (block $EVAL_return | |
106 | (loop $TCO_loop | |
107 | ||
0a19c2f1 JM |
108 | (local.set $f_args 0) |
109 | (local.set $f 0) | |
110 | (local.set $args 0) | |
3ea09886 | 111 | |
0a19c2f1 | 112 | (if (global.get $error_type) |
3ea09886 | 113 | (then |
0a19c2f1 | 114 | (local.set $res 0) |
3ea09886 JM |
115 | (br $EVAL_return))) |
116 | ||
50eea9ad JM |
117 | ;;($PR_VALUE ">>> EVAL ast: '%s'\n" $ast) |
118 | ||
0a19c2f1 | 119 | (if (i32.ne ($TYPE $ast) (global.get $LIST_T)) |
3ea09886 | 120 | (then |
0a19c2f1 | 121 | (local.set $res ($EVAL_AST $ast $env 0)) |
3ea09886 JM |
122 | (br $EVAL_return))) |
123 | ||
124 | ;; APPLY_LIST | |
125 | (if ($EMPTY_Q $ast) | |
126 | (then | |
0a19c2f1 | 127 | (local.set $res ($INC_REF $ast)) |
3ea09886 JM |
128 | (br $EVAL_return))) |
129 | ||
0a19c2f1 JM |
130 | (local.set $a0 ($MEM_VAL1_ptr $ast)) |
131 | (local.set $a0sym "") | |
132 | (if (i32.eq ($TYPE $a0) (global.get $SYMBOL_T)) | |
133 | (local.set $a0sym ($to_String $a0))) | |
3ea09886 JM |
134 | |
135 | (if (i32.eqz ($strcmp "def!" $a0sym)) | |
136 | (then | |
0a19c2f1 JM |
137 | (local.set $a1 ($MAL_GET_A1 $ast)) |
138 | (local.set $a2 ($MAL_GET_A2 $ast)) | |
139 | (local.set $res ($EVAL $a2 $env)) | |
140 | (br_if $EVAL_return (global.get $error_type)) | |
3ea09886 JM |
141 | |
142 | ;; set a1 in env to a2 | |
0a19c2f1 | 143 | (local.set $res ($ENV_SET $env $a1 $res)) |
3ea09886 JM |
144 | (br $EVAL_return)) |
145 | (else (if (i32.eqz ($strcmp "let*" $a0sym)) | |
146 | (then | |
0a19c2f1 JM |
147 | (local.set $a1 ($MAL_GET_A1 $ast)) |
148 | (local.set $a2 ($MAL_GET_A2 $ast)) | |
3ea09886 JM |
149 | |
150 | ;; create new environment with outer as current environment | |
0a19c2f1 JM |
151 | (local.set $prev_env $env) ;; save env for later release |
152 | (local.set $env ($ENV_NEW $env)) | |
3ea09886 JM |
153 | |
154 | (block $done | |
155 | (loop $loop | |
349faa83 | 156 | (br_if $done (i32.eqz ($VAL0 $a1))) |
3ea09886 | 157 | ;; eval current A1 odd element |
0a19c2f1 | 158 | (local.set $res ($EVAL ($MEM_VAL1_ptr ($MEM_VAL0_ptr $a1)) $env)) |
3ea09886 | 159 | |
0a19c2f1 | 160 | (br_if $done (global.get $error_type)) |
3ea09886 JM |
161 | |
162 | ;; set key/value in the let environment | |
0a19c2f1 | 163 | (local.set $res ($ENV_SET $env ($MEM_VAL1_ptr $a1) $res)) |
3ea09886 JM |
164 | ;; release our use, ENV_SET took ownership |
165 | ($RELEASE $res) | |
166 | ||
167 | ;; skip to the next pair of a1 elements | |
0a19c2f1 | 168 | (local.set $a1 ($MEM_VAL0_ptr ($MEM_VAL0_ptr $a1))) |
3ea09886 JM |
169 | (br $loop) |
170 | ) | |
171 | ) | |
172 | ||
173 | ;; release previous environment if not the current EVAL env | |
174 | (if (i32.ne $prev_env $orig_env) | |
175 | (then | |
176 | ($RELEASE $prev_env) | |
0a19c2f1 | 177 | (local.set $prev_env 0))) |
3ea09886 | 178 | |
0a19c2f1 | 179 | (local.set $ast $a2) |
3ea09886 JM |
180 | (br $TCO_loop)) |
181 | (else (if (i32.eqz ($strcmp "do" $a0sym)) | |
182 | (then | |
183 | ;; EVAL the rest through second to last | |
0a19c2f1 JM |
184 | (local.set $el ($EVAL_AST ($MEM_VAL0_ptr $ast) $env 1)) |
185 | (local.set $ast ($LAST $ast)) | |
50eea9ad | 186 | ($RELEASE $ast) ;; we already own it via ast |
3ea09886 JM |
187 | ($RELEASE $el) |
188 | (br $TCO_loop)) | |
189 | (else (if (i32.eqz ($strcmp "if" $a0sym)) | |
190 | (then | |
0a19c2f1 JM |
191 | (local.set $a1 ($MAL_GET_A1 $ast)) |
192 | (local.set $res ($EVAL $a1 $env)) | |
3ea09886 | 193 | |
0a19c2f1 | 194 | (if (global.get $error_type) |
3ea09886 | 195 | (then (nop)) |
0a19c2f1 JM |
196 | (else (if (OR (i32.eq $res (global.get $NIL)) |
197 | (i32.eq $res (global.get $FALSE))) | |
3ea09886 JM |
198 | (then |
199 | ($RELEASE $res) | |
200 | ;; if no false case (A3), return nil | |
201 | (if (i32.lt_u ($COUNT $ast) 4) | |
202 | (then | |
0a19c2f1 | 203 | (local.set $res ($INC_REF (global.get $NIL))) |
3ea09886 JM |
204 | (br $EVAL_return)) |
205 | (else | |
0a19c2f1 | 206 | (local.set $ast ($MAL_GET_A3 $ast))))) |
3ea09886 JM |
207 | (else |
208 | ($RELEASE $res) | |
0a19c2f1 | 209 | (local.set $ast ($MAL_GET_A2 $ast)))))) |
3ea09886 JM |
210 | (br $TCO_loop)) |
211 | (else (if (i32.eqz ($strcmp "fn*" $a0sym)) | |
212 | (then | |
0a19c2f1 JM |
213 | (local.set $a1 ($MAL_GET_A1 $ast)) |
214 | (local.set $a2 ($MAL_GET_A2 $ast)) | |
215 | (local.set $res ($MALFUNC $a2 $a1 $env)) | |
3ea09886 JM |
216 | (br $EVAL_return)) |
217 | (else | |
218 | ;; EVAL_INVOKE | |
0a19c2f1 JM |
219 | (local.set $res ($EVAL_AST $ast $env 0)) |
220 | (local.set $f_args $res) | |
3ea09886 JM |
221 | |
222 | ;; if error, return f/args for release by caller | |
0a19c2f1 | 223 | (if (global.get $error_type) |
3ea09886 | 224 | (then |
0a19c2f1 | 225 | (local.set $res $f_args) |
3ea09886 JM |
226 | (br $EVAL_return))) |
227 | ||
0a19c2f1 JM |
228 | (local.set $args ($MEM_VAL0_ptr $f_args)) ;; rest |
229 | (local.set $f ($MEM_VAL1_ptr $f_args)) ;; value | |
3ea09886 | 230 | |
0a19c2f1 JM |
231 | (local.set $ftype ($TYPE $f)) |
232 | (if (i32.eq $ftype (global.get $FUNCTION_T)) | |
3ea09886 | 233 | (then |
0a19c2f1 | 234 | (local.set $res (call_indirect (type $fnT) $args ($VAL0 $f))) |
3ea09886 JM |
235 | ;; release f/args |
236 | ($RELEASE $f_args) | |
237 | (br $EVAL_return)) | |
0a19c2f1 | 238 | (else (if (i32.eq $ftype (global.get $MALFUNC_T)) |
3ea09886 JM |
239 | (then |
240 | ;; save the current environment for release | |
0a19c2f1 | 241 | (local.set $prev_env $env) |
3ea09886 | 242 | ;; create new environment using env and params stored in function |
0a19c2f1 | 243 | (local.set $env ($ENV_NEW_BINDS ($MEM_VAL2_ptr $f) |
3ea09886 JM |
244 | ($MEM_VAL1_ptr $f) $args)) |
245 | ||
246 | ;; release previous environment if not the current EVAL env | |
247 | ;; because our new env refers to it and we no longer need to | |
248 | ;; track it (since we are TCO recurring) | |
249 | (if (i32.ne $prev_env $orig_env) | |
250 | (then | |
251 | ($RELEASE $prev_env) | |
0a19c2f1 | 252 | (local.set $prev_env 0))) |
3ea09886 JM |
253 | |
254 | ;; claim the AST before releasing the list containing it | |
0a19c2f1 | 255 | (local.set $ast ($MEM_VAL0_ptr $f)) |
3ea09886 JM |
256 | (drop ($INC_REF $ast)) |
257 | ||
258 | ;; if we have already been here via TCO, release previous | |
259 | ;; ast | |
260 | ;; PEND_A_LV | |
261 | (if $prev_ast ($RELEASE $prev_ast)) | |
0a19c2f1 | 262 | (local.set $prev_ast $ast) |
3ea09886 JM |
263 | |
264 | ;; release f/args | |
265 | ($RELEASE $f_args) | |
266 | ||
267 | (br $TCO_loop)) | |
268 | (else | |
269 | ($THROW_STR_1 "apply of non-function type: %d\n" $ftype) | |
0a19c2f1 | 270 | (local.set $res 0) |
3ea09886 JM |
271 | ($RELEASE $f_args) |
272 | (br $EVAL_return))))))))))))))) | |
273 | ||
274 | ) ;; end of TCO_loop | |
275 | ) ;; end of EVAL_return | |
276 | ||
277 | ;; EVAL_RETURN | |
278 | (if (i32.ne $env $orig_env) ($RELEASE $env)) | |
279 | (if $prev_ast ($RELEASE $prev_ast)) | |
280 | ||
281 | $res | |
282 | ) | |
283 | ||
284 | ||
285 | (func $PRINT (param $ast i32) (result i32) | |
286 | ($pr_str $ast 1) | |
287 | ) | |
288 | ||
289 | ;; REPL | |
290 | (func $RE (param $line i32 $env i32) (result i32) | |
349faa83 JM |
291 | (LET $mv1 0 $res 0) |
292 | (block $done | |
0a19c2f1 JM |
293 | (local.set $mv1 ($READ $line)) |
294 | (br_if $done (global.get $error_type)) | |
3ea09886 | 295 | |
0a19c2f1 | 296 | (local.set $res ($EVAL $mv1 $env)) |
3ea09886 JM |
297 | ) |
298 | ||
299 | ;; release memory from MAL_READ | |
300 | ($RELEASE $mv1) | |
301 | $res | |
302 | ) | |
303 | ||
304 | (func $REP (param $line i32 $env i32) (result i32) | |
349faa83 JM |
305 | (LET $mv2 0 $ms 0) |
306 | (block $done | |
0a19c2f1 JM |
307 | (local.set $mv2 ($RE $line $env)) |
308 | (br_if $done (global.get $error_type)) | |
3ea09886 JM |
309 | |
310 | ;; ($PR_MEMORY -1 -1) | |
0a19c2f1 | 311 | (local.set $ms ($PRINT $mv2)) |
3ea09886 JM |
312 | ) |
313 | ||
314 | ;; release memory from RE | |
315 | ($RELEASE $mv2) | |
316 | $ms | |
317 | ) | |
318 | ||
ed13313d | 319 | (func $main (param $argc i32 $argv i32) (result i32) |
349faa83 | 320 | (LET $line (STATIC_ARRAY 201) |
dd7a4f55 | 321 | $res 0 $repl_env 0 $ms 0) |
3ea09886 JM |
322 | |
323 | ;; DEBUG | |
0a19c2f1 JM |
324 | ;; ($printf_1 "memoryBase: 0x%x\n" (global.get $memoryBase)) |
325 | ;; ($printf_1 "heap_start: 0x%x\n" (global.get $heap_start)) | |
326 | ;; ($printf_1 "heap_end: 0x%x\n" (global.get $heap_end)) | |
327 | ;; ($printf_1 "mem: 0x%x\n" (global.get $mem)) | |
328 | ;; ($printf_1 "string_mem: %d\n" (global.get $string_mem)) | |
3ea09886 | 329 | |
0a19c2f1 JM |
330 | (global.set $repl_env ($ENV_NEW (global.get $NIL))) |
331 | (local.set $repl_env (global.get $repl_env)) | |
3ea09886 JM |
332 | |
333 | ;; core.EXT: defined in wasm | |
334 | ($add_core_ns $repl_env) | |
335 | ||
50eea9ad JM |
336 | ($checkpoint_user_memory) |
337 | ||
3ea09886 JM |
338 | ;; core.mal: defined using the language itself |
339 | ($RELEASE ($RE "(def! not (fn* (a) (if a false true)))" $repl_env)) | |
340 | ||
341 | ;;($PR_MEMORY -1 -1) | |
342 | ||
343 | ;; Start REPL | |
344 | (block $repl_done | |
345 | (loop $repl_loop | |
50eea9ad JM |
346 | (br_if $repl_done (i32.eqz ($readline "user> " $line))) |
347 | (br_if $repl_loop (i32.eq (i32.load8_u $line) 0)) | |
0a19c2f1 JM |
348 | (local.set $res ($REP $line $repl_env)) |
349 | (if (global.get $error_type) | |
3ea09886 | 350 | (then |
0a19c2f1 | 351 | (if (i32.eq 2 (global.get $error_type)) |
dd7a4f55 | 352 | (then |
0a19c2f1 | 353 | (local.set $ms ($pr_str (global.get $error_val) 1)) |
dd7a4f55 JM |
354 | ($printf_1 "Error: %s\n" ($to_String $ms)) |
355 | ($RELEASE $ms) | |
0a19c2f1 | 356 | ($RELEASE (global.get $error_val))) |
dd7a4f55 | 357 | (else |
0a19c2f1 JM |
358 | ($printf_1 "Error: %s\n" (global.get $error_str)))) |
359 | (global.set $error_type 0)) | |
3ea09886 JM |
360 | (else |
361 | ($printf_1 "%s\n" ($to_String $res)))) | |
362 | ($RELEASE $res) | |
50eea9ad JM |
363 | ;;($PR_MEMORY_SUMMARY_SMALL) |
364 | (br $repl_loop) | |
365 | ) | |
366 | ) | |
3ea09886 JM |
367 | |
368 | ($print "\n") | |
369 | ;;($PR_MEMORY -1 -1) | |
370 | 0 | |
371 | ) | |
372 | ||
3ea09886 JM |
373 | ) |
374 |