2021-05-07 00:00:18 +00:00
|
|
|
fn macroexpand expr-ah: (addr handle cell), globals: (addr global-table), trace: (addr trace) {
|
2021-05-07 04:24:34 +00:00
|
|
|
# trace "macroexpand " expr-ah {{{
|
|
|
|
{
|
2021-05-20 03:56:37 +00:00
|
|
|
var should-trace?/eax: boolean <- should-trace? trace
|
|
|
|
compare should-trace?, 0/false
|
2021-05-07 04:24:34 +00:00
|
|
|
break-if-=
|
|
|
|
var stream-storage: (stream byte 0x200)
|
|
|
|
var stream/ecx: (addr stream byte) <- address stream-storage
|
|
|
|
write stream, "macroexpand "
|
2021-05-20 03:56:37 +00:00
|
|
|
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
|
2021-05-07 04:24:34 +00:00
|
|
|
trace trace, "mac", stream
|
|
|
|
}
|
|
|
|
# }}}
|
2021-05-31 17:19:38 +00:00
|
|
|
trace-lower trace
|
2021-08-02 01:26:35 +00:00
|
|
|
#? clear-screen 0
|
|
|
|
#? set-cursor-position 0, 0x20 0x20
|
2021-05-05 03:09:07 +00:00
|
|
|
# loop until convergence
|
2021-05-07 04:24:34 +00:00
|
|
|
{
|
2021-05-20 06:32:16 +00:00
|
|
|
var error?/eax: boolean <- has-errors? trace
|
|
|
|
compare error?, 0/false
|
|
|
|
break-if-!=
|
2021-05-07 04:24:34 +00:00
|
|
|
var expanded?/eax: boolean <- macroexpand-iter expr-ah, globals, trace
|
|
|
|
compare expanded?, 0/false
|
|
|
|
loop-if-!=
|
|
|
|
}
|
2021-05-31 17:19:38 +00:00
|
|
|
trace-higher trace
|
2021-05-07 04:24:34 +00:00
|
|
|
# trace "=> " expr-ah {{{
|
|
|
|
{
|
2021-05-20 03:56:37 +00:00
|
|
|
var should-trace?/eax: boolean <- should-trace? trace
|
|
|
|
compare should-trace?, 0/false
|
2021-05-07 04:24:34 +00:00
|
|
|
break-if-=
|
|
|
|
var stream-storage: (stream byte 0x200)
|
|
|
|
var stream/ecx: (addr stream byte) <- address stream-storage
|
|
|
|
write stream, "=> "
|
2021-05-20 03:56:37 +00:00
|
|
|
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
|
2021-05-07 04:24:34 +00:00
|
|
|
trace trace, "mac", stream
|
|
|
|
}
|
|
|
|
# }}}
|
2021-05-05 03:09:07 +00:00
|
|
|
}
|
|
|
|
|
2021-05-07 00:00:18 +00:00
|
|
|
# return true if we found any macros
|
|
|
|
fn macroexpand-iter _expr-ah: (addr handle cell), globals: (addr global-table), trace: (addr trace) -> _/eax: boolean {
|
2021-05-07 01:13:27 +00:00
|
|
|
var expr-ah/esi: (addr handle cell) <- copy _expr-ah
|
2021-08-02 01:26:35 +00:00
|
|
|
{
|
|
|
|
compare expr-ah, 0
|
|
|
|
break-if-!=
|
|
|
|
abort "macroexpand-iter: NULL expr-ah"
|
|
|
|
}
|
2021-05-07 04:24:34 +00:00
|
|
|
# trace "macroexpand-iter " expr {{{
|
|
|
|
{
|
2021-05-20 03:56:37 +00:00
|
|
|
var should-trace?/eax: boolean <- should-trace? trace
|
|
|
|
compare should-trace?, 0/false
|
2021-05-07 04:24:34 +00:00
|
|
|
break-if-=
|
|
|
|
var stream-storage: (stream byte 0x200)
|
|
|
|
var stream/ecx: (addr stream byte) <- address stream-storage
|
|
|
|
write stream, "macroexpand-iter "
|
2021-05-20 03:56:37 +00:00
|
|
|
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
|
2021-05-07 04:24:34 +00:00
|
|
|
trace trace, "mac", stream
|
|
|
|
}
|
|
|
|
# }}}
|
2021-05-19 02:51:58 +00:00
|
|
|
trace-lower trace
|
2021-08-02 01:26:35 +00:00
|
|
|
debug-print "a", 7/fg, 0/bg
|
2021-05-07 04:24:34 +00:00
|
|
|
# if expr is a non-pair, return
|
2021-05-07 01:13:27 +00:00
|
|
|
var expr/eax: (addr cell) <- lookup *expr-ah
|
2021-08-02 01:26:35 +00:00
|
|
|
{
|
|
|
|
compare expr, 0
|
|
|
|
break-if-!=
|
|
|
|
abort "macroexpand-iter: NULL expr"
|
|
|
|
}
|
2021-05-07 04:24:34 +00:00
|
|
|
{
|
|
|
|
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
|
|
|
|
}
|
2021-08-02 01:26:35 +00:00
|
|
|
debug-print "b", 7/fg, 0/bg
|
2021-05-07 01:13:27 +00:00
|
|
|
{
|
|
|
|
var expr-type/eax: (addr int) <- get expr, type
|
|
|
|
compare *expr-type, 0/pair
|
|
|
|
break-if-=
|
2021-05-07 04:24:34 +00:00
|
|
|
# non-pairs are literals
|
|
|
|
trace-text trace, "mac", "non-pair"
|
|
|
|
trace-higher trace
|
2021-05-07 01:13:27 +00:00
|
|
|
return 0/false
|
|
|
|
}
|
2021-08-02 01:26:35 +00:00
|
|
|
debug-print "c", 7/fg, 0/bg
|
2021-05-07 04:24:34 +00:00
|
|
|
# if expr is a literal pair, return
|
2021-05-07 01:13:27 +00:00
|
|
|
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
|
2021-05-07 04:24:34 +00:00
|
|
|
{
|
|
|
|
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
|
|
|
|
}
|
2021-08-02 01:26:35 +00:00
|
|
|
debug-print "d", 7/fg, 0/bg
|
2021-05-07 04:24:34 +00:00
|
|
|
{
|
|
|
|
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
|
|
|
|
}
|
2021-08-02 01:26:35 +00:00
|
|
|
debug-print "e", 7/fg, 0/bg
|
2021-07-29 06:28:29 +00:00
|
|
|
{
|
|
|
|
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
|
|
|
|
}
|
2021-08-02 01:26:35 +00:00
|
|
|
debug-print "f", 7/fg, 0/bg
|
2021-05-07 04:24:34 +00:00
|
|
|
var result/edi: boolean <- copy 0/false
|
|
|
|
# for each builtin, expand only what will later be evaluated
|
2021-05-07 05:09:30 +00:00
|
|
|
$macroexpand-iter:anonymous-function: {
|
2021-05-07 04:24:34 +00:00
|
|
|
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?
|
2021-05-20 06:32:16 +00:00
|
|
|
{
|
|
|
|
var error?/eax: boolean <- has-errors? trace
|
|
|
|
compare error?, 0/false
|
|
|
|
break-if-=
|
|
|
|
trace-higher trace
|
|
|
|
return result
|
|
|
|
}
|
2021-05-07 04:24:34 +00:00
|
|
|
loop
|
|
|
|
}
|
|
|
|
trace-higher trace
|
2021-05-31 04:52:31 +00:00
|
|
|
# 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
|
|
|
|
}
|
|
|
|
# }}}
|
2021-05-07 04:24:34 +00:00
|
|
|
return result
|
|
|
|
}
|
2021-08-02 01:26:35 +00:00
|
|
|
debug-print "g", 7/fg, 0/bg
|
2021-05-07 04:41:03 +00:00
|
|
|
# builtins with "special" evaluation rules
|
2021-05-07 05:09:30 +00:00
|
|
|
$macroexpand-iter:quote: {
|
2021-05-07 04:41:03 +00:00
|
|
|
# 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
|
|
|
|
}
|
2021-08-02 01:26:35 +00:00
|
|
|
debug-print "h", 7/fg, 0/bg
|
2021-05-07 16:22:54 +00:00
|
|
|
$macroexpand-iter:backquote: {
|
|
|
|
# nested backquote not supported for now
|
|
|
|
var backquote?/eax: boolean <- symbol-equal? first, "`"
|
|
|
|
compare backquote?, 0/false
|
|
|
|
break-if-=
|
|
|
|
#
|
2021-05-31 15:09:19 +00:00
|
|
|
#? set-cursor-position 0/screen, 0x40/x 0x10/y
|
|
|
|
#? dump-cell-from-cursor-over-full-screen rest-ah
|
2021-05-31 14:29:33 +00:00
|
|
|
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"
|
|
|
|
}
|
2021-05-07 16:22:54 +00:00
|
|
|
trace-higher trace
|
|
|
|
return 0/false
|
|
|
|
}
|
2021-08-02 01:26:35 +00:00
|
|
|
$macroexpand-iter:unquote: {
|
|
|
|
# nested backquote not supported for now
|
|
|
|
var unquote?/eax: boolean <- symbol-equal? first, ","
|
|
|
|
compare unquote?, 0/false
|
|
|
|
break-if-=
|
|
|
|
error trace, "unquote (,) must be within backquote (`)"
|
|
|
|
return 0/false
|
|
|
|
}
|
|
|
|
$macroexpand-iter:unquote-splice: {
|
|
|
|
# nested backquote not supported for now
|
|
|
|
var unquote-splice?/eax: boolean <- symbol-equal? first, ",@"
|
|
|
|
compare unquote-splice?, 0/false
|
|
|
|
break-if-=
|
|
|
|
error trace, "unquote (,@) must be within backquote (`)"
|
|
|
|
return 0/false
|
|
|
|
}
|
|
|
|
debug-print "i", 7/fg, 0/bg
|
2021-06-04 23:07:07 +00:00
|
|
|
$macroexpand-iter:define: {
|
|
|
|
# trees starting with "define" define globals
|
|
|
|
var define?/eax: boolean <- symbol-equal? first, "define"
|
|
|
|
compare define?, 0/false
|
2021-05-07 04:41:03 +00:00
|
|
|
break-if-=
|
|
|
|
#
|
2021-06-04 23:07:07 +00:00
|
|
|
trace-text trace, "mac", "define"
|
2021-05-07 04:41:03 +00:00
|
|
|
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
|
2021-06-04 23:07:07 +00:00
|
|
|
# trace "define=> " _expr-ah {{{
|
2021-05-31 04:52:31 +00:00
|
|
|
{
|
|
|
|
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
|
2021-06-04 23:07:07 +00:00
|
|
|
write stream, "define=> "
|
2021-05-31 04:52:31 +00:00
|
|
|
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
|
|
|
|
}
|
|
|
|
# }}}
|
2021-05-07 04:41:03 +00:00
|
|
|
return macro-found?
|
|
|
|
}
|
2021-08-02 01:26:35 +00:00
|
|
|
debug-print "j", 7/fg, 0/bg
|
2021-05-07 05:09:30 +00:00
|
|
|
$macroexpand-iter:set: {
|
2021-05-07 04:41:03 +00:00
|
|
|
# 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
|
2021-05-31 04:52:31 +00:00
|
|
|
# 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
|
|
|
|
}
|
|
|
|
# }}}
|
2021-05-07 04:41:03 +00:00
|
|
|
return macro-found?
|
|
|
|
}
|
2021-08-02 01:26:35 +00:00
|
|
|
debug-print "k", 7/fg, 0/bg
|
2021-05-07 04:41:03 +00:00
|
|
|
# '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
|
2021-05-07 04:24:34 +00:00
|
|
|
# if car(expr) is a symbol defined as a macro, expand it
|
2021-05-07 01:13:27 +00:00
|
|
|
{
|
2021-05-07 05:09:30 +00:00
|
|
|
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
|
2021-05-07 01:13:27 +00:00
|
|
|
break-if-=
|
2021-05-07 05:09:30 +00:00
|
|
|
# definition found
|
|
|
|
{
|
|
|
|
var definition-type/eax: (addr int) <- get definition, type
|
|
|
|
compare *definition-type, 0/pair
|
|
|
|
}
|
|
|
|
break-if-!=
|
|
|
|
# definition is a pair
|
2021-05-07 04:41:03 +00:00
|
|
|
{
|
|
|
|
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
|
2021-05-08 03:40:42 +00:00
|
|
|
#? turn-on-debug-print
|
2021-06-13 04:11:22 +00:00
|
|
|
apply macro-definition-ah, rest-ah, expr-ah, globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number
|
2021-05-19 02:51:58 +00:00
|
|
|
trace-higher trace
|
2021-05-31 04:52:31 +00:00
|
|
|
# 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
|
|
|
|
}
|
|
|
|
# }}}
|
2021-05-07 05:09:30 +00:00
|
|
|
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: {
|
2021-08-02 01:26:35 +00:00
|
|
|
debug-print "l", 7/fg, 0/bg
|
2021-05-07 05:09:30 +00:00
|
|
|
#? clear-screen 0/screen
|
|
|
|
#? dump-trace trace
|
2021-08-02 01:26:35 +00:00
|
|
|
{
|
|
|
|
var foo/eax: (addr cell) <- lookup *curr-ah
|
|
|
|
compare foo, 0
|
|
|
|
break-if-!=
|
|
|
|
abort "macroexpand-iter: NULL in loop"
|
|
|
|
}
|
2021-05-07 05:09:30 +00:00
|
|
|
var macro-found?/eax: boolean <- macroexpand-iter curr-ah, globals, trace
|
|
|
|
result <- or macro-found?
|
2021-05-20 06:32:16 +00:00
|
|
|
var error?/eax: boolean <- has-errors? trace
|
|
|
|
compare error?, 0/false
|
|
|
|
break-if-!=
|
2021-05-07 05:09:30 +00:00
|
|
|
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
|
2021-05-07 01:13:27 +00:00
|
|
|
}
|
2021-05-19 02:51:58 +00:00
|
|
|
trace-higher trace
|
2021-05-31 04:52:31 +00:00
|
|
|
# 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
|
|
|
|
}
|
|
|
|
# }}}
|
2021-05-07 04:41:03 +00:00
|
|
|
return result
|
2021-05-05 02:49:11 +00:00
|
|
|
}
|
2021-05-07 04:24:34 +00:00
|
|
|
|
2021-05-31 14:29:33 +00:00
|
|
|
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
|
|
|
|
}
|
2021-05-31 15:09:19 +00:00
|
|
|
# if cdr is not a pair, break
|
2021-05-31 14:29:33 +00:00
|
|
|
var cdr/eax: (addr cell) <- lookup *cdr-ah
|
2021-05-31 15:09:19 +00:00
|
|
|
var cdr-type/ecx: (addr int) <- get cdr, type
|
|
|
|
compare *cdr-type, 0/pair
|
|
|
|
break-if-!=
|
|
|
|
# if cadr is not an unquote, break
|
2021-05-31 14:29:33 +00:00
|
|
|
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
|
|
|
|
}
|
|
|
|
|
2021-05-07 04:24:34 +00:00
|
|
|
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
|
2021-06-04 23:07:07 +00:00
|
|
|
initialize-sandbox-with sandbox, "(define m (litmac litfn () (a b) `(+ ,a ,b)))"
|
2021-06-13 04:11:22 +00:00
|
|
|
edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk
|
2021-05-07 04:24:34 +00:00
|
|
|
# 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
|
2021-05-31 14:24:51 +00:00
|
|
|
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"
|
2021-06-23 06:39:54 +00:00
|
|
|
#? dump-cell-from-cursor-over-full-screen result-ah, 4/fg 0/bg
|
2021-05-07 04:24:34 +00:00
|
|
|
var _result/eax: (addr cell) <- lookup *result-ah
|
|
|
|
var result/edi: (addr cell) <- copy _result
|
|
|
|
# expected
|
|
|
|
initialize-sandbox-with sandbox, "(+ 3 4)"
|
2021-05-20 03:56:37 +00:00
|
|
|
var expected-gap-ah/edx: (addr handle gap-buffer) <- get sandbox, data
|
2021-05-07 04:24:34 +00:00
|
|
|
var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
|
|
|
|
var expected-h: (handle cell)
|
2021-05-20 03:56:37 +00:00
|
|
|
var expected-ah/edx: (addr handle cell) <- address expected-h
|
2021-05-31 14:24:51 +00:00
|
|
|
read-cell expected-gap, expected-ah, trace
|
2021-05-07 04:24:34 +00:00
|
|
|
#? dump-cell-from-cursor-over-full-screen expected-ah
|
|
|
|
var expected/eax: (addr cell) <- lookup *expected-ah
|
|
|
|
#
|
2021-05-31 14:24:51 +00:00
|
|
|
var assertion/eax: boolean <- cell-isomorphic? result, expected, trace
|
2021-05-07 04:24:34 +00:00
|
|
|
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
|
2021-06-04 23:07:07 +00:00
|
|
|
initialize-sandbox-with sandbox, "(define m (litmac litfn () (a b) `(+ ,a ,b)))"
|
2021-06-13 04:11:22 +00:00
|
|
|
edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk
|
2021-05-07 04:24:34 +00:00
|
|
|
# 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
|
2021-05-31 14:24:51 +00:00
|
|
|
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"
|
2021-05-07 04:24:34 +00:00
|
|
|
#? 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))"
|
2021-05-20 03:56:37 +00:00
|
|
|
var expected-gap-ah/edx: (addr handle gap-buffer) <- get sandbox, data
|
2021-05-07 04:24:34 +00:00
|
|
|
var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
|
|
|
|
var expected-h: (handle cell)
|
2021-05-20 03:56:37 +00:00
|
|
|
var expected-ah/edx: (addr handle cell) <- address expected-h
|
2021-05-31 14:24:51 +00:00
|
|
|
read-cell expected-gap, expected-ah, trace
|
2021-05-07 04:24:34 +00:00
|
|
|
var expected/eax: (addr cell) <- lookup *expected-ah
|
|
|
|
#
|
2021-05-31 14:24:51 +00:00
|
|
|
var assertion/eax: boolean <- cell-isomorphic? result, expected, trace
|
2021-05-07 04:24:34 +00:00
|
|
|
check assertion, "F - test-macroexpand-inside-anonymous-fn"
|
|
|
|
}
|
2021-05-07 05:09:30 +00:00
|
|
|
|
|
|
|
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
|
2021-06-04 23:07:07 +00:00
|
|
|
initialize-sandbox-with sandbox, "(define m (litmac litfn () (a b) `(+ ,a ,b)))"
|
2021-06-13 04:11:22 +00:00
|
|
|
edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk
|
2021-05-07 05:09:30 +00:00
|
|
|
# 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
|
2021-05-31 14:24:51 +00:00
|
|
|
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"
|
2021-05-07 05:09:30 +00:00
|
|
|
#? 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)))"
|
2021-05-20 03:56:37 +00:00
|
|
|
var expected-gap-ah/edx: (addr handle gap-buffer) <- get sandbox, data
|
2021-05-07 05:09:30 +00:00
|
|
|
var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
|
|
|
|
var expected-h: (handle cell)
|
2021-05-20 03:56:37 +00:00
|
|
|
var expected-ah/edx: (addr handle cell) <- address expected-h
|
2021-05-31 14:24:51 +00:00
|
|
|
read-cell expected-gap, expected-ah, trace
|
2021-05-07 05:09:30 +00:00
|
|
|
#? dump-cell-from-cursor-over-full-screen expected-ah
|
|
|
|
var expected/eax: (addr cell) <- lookup *expected-ah
|
|
|
|
#
|
2021-05-31 14:24:51 +00:00
|
|
|
var assertion/eax: boolean <- cell-isomorphic? result, expected, trace
|
2021-05-07 05:09:30 +00:00
|
|
|
check assertion, "F - test-macroexpand-inside-fn-call"
|
|
|
|
}
|
2021-05-07 16:22:54 +00:00
|
|
|
|
2021-05-31 14:29:33 +00:00
|
|
|
fn test-macroexpand-repeatedly-with-backquoted-arg {
|
|
|
|
var globals-storage: global-table
|
|
|
|
var globals/edx: (addr global-table) <- address globals-storage
|
|
|
|
initialize-globals globals
|
2021-05-31 15:01:09 +00:00
|
|
|
# macroexpand an expression with a backquote but no macro
|
2021-05-31 14:29:33 +00:00
|
|
|
var sandbox-storage: sandbox
|
|
|
|
var sandbox/esi: (addr sandbox) <- address sandbox-storage
|
2021-05-31 15:01:09 +00:00
|
|
|
initialize-sandbox-with sandbox, "(cons 1 `(3))"
|
2021-05-31 14:29:33 +00:00
|
|
|
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
|
2021-05-31 15:01:09 +00:00
|
|
|
check-not error?, "F - test-macroexpand-repeatedly-with-backquoted-arg"
|
2021-05-31 14:29:33 +00:00
|
|
|
{
|
|
|
|
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
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2021-05-07 16:22:54 +00:00
|
|
|
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
|
2021-06-04 23:07:07 +00:00
|
|
|
initialize-sandbox-with sandbox, "(define m (litmac litfn () (a b) `(+ ,a ,b)))"
|
2021-06-13 04:11:22 +00:00
|
|
|
edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk
|
2021-05-07 16:22:54 +00:00
|
|
|
# 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
|
2021-05-31 14:24:51 +00:00
|
|
|
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
|
2021-05-07 16:22:54 +00:00
|
|
|
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)))"
|
2021-05-20 03:56:37 +00:00
|
|
|
var expected-gap-ah/edx: (addr handle gap-buffer) <- get sandbox, data
|
2021-05-07 16:22:54 +00:00
|
|
|
var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
|
|
|
|
var expected-h: (handle cell)
|
2021-05-20 03:56:37 +00:00
|
|
|
var expected-ah/edx: (addr handle cell) <- address expected-h
|
2021-05-31 14:24:51 +00:00
|
|
|
read-cell expected-gap, expected-ah, trace
|
2021-05-07 16:22:54 +00:00
|
|
|
var expected/eax: (addr cell) <- lookup *expected-ah
|
|
|
|
#
|
2021-05-31 14:24:51 +00:00
|
|
|
var assertion/eax: boolean <- cell-isomorphic? result, expected, trace
|
2021-05-07 16:22:54 +00:00
|
|
|
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
|
2021-06-04 23:07:07 +00:00
|
|
|
initialize-sandbox-with sandbox, "(define m (litmac litfn () (a b) `(+ ,a ,b)))"
|
2021-06-13 04:11:22 +00:00
|
|
|
edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk
|
2021-05-07 16:22:54 +00:00
|
|
|
# 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
|
2021-05-31 14:24:51 +00:00
|
|
|
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"
|
snapshot: infix
Like parenthesize, I'm copying tests over from https://github.com/akkartik/wart
Unlike parenthesize, though, I can't just transliterate the code itself.
Wart was operating on an intermediate AST representation. Here I'm all
the way down to cells. That seemed like a good idea when I embarked, but
now I'm not so sure. Operating with the right AST data structure allowed
me to more easily iterate over the elements of a list. The natural recursion
for cells is not a good fit.
This patch and the next couple is an interesting case study in what makes
Unix so effective. Yes, you have to play computer, and yes it gets verbose
and ugly. But just diff and patch go surprisingly far in helping build a
picture of the state space in my brain.
Then again, there's a steep gradient of skills here. There are people who
can visualize state spaces using diff and patch far better than me, and
people who can't do it as well as me. Nature, nurture, having different
priorities, whatever the reason. Giving some people just the right crutch
excludes others.
2021-06-23 04:20:45 +00:00
|
|
|
#? dump-cell-from-cursor-over-full-screen result-ah
|
2021-05-07 16:22:54 +00:00
|
|
|
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)))"
|
2021-05-20 03:56:37 +00:00
|
|
|
var expected-gap-ah/edx: (addr handle gap-buffer) <- get sandbox, data
|
2021-05-07 16:22:54 +00:00
|
|
|
var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
|
|
|
|
var expected-h: (handle cell)
|
2021-05-20 03:56:37 +00:00
|
|
|
var expected-ah/edx: (addr handle cell) <- address expected-h
|
2021-05-31 14:24:51 +00:00
|
|
|
read-cell expected-gap, expected-ah, trace
|
snapshot: infix
Like parenthesize, I'm copying tests over from https://github.com/akkartik/wart
Unlike parenthesize, though, I can't just transliterate the code itself.
Wart was operating on an intermediate AST representation. Here I'm all
the way down to cells. That seemed like a good idea when I embarked, but
now I'm not so sure. Operating with the right AST data structure allowed
me to more easily iterate over the elements of a list. The natural recursion
for cells is not a good fit.
This patch and the next couple is an interesting case study in what makes
Unix so effective. Yes, you have to play computer, and yes it gets verbose
and ugly. But just diff and patch go surprisingly far in helping build a
picture of the state space in my brain.
Then again, there's a steep gradient of skills here. There are people who
can visualize state spaces using diff and patch far better than me, and
people who can't do it as well as me. Nature, nurture, having different
priorities, whatever the reason. Giving some people just the right crutch
excludes others.
2021-06-23 04:20:45 +00:00
|
|
|
#? dump-cell-from-cursor-over-full-screen expected-ah
|
2021-05-07 16:22:54 +00:00
|
|
|
var expected/eax: (addr cell) <- lookup *expected-ah
|
|
|
|
#
|
2021-05-31 14:24:51 +00:00
|
|
|
var assertion/eax: boolean <- cell-isomorphic? result, expected, trace
|
2021-05-07 16:22:54 +00:00
|
|
|
check assertion, "F - test-macroexpand-inside-nested-backquote-unquote"
|
|
|
|
}
|
|
|
|
|
|
|
|
# TODO: unquote-splice, nested and unnested
|