fn macroexpand expr-ah: (addr handle cell), globals: (addr global-table), trace: (addr trace) {
# trace "macroexpand " expr-ah {{{
{
compare trace, 0
break-if-=
var stream-storage: (stream byte 0x200)
var stream/ecx: (addr stream byte) <- address stream-storage
write stream, "macroexpand "
print-cell expr-ah, stream, 0/no-trace
trace trace, "mac", stream
}
# }}}
# loop until convergence
{
var expanded?/eax: boolean <- macroexpand-iter expr-ah, globals, trace
compare expanded?, 0/false
loop-if-!=
}
# trace "=> " expr-ah {{{
{
compare trace, 0
break-if-=
var stream-storage: (stream byte 0x200)
var stream/ecx: (addr stream byte) <- address stream-storage
write stream, "=> "
print-cell expr-ah, stream, 0/no-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 {{{
{
compare trace, 0
break-if-=
var stream-storage: (stream byte 0x200)
var stream/ecx: (addr stream byte) <- address stream-storage
write stream, "macroexpand-iter "
print-cell expr-ah, stream, 0/no-trace
trace trace, "mac", stream
}
# }}}
# 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 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?
loop
}
trace-higher trace
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-=
#
error trace, "nested backquote not supported yet"
trace-higher trace
return 0/false
}
$macroexpand-iter:def: {
# trees starting with "def" define globals
var def?/eax: boolean <- symbol-equal? first, "def"
compare def?, 0/false
break-if-=
#
trace-text trace, "mac", "def"
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
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
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/call-number
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 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
}
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, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
var trace-ah/eax: (addr handle trace) <- get sandbox, trace
var trace/eax: (addr trace) <- lookup *trace-ah
# 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
read-cell gap, result-ah, 0/no-trace
var dummy/eax: boolean <- macroexpand-iter result-ah, globals, 0/no-trace
#? 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, "(+ 3 4)"
var expected-gap-ah/ecx: (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/ecx: (addr handle cell) <- address expected-h
read-cell expected-gap, expected-ah, 0/no-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, 0/no-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, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
var trace-ah/eax: (addr handle trace) <- get sandbox, trace
var trace/eax: (addr trace) <- lookup *trace-ah
# 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
read-cell gap, result-ah, 0/no-trace
var dummy/eax: boolean <- macroexpand-iter result-ah, globals, 0/no-trace
#? 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/ecx: (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/ecx: (addr handle cell) <- address expected-h
read-cell expected-gap, expected-ah, 0/no-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, 0/no-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, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
# 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
read-cell gap, result-ah, 0/no-trace
var dummy/eax: boolean <- macroexpand-iter result-ah, globals, 0/no-trace
#? 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/ecx: (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/ecx: (addr handle cell) <- address expected-h
read-cell expected-gap, expected-ah, 0/no-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, 0/no-trace
check assertion, "F - test-macroexpand-inside-fn-call"
}
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, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
# 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
read-cell gap, result-ah, 0/no-trace
var dummy/eax: boolean <- macroexpand-iter result-ah, globals, 0/no-trace
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/ecx: (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/ecx: (addr handle cell) <- address expected-h
read-cell expected-gap, expected-ah, 0/no-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, 0/no-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, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
# 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
read-cell gap, result-ah, 0/no-trace
var dummy/eax: boolean <- macroexpand-iter result-ah, globals, 0/no-trace
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/ecx: (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/ecx: (addr handle cell) <- address expected-h
read-cell expected-gap, expected-ah, 0/no-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, 0/no-trace
check assertion, "F - test-macroexpand-inside-nested-backquote-unquote"
}
# TODO: unquote-splice, nested and unnested