1 fn macroexpand expr-ah: (addr handle cell), globals: (addr global-table), trace: (addr trace) {
  2 +-- 15 lines: # trace "macroexpand " expr-ah --------------------------------------------------------------------------------------------------------------------------------------------
 17   trace-lower trace
 18   # loop until convergence
 19   {
 20     var error?/eax: boolean <- has-errors? trace
 21     compare error?, 0/false
 22     break-if-!=
 23     var expanded?/eax: boolean <- macroexpand-iter expr-ah, globals, trace
 24     compare expanded?, 0/false
 25     loop-if-!=
 26   }
 27   trace-higher trace
 28 +-- 15 lines: # trace "=> " expr-ah -----------------------------------------------------------------------------------------------------------------------------------------------------
 43 }
 44 
 45 # return true if we found any macros
 46 fn macroexpand-iter _expr-ah: (addr handle cell), globals: (addr global-table), trace: (addr trace) -> _/eax: boolean {
 47   var expr-ah/esi: (addr handle cell) <- copy _expr-ah
 48 +-- 15 lines: # trace "macroexpand-iter " expr ------------------------------------------------------------------------------------------------------------------------------------------
 63   trace-lower trace
 64   # if expr is a non-pair, return
 65   var expr/eax: (addr cell) <- lookup *expr-ah
 66   {
 67     var nil?/eax: boolean <- nil? expr
 68     compare nil?, 0/false
 69     break-if-=
 70     # nil is a literal
 71     trace-text trace, "mac", "nil"
 72     trace-higher trace
 73     return 0/false
 74   }
 75   {
 76     var expr-type/eax: (addr int) <- get expr, type
 77     compare *expr-type, 0/pair
 78     break-if-=
 79     # non-pairs are literals
 80     trace-text trace, "mac", "non-pair"
 81     trace-higher trace
 82     return 0/false
 83   }
 84   # if expr is a literal pair, return
 85   var first-ah/ebx: (addr handle cell) <- get expr, left
 86   var rest-ah/ecx: (addr handle cell) <- get expr, right
 87   var first/eax: (addr cell) <- lookup *first-ah
 88   {
 89     var litfn?/eax: boolean <- litfn? first
 90     compare litfn?, 0/false
 91     break-if-=
 92     # litfn is a literal
 93     trace-text trace, "mac", "literal function"
 94     trace-higher trace
 95     return 0/false
 96   }
 97   {
 98     var litmac?/eax: boolean <- litmac? first
 99     compare litmac?, 0/false
100     break-if-=
101     # litmac is a literal
102     trace-text trace, "mac", "literal macro"
103     trace-higher trace
104     return 0/false
105   }
106   var result/edi: boolean <- copy 0/false
107   # for each builtin, expand only what will later be evaluated
108   $macroexpand-iter:anonymous-function: {
109     var fn?/eax: boolean <- fn? first
110     compare fn?, 0/false
111     break-if-=
112     # fn: expand every expression in the body
113     trace-text trace, "mac", "anonymous function"
114     # skip parameters
115     var rest/eax: (addr cell) <- lookup *rest-ah
116     {
117       rest-ah <- get rest, right
118       rest <- lookup *rest-ah
119       {
120         var done?/eax: boolean <- nil? rest
121         compare done?, 0/false
122       }
123       break-if-!=
124       var curr-ah/eax: (addr handle cell) <- get rest, left
125       var macro-found?/eax: boolean <- macroexpand-iter curr-ah, globals, trace
126       result <- or macro-found?
127       {
128         var error?/eax: boolean <- has-errors? trace
129         compare error?, 0/false
130         break-if-=
131         trace-higher trace
132         return result
133       }
134       loop
135     }
136     trace-higher trace
137 +-- 15 lines: # trace "fn=> " _expr-ah --------------------------------------------------------------------------------------------------------------------------------------------------
152     return result
153   }
154   # builtins with "special" evaluation rules
155   $macroexpand-iter:quote: {
156     # trees starting with single quote create literals
157     var quote?/eax: boolean <- symbol-equal? first, "'"
158     compare quote?, 0/false
159     break-if-=
160     #
161     trace-text trace, "mac", "quote"
162     trace-higher trace
163     return 0/false
164   }
165   $macroexpand-iter:backquote: {
166     # nested backquote not supported for now
167     var backquote?/eax: boolean <- symbol-equal? first, "`"
168     compare backquote?, 0/false
169     break-if-=
170     #
171 #?     set-cursor-position 0/screen, 0x40/x 0x10/y
172 #?     dump-cell-from-cursor-over-full-screen rest-ah
173     var double-unquote-found?/eax: boolean <- look-for-double-unquote rest-ah
174     compare double-unquote-found?, 0/false
175     {
176       break-if-=
177       error trace, "double unquote not supported yet"
178     }
179     trace-higher trace
180     return 0/false
181   }
182   $macroexpand-iter:def: {
183     # trees starting with "def" define globals
184     var def?/eax: boolean <- symbol-equal? first, "def"
185     compare def?, 0/false
186     break-if-=
187     #
188     trace-text trace, "mac", "def"
189     var rest/eax: (addr cell) <- lookup *rest-ah
190     rest-ah <- get rest, right  # skip name
191     rest <- lookup *rest-ah
192     var val-ah/edx: (addr handle cell) <- get rest, left
193     var macro-found?/eax: boolean <- macroexpand-iter val-ah, globals, trace
194     trace-higher trace
195 +-- 15 lines: # trace "def=> " _expr-ah -------------------------------------------------------------------------------------------------------------------------------------------------
210     return macro-found?
211   }
212   $macroexpand-iter:set: {
213     # trees starting with "set" mutate bindings
214     var set?/eax: boolean <- symbol-equal? first, "set"
215     compare set?, 0/false
216     break-if-=
217     #
218     trace-text trace, "mac", "set"
219     var rest/eax: (addr cell) <- lookup *rest-ah
220     rest-ah <- get rest, right  # skip name
221     rest <- lookup *rest-ah
222     var val-ah/edx: (addr handle cell) <- get rest, left
223     var macro-found?/eax: boolean <- macroexpand-iter val-ah, globals, trace
224     trace-higher trace
225 +-- 15 lines: # trace "set=> " _expr-ah -------------------------------------------------------------------------------------------------------------------------------------------------
240     return macro-found?
241   }
242   # 'and' is like a function for macroexpansion purposes
243   # 'or' is like a function for macroexpansion purposes
244   # 'if' is like a function for macroexpansion purposes
245   # 'while' is like a function for macroexpansion purposes
246   # if car(expr) is a symbol defined as a macro, expand it
247   {
248     var definition-h: (handle cell)
249     var definition-ah/edx: (addr handle cell) <- address definition-h
250     maybe-lookup-symbol-in-globals first, definition-ah, globals, trace
251     var definition/eax: (addr cell) <- lookup *definition-ah
252     compare definition, 0
253     break-if-=
254     # definition found
255     {
256       var definition-type/eax: (addr int) <- get definition, type
257       compare *definition-type, 0/pair
258     }
259     break-if-!=
260     # definition is a pair
261     {
262       var definition-car-ah/eax: (addr handle cell) <- get definition, left
263       var definition-car/eax: (addr cell) <- lookup *definition-car-ah
264       var macro?/eax: boolean <- litmac? definition-car
265       compare macro?, 0/false
266     }
267     break-if-=
268     # definition is a macro
269     var macro-definition-ah/eax: (addr handle cell) <- get definition, right
270     # TODO: check car(macro-definition) is litfn
271 #?     turn-on-debug-print
272     apply macro-definition-ah, rest-ah, expr-ah, globals, trace, 0/no-screen, 0/no-keyboard, 0/call-number
273     trace-higher trace
274 +-- 15 lines: # trace "1=> " _expr-ah ---------------------------------------------------------------------------------------------------------------------------------------------------
289     return 1/true
290   }
291   # no macro found; process any macros within args
292   trace-text trace, "mac", "recursing into function definition"
293   var curr-ah/ebx: (addr handle cell) <- copy first-ah
294   $macroexpand-iter:loop: {
295 #?     clear-screen 0/screen
296 #?     dump-trace trace
297     var macro-found?/eax: boolean <- macroexpand-iter curr-ah, globals, trace
298     result <- or macro-found?
299     var error?/eax: boolean <- has-errors? trace
300     compare error?, 0/false
301     break-if-!=
302     var rest/eax: (addr cell) <- lookup *rest-ah
303     {
304       var nil?/eax: boolean <- nil? rest
305       compare nil?, 0/false
306     }
307     break-if-!=
308     curr-ah <- get rest, left
309     rest-ah <- get rest, right
310     loop
311   }
312   trace-higher trace
313 +-- 15 lines: # trace "=> " _expr-ah ----------------------------------------------------------------------------------------------------------------------------------------------------
328   return result
329 }
330 
331 fn look-for-double-unquote _expr-ah: (addr handle cell) -> _/eax: boolean {
332   # if expr is a non-pair, return false
333   var expr-ah/eax: (addr handle cell) <- copy _expr-ah
334   var expr/eax: (addr cell) <- lookup *expr-ah
335   {
336     var nil?/eax: boolean <- nil? expr
337     compare nil?, 0/false
338     break-if-=
339     return 0/false
340   }
341   {
342     var expr-type/eax: (addr int) <- get expr, type
343     compare *expr-type, 0/pair
344     break-if-=
345     return 0/false
346   }
347   var cdr-ah/ecx: (addr handle cell) <- get expr, right
348   var car-ah/ebx: (addr handle cell) <- get expr, left
349   var car/eax: (addr cell) <- lookup *car-ah
350   # if car is unquote or unquote-splice, check if cadr is unquote or
351   # unquote-splice.
352   $look-for-double-unquote:check: {
353     # if car is not an unquote, break
354     {
355       {
356         var unquote?/eax: boolean <- symbol-equal? car, ","
357         compare unquote?, 0/false
358       }
359       break-if-!=
360       var unquote-splice?/eax: boolean <- symbol-equal? car, ",@"
361       compare unquote-splice?, 0/false
362       break-if-!=
363       break $look-for-double-unquote:check
364     }
365     # if cdr is not a pair, break
366     var cdr/eax: (addr cell) <- lookup *cdr-ah
367     var cdr-type/ecx: (addr int) <- get cdr, type
368     compare *cdr-type, 0/pair
369     break-if-!=
370     # if cadr is not an unquote, break
371     var cadr-ah/eax: (addr handle cell) <- get cdr, left
372     var cadr/eax: (addr cell) <- lookup *cadr-ah
373     {
374       {
375         var unquote?/eax: boolean <- symbol-equal? cadr, ","
376         compare unquote?, 0/false
377       }
378       break-if-!=
379       var unquote-splice?/eax: boolean <- symbol-equal? cadr, ",@"
380       compare unquote-splice?, 0/false
381       break-if-!=
382       break $look-for-double-unquote:check
383     }
384     # error
385     return 1/true
386   }
387   var result/eax: boolean <- look-for-double-unquote car-ah
388   compare result, 0/false
389   {
390     break-if-=
391     return result
392   }
393   result <- look-for-double-unquote cdr-ah
394   return result
395 }
396 
397 fn test-macroexpand {
398   var globals-storage: global-table
399   var globals/edx: (addr global-table) <- address globals-storage
400   initialize-globals globals
401   # new macro: m
402   var sandbox-storage: sandbox
403   var sandbox/esi: (addr sandbox) <- address sandbox-storage
404   initialize-sandbox-with sandbox, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
405   edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
406   # invoke macro
407   initialize-sandbox-with sandbox, "(m 3 4)"
408   var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
409   var gap/eax: (addr gap-buffer) <- lookup *gap-ah
410   var result-h: (handle cell)
411   var result-ah/ebx: (addr handle cell) <- address result-h
412   var trace-storage: trace
413   var trace/ecx: (addr trace) <- address trace-storage
414   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
415   read-cell gap, result-ah, trace
416   var dummy/eax: boolean <- macroexpand-iter result-ah, globals, trace
417   var error?/eax: boolean <- has-errors? trace
418   check-not error?, "F - test-macroexpand/error"
419 #?   dump-cell-from-cursor-over-full-screen result-ah
420   var _result/eax: (addr cell) <- lookup *result-ah
421   var result/edi: (addr cell) <- copy _result
422   # expected
423   initialize-sandbox-with sandbox, "(+ 3 4)"
424   var expected-gap-ah/edx: (addr handle gap-buffer) <- get sandbox, data
425   var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
426   var expected-h: (handle cell)
427   var expected-ah/edx: (addr handle cell) <- address expected-h
428   read-cell expected-gap, expected-ah, trace
429 #?   dump-cell-from-cursor-over-full-screen expected-ah
430   var expected/eax: (addr cell) <- lookup *expected-ah
431   #
432   var assertion/eax: boolean <- cell-isomorphic? result, expected, trace
433   check assertion, "F - test-macroexpand"
434 }
435 
436 fn test-macroexpand-inside-anonymous-fn {
437   var globals-storage: global-table
438   var globals/edx: (addr global-table) <- address globals-storage
439   initialize-globals globals
440   # new macro: m
441   var sandbox-storage: sandbox
442   var sandbox/esi: (addr sandbox) <- address sandbox-storage
443   initialize-sandbox-with sandbox, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
444   edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
445   # invoke macro
446   initialize-sandbox-with sandbox, "(fn() (m 3 4))"
447   var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
448   var gap/eax: (addr gap-buffer) <- lookup *gap-ah
449   var result-h: (handle cell)
450   var result-ah/ebx: (addr handle cell) <- address result-h
451   var trace-storage: trace
452   var trace/ecx: (addr trace) <- address trace-storage
453   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
454   read-cell gap, result-ah, trace
455   var dummy/eax: boolean <- macroexpand-iter result-ah, globals, trace
456   var error?/eax: boolean <- has-errors? trace
457   check-not error?, "F - test-macroexpand-inside-anonymous-fn/error"
458 #?   dump-cell-from-cursor-over-full-screen result-ah
459   var _result/eax: (addr cell) <- lookup *result-ah
460   var result/edi: (addr cell) <- copy _result
461   # expected
462   initialize-sandbox-with sandbox, "(fn() (+ 3 4))"
463   var expected-gap-ah/edx: (addr handle gap-buffer) <- get sandbox, data
464   var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
465   var expected-h: (handle cell)
466   var expected-ah/edx: (addr handle cell) <- address expected-h
467   read-cell expected-gap, expected-ah, trace
468   var expected/eax: (addr cell) <- lookup *expected-ah
469   #
470   var assertion/eax: boolean <- cell-isomorphic? result, expected, trace
471   check assertion, "F - test-macroexpand-inside-anonymous-fn"
472 }
473 
474 fn test-macroexpand-inside-fn-call {
475   var globals-storage: global-table
476   var globals/edx: (addr global-table) <- address globals-storage
477   initialize-globals globals
478   # new macro: m
479   var sandbox-storage: sandbox
480   var sandbox/esi: (addr sandbox) <- address sandbox-storage
481   initialize-sandbox-with sandbox, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
482   edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
483   # invoke macro
484   initialize-sandbox-with sandbox, "((fn() (m 3 4)))"
485   var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
486   var gap/eax: (addr gap-buffer) <- lookup *gap-ah
487   var result-h: (handle cell)
488   var result-ah/ebx: (addr handle cell) <- address result-h
489   var trace-storage: trace
490   var trace/ecx: (addr trace) <- address trace-storage
491   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
492   read-cell gap, result-ah, trace
493   var dummy/eax: boolean <- macroexpand-iter result-ah, globals, trace
494   var error?/eax: boolean <- has-errors? trace
495   check-not error?, "F - test-macroexpand-inside-fn-call/error"
496 #?   dump-cell-from-cursor-over-full-screen result-ah
497   var _result/eax: (addr cell) <- lookup *result-ah
498   var result/edi: (addr cell) <- copy _result
499   # expected
500   initialize-sandbox-with sandbox, "((fn() (+ 3 4)))"
501   var expected-gap-ah/edx: (addr handle gap-buffer) <- get sandbox, data
502   var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
503   var expected-h: (handle cell)
504   var expected-ah/edx: (addr handle cell) <- address expected-h
505   read-cell expected-gap, expected-ah, trace
506 #?   dump-cell-from-cursor-over-full-screen expected-ah
507   var expected/eax: (addr cell) <- lookup *expected-ah
508   #
509   var assertion/eax: boolean <- cell-isomorphic? result, expected, trace
510   check assertion, "F - test-macroexpand-inside-fn-call"
511 }
512 
513 fn test-macroexpand-repeatedly-with-backquoted-arg {
514   var globals-storage: global-table
515   var globals/edx: (addr global-table) <- address globals-storage
516   initialize-globals globals
517   # macroexpand an expression with a backquote but no macro
518   var sandbox-storage: sandbox
519   var sandbox/esi: (addr sandbox) <- address sandbox-storage
520   initialize-sandbox-with sandbox, "(cons 1 `(3))"
521   var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
522   var gap/eax: (addr gap-buffer) <- lookup *gap-ah
523   var result-h: (handle cell)
524   var result-ah/ebx: (addr handle cell) <- address result-h
525   var trace-storage: trace
526   var trace/ecx: (addr trace) <- address trace-storage
527   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
528   read-cell gap, result-ah, trace
529   var dummy/eax: boolean <- macroexpand-iter result-ah, globals, trace
530   var error?/eax: boolean <- has-errors? trace
531   check-not error?, "F - test-macroexpand-repeatedly-with-backquoted-arg"
532   {
533     compare error?, 0/false
534     break-if-=
535     # we need space to display traces, so just stop rendering future tests on failure here
536     dump-trace trace
537     {
538       loop
539     }
540   }
541 }
542 
543 fn pending-test-macroexpand-inside-backquote-unquote {
544   var globals-storage: global-table
545   var globals/edx: (addr global-table) <- address globals-storage
546   initialize-globals globals
547   # new macro: m
548   var sandbox-storage: sandbox
549   var sandbox/esi: (addr sandbox) <- address sandbox-storage
550   initialize-sandbox-with sandbox, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
551   edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
552   # invoke macro
553   initialize-sandbox-with sandbox, "`(print [result is ] ,(m 3 4)))"
554   var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
555   var gap/eax: (addr gap-buffer) <- lookup *gap-ah
556   var result-h: (handle cell)
557   var result-ah/ebx: (addr handle cell) <- address result-h
558   var trace-storage: trace
559   var trace/ecx: (addr trace) <- address trace-storage
560   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
561   read-cell gap, result-ah, trace
562   var dummy/eax: boolean <- macroexpand-iter result-ah, globals, trace
563   var error?/eax: boolean <- has-errors? trace
564   check-not error?, "F - test-macroexpand-inside-backquote-unquote/error"
565 #?   dump-cell-from-cursor-over-full-screen result-ah
566   var _result/eax: (addr cell) <- lookup *result-ah
567   var result/edi: (addr cell) <- copy _result
568   # expected
569   initialize-sandbox-with sandbox, "`(print [result is ] ,(+ 3 4)))"
570   var expected-gap-ah/edx: (addr handle gap-buffer) <- get sandbox, data
571   var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
572   var expected-h: (handle cell)
573   var expected-ah/edx: (addr handle cell) <- address expected-h
574   read-cell expected-gap, expected-ah, trace
575   var expected/eax: (addr cell) <- lookup *expected-ah
576   #
577   var assertion/eax: boolean <- cell-isomorphic? result, expected, trace
578   check assertion, "F - test-macroexpand-inside-backquote-unquote"
579 }
580 
581 fn pending-test-macroexpand-inside-nested-backquote-unquote {
582   var globals-storage: global-table
583   var globals/edx: (addr global-table) <- address globals-storage
584   initialize-globals globals
585   # new macro: m
586   var sandbox-storage: sandbox
587   var sandbox/esi: (addr sandbox) <- address sandbox-storage
588   initialize-sandbox-with sandbox, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
589   edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
590   # invoke macro
591   initialize-sandbox-with sandbox, "`(a ,(m 3 4) `(b ,(m 3 4) ,,(m 3 4)))"
592   var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
593   var gap/eax: (addr gap-buffer) <- lookup *gap-ah
594   var result-h: (handle cell)
595   var result-ah/ebx: (addr handle cell) <- address result-h
596   var trace-storage: trace
597   var trace/ecx: (addr trace) <- address trace-storage
598   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
599   read-cell gap, result-ah, trace
600   var dummy/eax: boolean <- macroexpand-iter result-ah, globals, trace
601   var error?/eax: boolean <- has-errors? trace
602   check-not error?, "F - test-macroexpand-inside-nested-backquote-unquote/error"
603   dump-cell-from-cursor-over-full-screen result-ah
604   var _result/eax: (addr cell) <- lookup *result-ah
605   var result/edi: (addr cell) <- copy _result
606   # expected
607   initialize-sandbox-with sandbox, "`(a ,(+ 3 4) `(b ,(m 3 4) ,,(+ 3 4)))"
608   var expected-gap-ah/edx: (addr handle gap-buffer) <- get sandbox, data
609   var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
610   var expected-h: (handle cell)
611   var expected-ah/edx: (addr handle cell) <- address expected-h
612   read-cell expected-gap, expected-ah, trace
613   dump-cell-from-cursor-over-full-screen expected-ah
614   var expected/eax: (addr cell) <- lookup *expected-ah
615   #
616   var assertion/eax: boolean <- cell-isomorphic? result, expected, trace
617   check assertion, "F - test-macroexpand-inside-nested-backquote-unquote"
618 }
619 
620 # TODO: unquote-splice, nested and unnested