fn macroexpand expr-ah: (addr handle cell), globals: (addr global-table), trace: (addr trace) { # trace "macroexpand " expr-ah {{{ { var should-trace?/eax: boolean <- should-trace? trace compare should-trace?, 0/false break-if-= var stream-storage: (stream byte 0x200) var stream/ecx: (addr stream byte) <- address stream-storage write stream, "macroexpand " var nested-trace-storage: trace var nested-trace/edi: (addr trace) <- address nested-trace-storage initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible print-cell expr-ah, stream, nested-trace trace trace, "mac", stream } # }}} trace-lower trace # loop until convergence { var error?/eax: boolean <- has-errors? trace compare error?, 0/false break-if-!= var expanded?/eax: boolean <- macroexpand-iter expr-ah, globals, trace compare expanded?, 0/false loop-if-!= } trace-higher trace # trace "=> " expr-ah {{{ { var should-trace?/eax: boolean <- should-trace? trace compare should-trace?, 0/false break-if-= var stream-storage: (stream byte 0x200) var stream/ecx: (addr stream byte) <- address stream-storage write stream, "=> " var nested-trace-storage: trace var nested-trace/edi: (addr trace) <- address nested-trace-storage initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible print-cell expr-ah, stream, nested-trace trace trace, "mac", stream } # }}} } # return true if we found any macros fn macroexpand-iter _expr-ah: (addr handle cell), globals: (addr global-table), trace: (addr trace) -> _/eax: boolean { var expr-ah/esi: (addr handle cell) <- copy _expr-ah # trace "macroexpand-iter " expr {{{ { var should-trace?/eax: boolean <- should-trace? trace compare should-trace?, 0/false break-if-= var stream-storage: (stream byte 0x200) var stream/ecx: (addr stream byte) <- address stream-storage write stream, "macroexpand-iter " var nested-trace-storage: trace var nested-trace/edi: (addr trace) <- address nested-trace-storage initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible print-cell expr-ah, stream, nested-trace trace trace, "mac", stream } # }}} trace-lower trace # if expr is a non-pair, return var expr/eax: (addr cell) <- lookup *expr-ah { var nil?/eax: boolean <- nil? expr compare nil?, 0/false break-if-= # nil is a literal trace-text trace, "mac", "nil" trace-higher trace return 0/false } { var expr-type/eax: (addr int) <- get expr, type compare *expr-type, 0/pair break-if-= # non-pairs are literals trace-text trace, "mac", "non-pair" trace-higher trace return 0/false } # if expr is a literal pair, return var first-ah/ebx: (addr handle cell) <- get expr, left var rest-ah/ecx: (addr handle cell) <- get expr, right var first/eax: (addr cell) <- lookup *first-ah { var litfn?/eax: boolean <- litfn? first compare litfn?, 0/false break-if-= # litfn is a literal trace-text trace, "mac", "literal function" trace-higher trace return 0/false } { var litmac?/eax: boolean <- litmac? first compare litmac?, 0/false break-if-= # litmac is a literal trace-text trace, "mac", "literal macro" trace-higher trace return 0/false } { var litimg?/eax: boolean <- litimg? first compare litimg?, 0/false break-if-= # litimg is a literal trace-text trace, "mac", "literal image" trace-higher trace return 0/false } var result/edi: boolean <- copy 0/false # for each builtin, expand only what will later be evaluated $macroexpand-iter:anonymous-function: { var fn?/eax: boolean <- fn? first compare fn?, 0/false break-if-= # fn: expand every expression in the body trace-text trace, "mac", "anonymous function" # skip parameters var rest/eax: (addr cell) <- lookup *rest-ah { rest-ah <- get rest, right rest <- lookup *rest-ah { var done?/eax: boolean <- nil? rest compare done?, 0/false } break-if-!= var curr-ah/eax: (addr handle cell) <- get rest, left var macro-found?/eax: boolean <- macroexpand-iter curr-ah, globals, trace result <- or macro-found? { var error?/eax: boolean <- has-errors? trace compare error?, 0/false break-if-= trace-higher trace return result } loop } trace-higher trace # trace "fn=> " _expr-ah {{{ { var should-trace?/eax: boolean <- should-trace? trace compare should-trace?, 0/false break-if-= var stream-storage: (stream byte 0x200) var stream/ecx: (addr stream byte) <- address stream-storage write stream, "fn=> " var nested-trace-storage: trace var nested-trace/edi: (addr trace) <- address nested-trace-storage initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible print-cell _expr-ah, stream, nested-trace trace trace, "mac", stream } # }}} return result } # builtins with "special" evaluation rules $macroexpand-iter:quote: { # trees starting with single quote create literals var quote?/eax: boolean <- symbol-equal? first, "'" compare quote?, 0/false break-if-= # trace-text trace, "mac", "quote" trace-higher trace return 0/false } $macroexpand-iter:backquote: { # nested backquote not supported for now var backquote?/eax: boolean <- symbol-equal? first, "`" compare backquote?, 0/false break-if-= # #? set-cursor-position 0/screen, 0x40/x 0x10/y #? dump-cell-from-cursor-over-full-screen rest-ah var double-unquote-found?/eax: boolean <- look-for-double-unquote rest-ah compare double-unquote-found?, 0/false { break-if-= error trace, "double unquote not supported yet" } trace-higher trace return 0/false } $macroexpand-iter:define: { # trees starting with "define" define globals var define?/eax: boolean <- symbol-equal? first, "define" compare define?, 0/false break-if-= # trace-text trace, "mac", "define" var rest/eax: (addr cell) <- lookup *rest-ah rest-ah <- get rest, right # skip name rest <- lookup *rest-ah var val-ah/edx: (addr handle cell) <- get rest, left var macro-found?/eax: boolean <- macroexpand-iter val-ah, globals, trace trace-higher trace # trace "define=> " _expr-ah {{{ { var should-trace?/eax: boolean <- should-trace? trace compare should-trace?, 0/false break-if-= var stream-storage: (stream byte 0x200) var stream/ecx: (addr stream byte) <- address stream-storage write stream, "define=> " var nested-trace-storage: trace var nested-trace/edi: (addr trace) <- address nested-trace-storage initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible print-cell _expr-ah, stream, nested-trace trace trace, "mac", stream } # }}} return macro-found? } $macroexpand-iter:set: { # trees starting with "set" mutate bindings var set?/eax: boolean <- symbol-equal? first, "set" compare set?, 0/false break-if-= # trace-text trace, "mac", "set" var rest/eax: (addr cell) <- lookup *rest-ah rest-ah <- get rest, right # skip name rest <- lookup *rest-ah var val-ah/edx: (addr handle cell) <- get rest, left var macro-found?/eax: boolean <- macroexpand-iter val-ah, globals, trace trace-higher trace # trace "set=> " _expr-ah {{{ { var should-trace?/eax: boolean <- should-trace? trace compare should-trace?, 0/false break-if-= var stream-storage: (stream byte 0x200) var stream/ecx: (addr stream byte) <- address stream-storage write stream, "set=> " var nested-trace-storage: trace var nested-trace/edi: (addr trace) <- address nested-trace-storage initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible print-cell _expr-ah, stream, nested-trace trace trace, "mac", stream } # }}} return macro-found? } # 'and' is like a function for macroexpansion purposes # 'or' is like a function for macroexpansion purposes # 'if' is like a function for macroexpansion purposes # 'while' is like a function for macroexpansion purposes # if car(expr) is a symbol defined as a macro, expand it { var definition-h: (handle cell) var definition-ah/edx: (addr handle cell) <- address definition-h maybe-lookup-symbol-in-globals first, definition-ah, globals, trace var definition/eax: (addr cell) <- lookup *definition-ah compare definition, 0 break-if-= # definition found { var definition-type/eax: (addr int) <- get definition, type compare *definition-type, 0/pair } break-if-!= # definition is a pair { var definition-car-ah/eax: (addr handle cell) <- get definition, left var definition-car/eax: (addr cell) <- lookup *definition-car-ah var macro?/eax: boolean <- litmac? definition-car compare macro?, 0/false } break-if-= # definition is a macro var macro-definition-ah/eax: (addr handle cell) <- get definition, right # TODO: check car(macro-definition) is litfn #? turn-on-debug-print apply macro-definition-ah, rest-ah, expr-ah, globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number trace-higher trace # trace "1=> " _expr-ah {{{ { var should-trace?/eax: boolean <- should-trace? trace compare should-trace?, 0/false break-if-= var stream-storage: (stream byte 0x200) var stream/ecx: (addr stream byte) <- address stream-storage write stream, "1=> " var nested-trace-storage: trace var nested-trace/edi: (addr trace) <- address nested-trace-storage initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible print-cell _expr-ah, stream, nested-trace trace trace, "mac", stream } # }}} return 1/true } # no macro found; process any macros within args trace-text trace, "mac", "recursing into function definition" var curr-ah/ebx: (addr handle cell) <- copy first-ah $macroexpand-iter:loop: { #? clear-screen 0/screen #? dump-trace trace var macro-found?/eax: boolean <- macroexpand-iter curr-ah, globals, trace result <- or macro-found? var error?/eax: boolean <- has-errors? trace compare error?, 0/false break-if-!= var rest/eax: (addr cell) <- lookup *rest-ah { var nil?/eax: boolean <- nil? rest compare nil?, 0/false } break-if-!= curr-ah <- get rest, left rest-ah <- get rest, right loop } trace-higher trace # trace "=> " _expr-ah {{{ { var should-trace?/eax: boolean <- should-trace? trace compare should-trace?, 0/false break-if-= var stream-storage: (stream byte 0x200) var stream/ecx: (addr stream byte) <- address stream-storage write stream, "=> " var nested-trace-storage: trace var nested-trace/edi: (addr trace) <- address nested-trace-storage initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible print-cell _expr-ah, stream, nested-trace trace trace, "mac", stream } # }}} return result } fn look-for-double-unquote _expr-ah: (addr handle cell) -> _/eax: boolean { # if expr is a non-pair, return false var expr-ah/eax: (addr handle cell) <- copy _expr-ah var expr/eax: (addr cell) <- lookup *expr-ah { var nil?/eax: boolean <- nil? expr compare nil?, 0/false break-if-= return 0/false } { var expr-type/eax: (addr int) <- get expr, type compare *expr-type, 0/pair break-if-= return 0/false } var cdr-ah/ecx: (addr handle cell) <- get expr, right var car-ah/ebx: (addr handle cell) <- get expr, left var car/eax: (addr cell) <- lookup *car-ah # if car is unquote or unquote-splice, check if cadr is unquote or # unquote-splice. $look-for-double-unquote:check: { # if car is not an unquote, break { { var unquote?/eax: boolean <- symbol-equal? car, "," compare unquote?, 0/false } break-if-!= var unquote-splice?/eax: boolean <- symbol-equal? car, ",@" compare unquote-splice?, 0/false break-if-!= break $look-for-double-unquote:check } # if cdr is not a pair, break var cdr/eax: (addr cell) <- lookup *cdr-ah var cdr-type/ecx: (addr int) <- get cdr, type compare *cdr-type, 0/pair break-if-!= # if cadr is not an unquote, break var cadr-ah/eax: (addr handle cell) <- get cdr, left var cadr/eax: (addr cell) <- lookup *cadr-ah { { var unquote?/eax: boolean <- symbol-equal? cadr, "," compare unquote?, 0/false } break-if-!= var unquote-splice?/eax: boolean <- symbol-equal? cadr, ",@" compare unquote-splice?, 0/false break-if-!= break $look-for-double-unquote:check } # error return 1/true } var result/eax: boolean <- look-for-double-unquote car-ah compare result, 0/false { break-if-= return result } result <- look-for-double-unquote cdr-ah return result } fn test-macroexpand { var globals-storage: global-table var globals/edx: (addr global-table) <- address globals-storage initialize-globals globals # new macro: m var sandbox-storage: sandbox var sandbox/esi: (addr sandbox) <- address sandbox-storage initialize-sandbox-with sandbox, "(define m (litmac litfn () (a b) `(+ ,a ,b)))" edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk # invoke macro initialize-sandbox-with sandbox, "(m 3 4)" var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data var gap/eax: (addr gap-buffer) <- lookup *gap-ah var result-h: (handle cell) var result-ah/ebx: (addr handle cell) <- address result-h var trace-storage: trace var trace/ecx: (addr trace) <- address trace-storage initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible read-cell gap, result-ah, trace var dummy/eax: boolean <- macroexpand-iter result-ah, globals, trace var error?/eax: boolean <- has-errors? trace check-not error?, "F - test-macroexpand/error" #? dump-cell-from-cursor-over-full-screen result-ah, 4/fg 0/bg var _result/eax: (addr cell) <- lookup *result-ah var result/edi: (addr cell) <- copy _result # expected initialize-sandbox-with sandbox, "(+ 3 4)" var expected-gap-ah/edx: (addr handle gap-buffer) <- get sandbox, data var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah var expected-h: (handle cell) var expected-ah/edx: (addr handle cell) <- address expected-h read-cell expected-gap, expected-ah, trace #? dump-cell-from-cursor-over-full-screen expected-ah var expected/eax: (addr cell) <- lookup *expected-ah # var assertion/eax: boolean <- cell-isomorphic? result, expected, trace check assertion, "F - test-macroexpand" } fn test-macroexpand-inside-anonymous-fn { var globals-storage: global-table var globals/edx: (addr global-table) <- address globals-storage initialize-globals globals # new macro: m var sandbox-storage: sandbox var sandbox/esi: (addr sandbox) <- address sandbox-storage initialize-sandbox-with sandbox, "(define m (litmac litfn () (a b) `(+ ,a ,b)))" edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk # invoke macro initialize-sandbox-with sandbox, "(fn() (m 3 4))" var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data var gap/eax: (addr gap-buffer) <- lookup *gap-ah var result-h: (handle cell) var result-ah/ebx: (addr handle cell) <- address result-h var trace-storage: trace var trace/ecx: (addr trace) <- address trace-storage initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible read-cell gap, result-ah, trace var dummy/eax: boolean <- macroexpand-iter result-ah, globals, trace var error?/eax: boolean <- has-errors? trace check-not error?, "F - test-macroexpand-inside-anonymous-fn/error" #? dump-cell-from-cursor-over-full-screen result-ah var _result/eax: (addr cell) <- lookup *result-ah var result/edi: (addr cell) <- copy _result # expected initialize-sandbox-with sandbox, "(fn() (+ 3 4))" var expected-gap-ah/edx: (addr handle gap-buffer) <- get sandbox, data var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah var expected-h: (handle cell) var expected-ah/edx: (addr handle cell) <- address expected-h read-cell expected-gap, expected-ah, trace var expected/eax: (addr cell) <- lookup *expected-ah # var assertion/eax: boolean <- cell-isomorphic? result, expected, trace check assertion, "F - test-macroexpand-inside-anonymous-fn" } fn test-macroexpand-inside-fn-call { var globals-storage: global-table var globals/edx: (addr global-table) <- address globals-storage initialize-globals globals # new macro: m var sandbox-storage: sandbox var sandbox/esi: (addr sandbox) <- address sandbox-storage initialize-sandbox-with sandbox, "(define m (litmac litfn () (a b) `(+ ,a ,b)))" edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk # invoke macro initialize-sandbox-with sandbox, "((fn() (m 3 4)))" var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data var gap/eax: (addr gap-buffer) <- lookup *gap-ah var result-h: (handle cell) var result-ah/ebx: (addr handle cell) <- address result-h var trace-storage: trace var trace/ecx: (addr trace) <- address trace-storage initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible read-cell gap, result-ah, trace var dummy/eax: boolean <- macroexpand-iter result-ah, globals, trace var error?/eax: boolean <- has-errors? trace check-not error?, "F - test-macroexpand-inside-fn-call/error" #? dump-cell-from-cursor-over-full-screen result-ah var _result/eax: (addr cell) <- lookup *result-ah var result/edi: (addr cell) <- copy _result # expected initialize-sandbox-with sandbox, "((fn() (+ 3 4)))" var expected-gap-ah/edx: (addr handle gap-buffer) <- get sandbox, data var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah var expected-h: (handle cell) var expected-ah/edx: (addr handle cell) <- address expected-h read-cell expected-gap, expected-ah, trace #? dump-cell-from-cursor-over-full-screen expected-ah var expected/eax: (addr cell) <- lookup *expected-ah # var assertion/eax: boolean <- cell-isomorphic? result, expected, trace check assertion, "F - test-macroexpand-inside-fn-call" } fn test-macroexpand-repeatedly-with-backquoted-arg { var globals-storage: global-table var globals/edx: (addr global-table) <- address globals-storage initialize-globals globals # macroexpand an expression with a backquote but no macro var sandbox-storage: sandbox var sandbox/esi: (addr sandbox) <- address sandbox-storage initialize-sandbox-with sandbox, "(cons 1 `(3))" var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data var gap/eax: (addr gap-buffer) <- lookup *gap-ah var result-h: (handle cell) var result-ah/ebx: (addr handle cell) <- address result-h var trace-storage: trace var trace/ecx: (addr trace) <- address trace-storage initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible read-cell gap, result-ah, trace var dummy/eax: boolean <- macroexpand-iter result-ah, globals, trace var error?/eax: boolean <- has-errors? trace check-not error?, "F - test-macroexpand-repeatedly-with-backquoted-arg" { compare error?, 0/false break-if-= # we need space to display traces, so just stop rendering future tests on failure here dump-trace trace { loop } } } fn pending-test-macroexpand-inside-backquote-unquote { var globals-storage: global-table var globals/edx: (addr global-table) <- address globals-storage initialize-globals globals # new macro: m var sandbox-storage: sandbox var sandbox/esi: (addr sandbox) <- address sandbox-storage initialize-sandbox-with sandbox, "(define m (litmac litfn () (a b) `(+ ,a ,b)))" edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk # invoke macro initialize-sandbox-with sandbox, "`(print [result is ] ,(m 3 4)))" var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data var gap/eax: (addr gap-buffer) <- lookup *gap-ah var result-h: (handle cell) var result-ah/ebx: (addr handle cell) <- address result-h var trace-storage: trace var trace/ecx: (addr trace) <- address trace-storage initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible read-cell gap, result-ah, trace var dummy/eax: boolean <- macroexpand-iter result-ah, globals, trace var error?/eax: boolean <- has-errors? trace check-not error?, "F - test-macroexpand-inside-backquote-unquote/error" #? dump-cell-from-cursor-over-full-screen result-ah var _result/eax: (addr cell) <- lookup *result-ah var result/edi: (addr cell) <- copy _result # expected initialize-sandbox-with sandbox, "`(print [result is ] ,(+ 3 4)))" var expected-gap-ah/edx: (addr handle gap-buffer) <- get sandbox, data var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah var expected-h: (handle cell) var expected-ah/edx: (addr handle cell) <- address expected-h read-cell expected-gap, expected-ah, trace var expected/eax: (addr cell) <- lookup *expected-ah # var assertion/eax: boolean <- cell-isomorphic? result, expected, trace check assertion, "F - test-macroexpand-inside-backquote-unquote" } fn pending-test-macroexpand-inside-nested-backquote-unquote { var globals-storage: global-table var globals/edx: (addr global-table) <- address globals-storage initialize-globals globals # new macro: m var sandbox-storage: sandbox var sandbox/esi: (addr sandbox) <- address sandbox-storage initialize-sandbox-with sandbox, "(define m (litmac litfn () (a b) `(+ ,a ,b)))" edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk # invoke macro initialize-sandbox-with sandbox, "`(a ,(m 3 4) `(b ,(m 3 4) ,,(m 3 4)))" var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data var gap/eax: (addr gap-buffer) <- lookup *gap-ah var result-h: (handle cell) var result-ah/ebx: (addr handle cell) <- address result-h var trace-storage: trace var trace/ecx: (addr trace) <- address trace-storage initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible read-cell gap, result-ah, trace var dummy/eax: boolean <- macroexpand-iter result-ah, globals, trace var error?/eax: boolean <- has-errors? trace check-not error?, "F - test-macroexpand-inside-nested-backquote-unquote/error" #? dump-cell-from-cursor-over-full-screen result-ah var _result/eax: (addr cell) <- lookup *result-ah var result/edi: (addr cell) <- copy _result # expected initialize-sandbox-with sandbox, "`(a ,(+ 3 4) `(b ,(m 3 4) ,,(+ 3 4)))" var expected-gap-ah/edx: (addr handle gap-buffer) <- get sandbox, data var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah var expected-h: (handle cell) var expected-ah/edx: (addr handle cell) <- address expected-h read-cell expected-gap, expected-ah, trace #? dump-cell-from-cursor-over-full-screen expected-ah var expected/eax: (addr cell) <- lookup *expected-ah # var assertion/eax: boolean <- cell-isomorphic? result, expected, trace check assertion, "F - test-macroexpand-inside-nested-backquote-unquote" } # TODO: unquote-splice, nested and unnested