2021-03-05 07:08:44 +00:00
|
|
|
# env is an alist of ((sym . val) (sym . val) ...)
|
|
|
|
fn evaluate _in: (addr handle cell), out: (addr handle cell), env: (addr cell), trace: (addr trace) {
|
2021-03-05 05:24:48 +00:00
|
|
|
trace-text trace, "eval", "evaluate"
|
|
|
|
trace-lower trace
|
|
|
|
var in/eax: (addr handle cell) <- copy _in
|
|
|
|
var in-addr/eax: (addr cell) <- lookup *in
|
|
|
|
{
|
|
|
|
var is-nil?/eax: boolean <- is-nil? in-addr
|
|
|
|
compare is-nil?, 0/false
|
|
|
|
break-if-=
|
|
|
|
# nil is a literal
|
2021-03-07 07:03:23 +00:00
|
|
|
trace-text trace, "eval", "nil"
|
2021-03-05 05:24:48 +00:00
|
|
|
copy-object _in, out
|
|
|
|
trace-higher trace
|
|
|
|
return
|
|
|
|
}
|
|
|
|
var in-type/ecx: (addr int) <- get in-addr, type
|
|
|
|
compare *in-type, 1/number
|
|
|
|
{
|
|
|
|
break-if-!=
|
|
|
|
# numbers are literals
|
2021-03-07 07:03:23 +00:00
|
|
|
trace-text trace, "eval", "number"
|
2021-03-05 05:24:48 +00:00
|
|
|
copy-object _in, out
|
|
|
|
trace-higher trace
|
|
|
|
return
|
|
|
|
}
|
2021-03-05 07:08:44 +00:00
|
|
|
compare *in-type, 2/symbol
|
|
|
|
{
|
|
|
|
break-if-!=
|
2021-03-07 07:03:23 +00:00
|
|
|
trace-text trace, "eval", "symbol"
|
2021-03-05 07:08:44 +00:00
|
|
|
lookup-symbol in-addr, out, env, trace
|
|
|
|
trace-higher trace
|
|
|
|
return
|
|
|
|
}
|
2021-03-07 07:03:23 +00:00
|
|
|
# in-addr is a syntax tree
|
|
|
|
$evaluate:anonymous-function: {
|
|
|
|
# trees starting with "fn" are anonymous functions and therefore literals
|
|
|
|
var expr/esi: (addr cell) <- copy in-addr
|
|
|
|
# if its first elem is not "fn", break
|
|
|
|
var first-ah/ecx: (addr handle cell) <- get in-addr, left
|
|
|
|
var first/eax: (addr cell) <- lookup *first-ah
|
|
|
|
var is-fn?/eax: boolean <- is-fn? first
|
|
|
|
compare is-fn?, 0/false
|
|
|
|
break-if-=
|
|
|
|
#
|
|
|
|
trace-text trace, "eval", "anonymous function"
|
|
|
|
copy-object _in, out
|
|
|
|
trace-higher trace
|
|
|
|
return
|
|
|
|
}
|
2021-03-05 23:18:46 +00:00
|
|
|
trace-text trace, "eval", "function call"
|
|
|
|
trace-text trace, "eval", "evaluating list elements"
|
|
|
|
var evaluated-list-storage: (handle cell)
|
|
|
|
var evaluated-list-ah/esi: (addr handle cell) <- address evaluated-list-storage
|
|
|
|
var curr-out-ah/edx: (addr handle cell) <- copy evaluated-list-ah
|
|
|
|
var curr/ecx: (addr cell) <- copy in-addr
|
|
|
|
$evaluate-list:loop: {
|
|
|
|
allocate-pair curr-out-ah
|
|
|
|
var is-nil?/eax: boolean <- is-nil? curr
|
|
|
|
compare is-nil?, 0/false
|
|
|
|
break-if-!=
|
|
|
|
# eval left
|
|
|
|
var curr-out/eax: (addr cell) <- lookup *curr-out-ah
|
|
|
|
var left-out-ah/edi: (addr handle cell) <- get curr-out, left
|
|
|
|
var left-ah/esi: (addr handle cell) <- get curr, left
|
|
|
|
evaluate left-ah, left-out-ah, env, trace
|
|
|
|
#
|
|
|
|
curr-out-ah <- get curr-out, right
|
|
|
|
var right-ah/eax: (addr handle cell) <- get curr, right
|
|
|
|
var right/eax: (addr cell) <- lookup *right-ah
|
|
|
|
curr <- copy right
|
|
|
|
loop
|
|
|
|
}
|
|
|
|
trace-text trace, "eval", "apply"
|
|
|
|
var evaluated-list/eax: (addr cell) <- lookup *evaluated-list-ah
|
|
|
|
var function-ah/ecx: (addr handle cell) <- get evaluated-list, left
|
|
|
|
var args-ah/edx: (addr handle cell) <- get evaluated-list, right
|
|
|
|
#? dump-cell args-ah
|
|
|
|
#? abort "aaa"
|
|
|
|
apply function-ah, args-ah, out, env, trace
|
|
|
|
}
|
|
|
|
|
|
|
|
fn apply _f-ah: (addr handle cell), args-ah: (addr handle cell), out: (addr handle cell), env: (addr cell), trace: (addr trace) {
|
|
|
|
var f-ah/eax: (addr handle cell) <- copy _f-ah
|
2021-03-07 07:15:27 +00:00
|
|
|
var _f/eax: (addr cell) <- lookup *f-ah
|
|
|
|
var f/esi: (addr cell) <- copy _f
|
|
|
|
# call primitive functions
|
2021-03-05 23:18:46 +00:00
|
|
|
{
|
2021-03-07 07:15:27 +00:00
|
|
|
var f-type/eax: (addr int) <- get f, type
|
2021-03-05 23:18:46 +00:00
|
|
|
compare *f-type, 4/primitive-function
|
|
|
|
break-if-!=
|
|
|
|
apply-primitive f, args-ah, out, env, trace
|
|
|
|
return
|
|
|
|
}
|
2021-03-07 07:15:27 +00:00
|
|
|
# if it's not a primitive function it must be an anonymous function
|
|
|
|
{
|
|
|
|
var f-type/ecx: (addr int) <- get f, type
|
|
|
|
compare *f-type, 0/pair
|
|
|
|
break-if-!=
|
|
|
|
var first-ah/eax: (addr handle cell) <- get f, left
|
|
|
|
var first/eax: (addr cell) <- lookup *first-ah
|
|
|
|
var is-fn?/eax: boolean <- is-fn? first
|
|
|
|
compare is-fn?, 0/false
|
|
|
|
break-if-=
|
|
|
|
trace-text trace, "eval", "apply anonymous function"
|
|
|
|
var rest-ah/esi: (addr handle cell) <- get f, right
|
|
|
|
var rest/eax: (addr cell) <- lookup *rest-ah
|
|
|
|
var params-ah/ecx: (addr handle cell) <- get rest, left
|
|
|
|
var body-ah/eax: (addr handle cell) <- get rest, right
|
|
|
|
apply-function params-ah, args-ah, body-ah, out, env, trace
|
|
|
|
return
|
|
|
|
}
|
2021-03-07 07:03:23 +00:00
|
|
|
error trace, "unknown function"
|
2021-03-05 23:18:46 +00:00
|
|
|
}
|
|
|
|
|
2021-03-07 07:15:27 +00:00
|
|
|
fn apply-function _params-ah: (addr handle cell), _args-ah: (addr handle cell), _body-ah: (addr handle cell), out: (addr handle cell), env: (addr cell), trace: (addr trace) {
|
|
|
|
}
|
|
|
|
|
2021-03-05 23:18:46 +00:00
|
|
|
fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr handle cell), env: (addr cell), trace: (addr trace) {
|
|
|
|
var f/esi: (addr cell) <- copy _f
|
|
|
|
var f-index/eax: (addr int) <- get f, index-data
|
|
|
|
{
|
|
|
|
compare *f-index, 1/add
|
|
|
|
break-if-!=
|
|
|
|
apply-add args-ah, out, env, trace
|
|
|
|
return
|
|
|
|
}
|
|
|
|
abort "unknown primitive function"
|
|
|
|
}
|
|
|
|
|
|
|
|
fn apply-add _args-ah: (addr handle cell), out: (addr handle cell), env: (addr cell), trace: (addr trace) {
|
|
|
|
var args-ah/eax: (addr handle cell) <- copy _args-ah
|
|
|
|
var _args/eax: (addr cell) <- lookup *args-ah
|
|
|
|
var args/esi: (addr cell) <- copy _args
|
|
|
|
# TODO: check that args is a pair
|
|
|
|
var empty-args?/eax: boolean <- is-nil? args
|
|
|
|
compare empty-args?, 0/false
|
|
|
|
{
|
|
|
|
break-if-=
|
|
|
|
error trace, "+ needs 2 args but got 0"
|
|
|
|
return
|
|
|
|
}
|
|
|
|
# args->left->value
|
|
|
|
var first-ah/eax: (addr handle cell) <- get args, left
|
|
|
|
var first/eax: (addr cell) <- lookup *first-ah
|
|
|
|
var first-type/ecx: (addr int) <- get first, type
|
|
|
|
compare *first-type, 1/number
|
|
|
|
{
|
|
|
|
break-if-=
|
|
|
|
error trace, "first arg for + is not a number"
|
|
|
|
return
|
|
|
|
}
|
|
|
|
var first-value/ecx: (addr float) <- get first, number-data
|
|
|
|
# args->right->left->value
|
|
|
|
var right-ah/eax: (addr handle cell) <- get args, right
|
|
|
|
#? dump-cell right-ah
|
|
|
|
#? abort "aaa"
|
|
|
|
var right/eax: (addr cell) <- lookup *right-ah
|
|
|
|
# TODO: check that right is a pair
|
|
|
|
var second-ah/eax: (addr handle cell) <- get right, left
|
|
|
|
var second/eax: (addr cell) <- lookup *second-ah
|
|
|
|
var second-type/edx: (addr int) <- get second, type
|
|
|
|
compare *second-type, 1/number
|
|
|
|
{
|
|
|
|
break-if-=
|
|
|
|
error trace, "second arg for + is not a number"
|
|
|
|
return
|
|
|
|
}
|
|
|
|
var second-value/edx: (addr float) <- get second, number-data
|
|
|
|
# add
|
|
|
|
var result/xmm0: float <- copy *first-value
|
|
|
|
result <- add *second-value
|
|
|
|
new-float out, result
|
2021-03-05 05:24:48 +00:00
|
|
|
}
|
2021-03-05 07:08:44 +00:00
|
|
|
|
|
|
|
fn lookup-symbol sym: (addr cell), out: (addr handle cell), _env: (addr cell), trace: (addr trace) {
|
|
|
|
# trace sym
|
|
|
|
{
|
|
|
|
var stream-storage: (stream byte 0x40)
|
|
|
|
var stream/ecx: (addr stream byte) <- address stream-storage
|
|
|
|
write stream, "lookup "
|
|
|
|
var sym2/eax: (addr cell) <- copy sym
|
|
|
|
var sym-data-ah/eax: (addr handle stream byte) <- get sym2, text-data
|
|
|
|
var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah
|
|
|
|
rewind-stream sym-data
|
|
|
|
write-stream stream, sym-data
|
|
|
|
trace trace, "eval", stream
|
|
|
|
}
|
|
|
|
trace-lower trace
|
|
|
|
var env/ebx: (addr cell) <- copy _env
|
|
|
|
# if env is not a list, abort
|
|
|
|
{
|
|
|
|
var env-type/ecx: (addr int) <- get env, type
|
|
|
|
compare *env-type, 0/pair
|
|
|
|
break-if-=
|
|
|
|
error trace, "eval found a non-list environment"
|
|
|
|
trace-higher trace
|
|
|
|
return
|
|
|
|
}
|
2021-03-05 17:27:15 +00:00
|
|
|
# if env is nil, look up in globals
|
2021-03-05 07:08:44 +00:00
|
|
|
{
|
|
|
|
var env-is-nil?/eax: boolean <- is-nil? env
|
|
|
|
compare env-is-nil?, 0/false
|
|
|
|
break-if-=
|
2021-03-05 17:27:15 +00:00
|
|
|
lookup-symbol-in-hardcoded-globals sym, out, trace
|
2021-03-05 07:08:44 +00:00
|
|
|
trace-higher trace
|
|
|
|
return
|
|
|
|
}
|
|
|
|
# check car
|
|
|
|
var env-head-storage: (handle cell)
|
|
|
|
var env-head-ah/eax: (addr handle cell) <- address env-head-storage
|
|
|
|
car env, env-head-ah, trace
|
|
|
|
var _env-head/eax: (addr cell) <- lookup *env-head-ah
|
|
|
|
var env-head/ecx: (addr cell) <- copy _env-head
|
|
|
|
# if car is not a list, abort
|
|
|
|
{
|
|
|
|
var env-head-type/eax: (addr int) <- get env-head, type
|
|
|
|
compare *env-head-type, 0/pair
|
|
|
|
break-if-=
|
|
|
|
error trace, "environment is not a list of (key . value) pairs"
|
|
|
|
trace-higher trace
|
|
|
|
return
|
|
|
|
}
|
|
|
|
# check key
|
|
|
|
var curr-key-storage: (handle cell)
|
|
|
|
var curr-key-ah/eax: (addr handle cell) <- address curr-key-storage
|
|
|
|
car env-head, curr-key-ah, trace
|
|
|
|
var curr-key/eax: (addr cell) <- lookup *curr-key-ah
|
|
|
|
# if key is not a symbol, abort
|
|
|
|
{
|
|
|
|
var curr-key-type/eax: (addr int) <- get curr-key, type
|
|
|
|
compare *curr-key-type, 2/symbol
|
|
|
|
break-if-=
|
|
|
|
error trace, "environment contains a binding for a non-symbol"
|
|
|
|
trace-higher trace
|
|
|
|
return
|
|
|
|
}
|
|
|
|
# if key matches sym, return val
|
|
|
|
var match?/eax: boolean <- cell-isomorphic? curr-key, sym, trace
|
|
|
|
compare match?, 0/false
|
|
|
|
{
|
|
|
|
break-if-=
|
|
|
|
cdr env-head, out, trace
|
|
|
|
trace-higher trace
|
|
|
|
return
|
|
|
|
}
|
|
|
|
# otherwise recurse
|
|
|
|
var env-tail-storage: (handle cell)
|
|
|
|
var env-tail-ah/eax: (addr handle cell) <- address env-tail-storage
|
|
|
|
cdr env, env-tail-ah, trace
|
|
|
|
var env-tail/eax: (addr cell) <- lookup *env-tail-ah
|
|
|
|
lookup-symbol sym, out, env-tail, trace
|
|
|
|
trace-higher trace
|
|
|
|
}
|
|
|
|
|
2021-03-05 17:27:15 +00:00
|
|
|
fn lookup-symbol-in-hardcoded-globals _sym: (addr cell), out: (addr handle cell), trace: (addr trace) {
|
|
|
|
var sym/eax: (addr cell) <- copy _sym
|
|
|
|
var sym-data-ah/eax: (addr handle stream byte) <- get sym, text-data
|
|
|
|
var _sym-data/eax: (addr stream byte) <- lookup *sym-data-ah
|
|
|
|
var sym-data/esi: (addr stream byte) <- copy _sym-data
|
|
|
|
{
|
2021-03-05 23:18:46 +00:00
|
|
|
var is-add?/eax: boolean <- stream-data-equal? sym-data, "+"
|
|
|
|
compare is-add?, 0/false
|
2021-03-05 17:27:15 +00:00
|
|
|
break-if-=
|
2021-03-05 23:18:46 +00:00
|
|
|
new-primitive-function out, 1/add
|
2021-03-05 17:27:15 +00:00
|
|
|
trace-text trace, "eval", "global +"
|
|
|
|
return
|
|
|
|
}
|
|
|
|
# otherwise error "unbound symbol: ", sym
|
|
|
|
var stream-storage: (stream byte 0x40)
|
|
|
|
var stream/ecx: (addr stream byte) <- address stream-storage
|
|
|
|
write stream, "unbound symbol: "
|
|
|
|
rewind-stream sym-data
|
|
|
|
write-stream stream, sym-data
|
|
|
|
trace trace, "error", stream
|
|
|
|
}
|
|
|
|
|
|
|
|
fn test-lookup-symbol-in-env {
|
|
|
|
# tmp = (a . 3)
|
|
|
|
var val-storage: (handle cell)
|
|
|
|
var val-ah/ecx: (addr handle cell) <- address val-storage
|
|
|
|
new-integer val-ah, 3
|
|
|
|
var key-storage: (handle cell)
|
|
|
|
var key-ah/edx: (addr handle cell) <- address key-storage
|
|
|
|
new-symbol key-ah, "a"
|
|
|
|
var tmp-storage: (handle cell)
|
|
|
|
var tmp-ah/ebx: (addr handle cell) <- address tmp-storage
|
|
|
|
new-pair tmp-ah, *key-ah, *val-ah
|
|
|
|
# env = ((a . 3))
|
|
|
|
var nil-storage: (handle cell)
|
|
|
|
var nil-ah/ecx: (addr handle cell) <- address nil-storage
|
|
|
|
allocate-pair nil-ah
|
|
|
|
new-pair tmp-ah, *tmp-ah, *nil-ah
|
|
|
|
var _env/eax: (addr cell) <- lookup *tmp-ah
|
|
|
|
var env/ecx: (addr cell) <- copy _env
|
|
|
|
# lookup sym(a), env
|
|
|
|
new-symbol tmp-ah, "a"
|
|
|
|
var in/eax: (addr cell) <- lookup *tmp-ah
|
|
|
|
lookup-symbol in, tmp-ah, env, 0/no-trace
|
|
|
|
var result/eax: (addr cell) <- lookup *tmp-ah
|
|
|
|
var result-type/edx: (addr int) <- get result, type
|
|
|
|
check-ints-equal *result-type, 1/number, "F - test-lookup-symbol-in-env/0"
|
|
|
|
var result-value-addr/eax: (addr float) <- get result, number-data
|
|
|
|
var result-value/eax: int <- convert *result-value-addr
|
|
|
|
check-ints-equal result-value, 3, "F - test-lookup-symbol-in-env/1"
|
|
|
|
}
|
|
|
|
|
|
|
|
fn test-lookup-symbol-in-hardcoded-globals {
|
|
|
|
# env = nil
|
|
|
|
var nil-storage: (handle cell)
|
|
|
|
var nil-ah/ecx: (addr handle cell) <- address nil-storage
|
|
|
|
allocate-pair nil-ah
|
|
|
|
var _env/eax: (addr cell) <- lookup *nil-ah
|
|
|
|
var env/ecx: (addr cell) <- copy _env
|
|
|
|
# lookup sym(a), env
|
|
|
|
var tmp-storage: (handle cell)
|
|
|
|
var tmp-ah/ebx: (addr handle cell) <- address tmp-storage
|
|
|
|
new-symbol tmp-ah, "+"
|
|
|
|
var in/eax: (addr cell) <- lookup *tmp-ah
|
|
|
|
lookup-symbol in, tmp-ah, env, 0/no-trace
|
|
|
|
var result/eax: (addr cell) <- lookup *tmp-ah
|
|
|
|
var result-type/edx: (addr int) <- get result, type
|
|
|
|
check-ints-equal *result-type, 4/primitive-function, "F - test-lookup-symbol-in-hardcoded-globals/0"
|
|
|
|
var result-value/eax: (addr int) <- get result, index-data
|
2021-03-05 23:18:46 +00:00
|
|
|
check-ints-equal *result-value, 1/add, "F - test-lookup-symbol-in-hardcoded-globals/1"
|
2021-03-05 17:27:15 +00:00
|
|
|
}
|
|
|
|
|
2021-03-05 07:08:44 +00:00
|
|
|
fn car _in: (addr cell), out: (addr handle cell), trace: (addr trace) {
|
|
|
|
trace-text trace, "eval", "car"
|
|
|
|
trace-lower trace
|
|
|
|
var in/eax: (addr cell) <- copy _in
|
|
|
|
# if in is not a list, abort
|
|
|
|
{
|
|
|
|
var in-type/ecx: (addr int) <- get in, type
|
|
|
|
compare *in-type, 0/pair
|
|
|
|
break-if-=
|
|
|
|
error trace, "car on a non-list"
|
|
|
|
trace-higher trace
|
|
|
|
return
|
|
|
|
}
|
|
|
|
# if in is nil, abort
|
|
|
|
{
|
|
|
|
var in-is-nil?/eax: boolean <- is-nil? in
|
|
|
|
compare in-is-nil?, 0/false
|
|
|
|
break-if-=
|
|
|
|
error trace, "car on nil"
|
|
|
|
trace-higher trace
|
|
|
|
return
|
|
|
|
}
|
|
|
|
var in-left/eax: (addr handle cell) <- get in, left
|
|
|
|
copy-object in-left, out
|
|
|
|
trace-higher trace
|
|
|
|
return
|
|
|
|
}
|
|
|
|
|
|
|
|
fn cdr _in: (addr cell), out: (addr handle cell), trace: (addr trace) {
|
|
|
|
trace-text trace, "eval", "cdr"
|
|
|
|
trace-lower trace
|
|
|
|
var in/eax: (addr cell) <- copy _in
|
|
|
|
# if in is not a list, abort
|
|
|
|
{
|
|
|
|
var in-type/ecx: (addr int) <- get in, type
|
|
|
|
compare *in-type, 0/pair
|
|
|
|
break-if-=
|
|
|
|
error trace, "car on a non-list"
|
|
|
|
trace-higher trace
|
|
|
|
return
|
|
|
|
}
|
|
|
|
# if in is nil, abort
|
|
|
|
{
|
|
|
|
var in-is-nil?/eax: boolean <- is-nil? in
|
|
|
|
compare in-is-nil?, 0/false
|
|
|
|
break-if-=
|
|
|
|
error trace, "car on nil"
|
|
|
|
trace-higher trace
|
|
|
|
return
|
|
|
|
}
|
|
|
|
var in-right/eax: (addr handle cell) <- get in, right
|
|
|
|
copy-object in-right, out
|
|
|
|
trace-higher trace
|
|
|
|
return
|
|
|
|
}
|
|
|
|
|
|
|
|
fn cell-isomorphic? _a: (addr cell), _b: (addr cell), trace: (addr trace) -> _/eax: boolean {
|
|
|
|
trace-text trace, "eval", "cell-isomorphic?"
|
|
|
|
trace-lower trace
|
|
|
|
var a/esi: (addr cell) <- copy _a
|
|
|
|
var b/edi: (addr cell) <- copy _b
|
|
|
|
# if types don't match, return false
|
|
|
|
var a-type-addr/eax: (addr int) <- get a, type
|
|
|
|
var b-type-addr/ecx: (addr int) <- get b, type
|
|
|
|
var b-type/ecx: int <- copy *b-type-addr
|
|
|
|
compare b-type, *a-type-addr
|
|
|
|
{
|
|
|
|
break-if-=
|
|
|
|
trace-text trace, "eval", "=> false (type)"
|
|
|
|
trace-higher trace
|
|
|
|
return 0/false
|
|
|
|
}
|
|
|
|
# if types are number, compare number-data
|
|
|
|
# TODO: exactly comparing floats is a bad idea
|
|
|
|
compare b-type, 1/number
|
|
|
|
{
|
|
|
|
break-if-!=
|
|
|
|
var a-val-addr/eax: (addr float) <- get a, number-data
|
|
|
|
var b-val-addr/ecx: (addr float) <- get b, number-data
|
|
|
|
var a-val/xmm0: float <- copy *a-val-addr
|
|
|
|
compare a-val, *b-val-addr
|
|
|
|
{
|
|
|
|
break-if-=
|
|
|
|
trace-text trace, "eval", "=> false (numbers)"
|
|
|
|
trace-higher trace
|
|
|
|
return 0/false
|
|
|
|
}
|
|
|
|
trace-text trace, "eval", "=> true (numbers)"
|
|
|
|
trace-higher trace
|
|
|
|
return 1/true
|
|
|
|
}
|
|
|
|
compare b-type, 2/symbol
|
|
|
|
{
|
|
|
|
break-if-!=
|
|
|
|
var b-val-ah/eax: (addr handle stream byte) <- get b, text-data
|
|
|
|
var _b-val/eax: (addr stream byte) <- lookup *b-val-ah
|
|
|
|
var b-val/ecx: (addr stream byte) <- copy _b-val
|
|
|
|
var a-val-ah/eax: (addr handle stream byte) <- get a, text-data
|
|
|
|
var a-val/eax: (addr stream byte) <- lookup *a-val-ah
|
|
|
|
var tmp-array: (handle array byte)
|
|
|
|
var tmp-ah/edx: (addr handle array byte) <- address tmp-array
|
|
|
|
stream-to-array a-val, tmp-ah
|
|
|
|
var tmp/eax: (addr array byte) <- lookup *tmp-ah
|
|
|
|
var match?/eax: boolean <- stream-data-equal? b-val, tmp
|
|
|
|
trace-text trace, "eval", "=> ? (symbols)"
|
|
|
|
trace-higher trace
|
|
|
|
return match?
|
|
|
|
}
|
|
|
|
# if a is nil, b should be nil
|
|
|
|
{
|
|
|
|
# (assumes is-nil? returns 0 or 1)
|
|
|
|
var _b-is-nil?/eax: boolean <- is-nil? b
|
|
|
|
var b-is-nil?/ecx: boolean <- copy _b-is-nil?
|
|
|
|
var a-is-nil?/eax: boolean <- is-nil? a
|
|
|
|
# a == nil and b == nil => return true
|
|
|
|
{
|
|
|
|
compare a-is-nil?, 0/false
|
|
|
|
break-if-=
|
|
|
|
compare b-is-nil?, 0/false
|
|
|
|
break-if-=
|
|
|
|
trace-text trace, "eval", "=> true (nils)"
|
|
|
|
trace-higher trace
|
|
|
|
return 1/true
|
|
|
|
}
|
|
|
|
# a == nil => return false
|
|
|
|
{
|
|
|
|
compare a-is-nil?, 0/false
|
|
|
|
break-if-=
|
|
|
|
trace-text trace, "eval", "=> false (b != nil)"
|
|
|
|
trace-higher trace
|
|
|
|
return 0/false
|
|
|
|
}
|
|
|
|
# b == nil => return false
|
|
|
|
{
|
|
|
|
compare b-is-nil?, 0/false
|
|
|
|
break-if-=
|
|
|
|
trace-text trace, "eval", "=> false (a != nil)"
|
|
|
|
trace-higher trace
|
|
|
|
return 0/false
|
|
|
|
}
|
|
|
|
}
|
|
|
|
# a and b are pairs
|
|
|
|
var a-tmp-storage: (handle cell)
|
|
|
|
var a-tmp-ah/edx: (addr handle cell) <- address a-tmp-storage
|
|
|
|
var b-tmp-storage: (handle cell)
|
|
|
|
var b-tmp-ah/ebx: (addr handle cell) <- address b-tmp-storage
|
|
|
|
# if cars aren't equal, return false
|
|
|
|
car a, a-tmp-ah, trace
|
|
|
|
car b, b-tmp-ah, trace
|
|
|
|
{
|
|
|
|
var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah
|
|
|
|
var a-tmp/ecx: (addr cell) <- copy _a-tmp
|
|
|
|
var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah
|
|
|
|
var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace
|
|
|
|
compare result, 0/false
|
|
|
|
break-if-!=
|
|
|
|
return 0/false
|
|
|
|
}
|
|
|
|
# recurse on cdrs
|
|
|
|
cdr a, a-tmp-ah, trace
|
|
|
|
cdr b, b-tmp-ah, trace
|
|
|
|
var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah
|
|
|
|
var a-tmp/ecx: (addr cell) <- copy _a-tmp
|
|
|
|
var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah
|
|
|
|
var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace
|
|
|
|
return result
|
|
|
|
}
|
2021-03-05 14:19:21 +00:00
|
|
|
|
2021-03-07 07:03:23 +00:00
|
|
|
fn is-fn? _x: (addr cell) -> _/eax: boolean {
|
|
|
|
var x/esi: (addr cell) <- copy _x
|
|
|
|
var type/eax: (addr int) <- get x, type
|
|
|
|
compare *type, 2/symbol
|
|
|
|
{
|
|
|
|
break-if-=
|
|
|
|
return 0/false
|
|
|
|
}
|
|
|
|
var contents-ah/eax: (addr handle stream byte) <- get x, text-data
|
|
|
|
var contents/eax: (addr stream byte) <- lookup *contents-ah
|
|
|
|
var result/eax: boolean <- stream-data-equal? contents, "fn"
|
|
|
|
return result
|
|
|
|
}
|
|
|
|
|
2021-03-05 14:19:21 +00:00
|
|
|
fn test-evaluate-is-well-behaved {
|
|
|
|
var t-storage: trace
|
|
|
|
var t/esi: (addr trace) <- address t-storage
|
|
|
|
initialize-trace t, 0x10, 0/visible # we don't use trace UI
|
|
|
|
#
|
|
|
|
var tmp-storage: (handle cell)
|
|
|
|
var tmp-ah/edx: (addr handle cell) <- address tmp-storage
|
|
|
|
# eval sym(a), nil env
|
|
|
|
allocate-pair tmp-ah
|
|
|
|
var env/eax: (addr cell) <- lookup *tmp-ah
|
|
|
|
new-symbol tmp-ah, "a"
|
|
|
|
evaluate tmp-ah, tmp-ah, env, t
|
|
|
|
# doesn't die
|
|
|
|
check-trace-contains t, "error", "unbound symbol: a", "F - test-evaluate-is-well-behaved"
|
|
|
|
}
|
|
|
|
|
2021-03-05 17:02:56 +00:00
|
|
|
fn test-evaluate-number {
|
|
|
|
var tmp-storage: (handle cell)
|
|
|
|
var tmp-ah/edx: (addr handle cell) <- address tmp-storage
|
|
|
|
# eval 3, nil env
|
|
|
|
allocate-pair tmp-ah
|
|
|
|
var env/eax: (addr cell) <- lookup *tmp-ah
|
|
|
|
new-integer tmp-ah, 3
|
|
|
|
evaluate tmp-ah, tmp-ah, env, 0/no-trace
|
|
|
|
#
|
|
|
|
var result/eax: (addr cell) <- lookup *tmp-ah
|
|
|
|
var result-type/edx: (addr int) <- get result, type
|
|
|
|
check-ints-equal *result-type, 1/number, "F - test-evaluate-number/0"
|
|
|
|
var result-value-addr/eax: (addr float) <- get result, number-data
|
|
|
|
var result-value/eax: int <- convert *result-value-addr
|
|
|
|
check-ints-equal result-value, 3, "F - test-evaluate-number/1"
|
|
|
|
}
|
|
|
|
|
|
|
|
fn test-evaluate-symbol {
|
2021-03-05 14:19:21 +00:00
|
|
|
# tmp = (a . 3)
|
|
|
|
var val-storage: (handle cell)
|
|
|
|
var val-ah/ecx: (addr handle cell) <- address val-storage
|
|
|
|
new-integer val-ah, 3
|
|
|
|
var key-storage: (handle cell)
|
|
|
|
var key-ah/edx: (addr handle cell) <- address key-storage
|
|
|
|
new-symbol key-ah, "a"
|
|
|
|
var tmp-storage: (handle cell)
|
|
|
|
var tmp-ah/ebx: (addr handle cell) <- address tmp-storage
|
|
|
|
new-pair tmp-ah, *key-ah, *val-ah
|
|
|
|
# env = ((a . 3))
|
|
|
|
var nil-storage: (handle cell)
|
|
|
|
var nil-ah/ecx: (addr handle cell) <- address nil-storage
|
|
|
|
allocate-pair nil-ah
|
|
|
|
new-pair tmp-ah, *tmp-ah, *nil-ah
|
|
|
|
var env/eax: (addr cell) <- lookup *tmp-ah
|
|
|
|
# eval sym(a), env
|
|
|
|
new-symbol tmp-ah, "a"
|
|
|
|
evaluate tmp-ah, tmp-ah, env, 0/no-trace
|
|
|
|
var result/eax: (addr cell) <- lookup *tmp-ah
|
|
|
|
var result-type/edx: (addr int) <- get result, type
|
2021-03-05 17:02:56 +00:00
|
|
|
check-ints-equal *result-type, 1/number, "F - test-evaluate-symbol/0"
|
2021-03-05 14:19:21 +00:00
|
|
|
var result-value-addr/eax: (addr float) <- get result, number-data
|
|
|
|
var result-value/eax: int <- convert *result-value-addr
|
2021-03-05 17:02:56 +00:00
|
|
|
check-ints-equal result-value, 3, "F - test-evaluate-symbol/1"
|
2021-03-05 14:19:21 +00:00
|
|
|
}
|
2021-03-05 17:27:15 +00:00
|
|
|
|
|
|
|
fn test-evaluate-primitive-function {
|
|
|
|
var nil-storage: (handle cell)
|
|
|
|
var nil-ah/ecx: (addr handle cell) <- address nil-storage
|
|
|
|
allocate-pair nil-ah
|
2021-03-05 23:18:46 +00:00
|
|
|
var add-storage: (handle cell)
|
|
|
|
var add-ah/ebx: (addr handle cell) <- address add-storage
|
|
|
|
new-symbol add-ah, "+"
|
2021-03-05 17:27:15 +00:00
|
|
|
# eval +, nil env
|
|
|
|
var tmp-storage: (handle cell)
|
|
|
|
var tmp-ah/esi: (addr handle cell) <- address tmp-storage
|
|
|
|
var env/eax: (addr cell) <- lookup *nil-ah
|
2021-03-05 23:18:46 +00:00
|
|
|
evaluate add-ah, tmp-ah, env, 0/no-trace
|
2021-03-05 17:27:15 +00:00
|
|
|
#
|
|
|
|
var result/eax: (addr cell) <- lookup *tmp-ah
|
|
|
|
var result-type/edx: (addr int) <- get result, type
|
|
|
|
check-ints-equal *result-type, 4/primitive-function, "F - test-evaluate-primitive-function/0"
|
|
|
|
var result-value/eax: (addr int) <- get result, index-data
|
2021-03-05 23:18:46 +00:00
|
|
|
check-ints-equal *result-value, 1/add, "F - test-evaluate-primitive-function/1"
|
|
|
|
}
|
|
|
|
|
|
|
|
fn test-evaluate-primitive-function-call {
|
|
|
|
var t-storage: trace
|
|
|
|
var t/edi: (addr trace) <- address t-storage
|
|
|
|
initialize-trace t, 0x100, 0/visible # we don't use trace UI
|
|
|
|
#
|
|
|
|
var nil-storage: (handle cell)
|
|
|
|
var nil-ah/ecx: (addr handle cell) <- address nil-storage
|
|
|
|
allocate-pair nil-ah
|
|
|
|
var one-storage: (handle cell)
|
|
|
|
var one-ah/edx: (addr handle cell) <- address one-storage
|
|
|
|
new-integer one-ah, 1
|
|
|
|
var add-storage: (handle cell)
|
|
|
|
var add-ah/ebx: (addr handle cell) <- address add-storage
|
|
|
|
new-symbol add-ah, "+"
|
|
|
|
# eval (+ 1 1), nil env
|
|
|
|
var tmp-storage: (handle cell)
|
|
|
|
var tmp-ah/esi: (addr handle cell) <- address tmp-storage
|
|
|
|
new-pair tmp-ah, *one-ah, *nil-ah
|
|
|
|
new-pair tmp-ah, *one-ah, *tmp-ah
|
|
|
|
new-pair tmp-ah, *add-ah, *tmp-ah
|
|
|
|
#? dump-cell tmp-ah
|
|
|
|
var env/eax: (addr cell) <- lookup *nil-ah
|
|
|
|
evaluate tmp-ah, tmp-ah, env, t
|
|
|
|
#? dump-trace t
|
|
|
|
#
|
|
|
|
var result/eax: (addr cell) <- lookup *tmp-ah
|
|
|
|
var result-type/edx: (addr int) <- get result, type
|
|
|
|
check-ints-equal *result-type, 1/number, "F - test-evaluate-primitive-function-call/0"
|
|
|
|
var result-value-addr/eax: (addr float) <- get result, number-data
|
|
|
|
var result-value/eax: int <- convert *result-value-addr
|
|
|
|
check-ints-equal result-value, 2, "F - test-evaluate-primitive-function-call/1"
|
2021-03-05 17:27:15 +00:00
|
|
|
}
|