https://github.com/akkartik/mu/blob/main/shell/macroexpand.mu

      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:define: {
    183     # trees starting with "define" define globals
    184     var define?/eax: boolean <- symbol-equal? first, "define"
    185     compare define?, 0/false
    186     break-if-=
    187     #
    188     trace-text trace, "mac", "define"
    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 "define=> " _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/definitions-created, 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, "(define m (litmac litfn () (a b) `(+ ,a ,b)))"
    405   edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk
    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, 4/fg 0/bg
    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, "(define m (litmac litfn () (a b) `(+ ,a ,b)))"
    444   edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk
    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, "(define m (litmac litfn () (a b) `(+ ,a ,b)))"
    482   edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk
    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, "(define m (litmac litfn () (a b) `(+ ,a ,b)))"
    551   edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk
    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, "(define m (litmac litfn () (a b) `(+ ,a ,b)))"
    589   edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk
    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