diff options
| -rw-r--r-- | shell/eval.mu | 96 | ||||
| -rw-r--r-- | shell/trace.mu | 5 |
2 files changed, 88 insertions, 13 deletions
diff --git a/shell/eval.mu b/shell/eval.mu index 045d8225..13822aac 100644 --- a/shell/eval.mu +++ b/shell/eval.mu @@ -83,7 +83,6 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel 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 @@ -115,6 +114,19 @@ fn apply _f-ah: (addr handle cell), args-ah: (addr handle cell), out: (addr hand return } # if it's not a primitive function it must be an anonymous function + # trace "apply anonymous function " f " in environment " env {{{ + { + var stream-storage: (stream byte 0x40) + var stream/ecx: (addr stream byte) <- address stream-storage + write stream, "apply anonymous function " + print-cell _f-ah, stream, 0/no-trace + write stream, " in environment " + var env-ah/eax: (addr handle cell) <- address env-h + print-cell env-ah, stream, 0/no-trace + trace trace, "eval", stream + } + # }}} + trace-lower trace { var f-type/ecx: (addr int) <- get f, type compare *f-type, 0/pair @@ -124,12 +136,12 @@ fn apply _f-ah: (addr handle cell), args-ah: (addr handle cell), out: (addr hand 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-h, trace + trace-higher trace return } error trace, "unknown function" @@ -185,7 +197,6 @@ fn push-bindings _params-ah: (addr handle cell), _args-ah: (addr handle cell), o # nil is a literal trace-text trace, "eval", "done with push-bindings" copy-handle old-env-h, env-ah - trace-higher trace return } # Params can only be symbols or pairs. Args can be anything. @@ -197,6 +208,9 @@ fn push-bindings _params-ah: (addr handle cell), _args-ah: (addr handle cell), o print-cell params-ah, stream, 0/no-trace write stream, " to " print-cell args-ah, stream, 0/no-trace + write stream, " onto " + var old-env-ah/eax: (addr handle cell) <- address old-env-h + print-cell old-env-ah, stream, 0/no-trace trace trace, "eval", stream } # }}} @@ -241,6 +255,7 @@ fn push-bindings _params-ah: (addr handle cell), _args-ah: (addr handle cell), o var remaining-params-ah/eax: (addr handle cell) <- get params, right var remaining-args-ah/ecx: (addr handle cell) <- get args, right push-bindings remaining-params-ah, remaining-args-ah, *intermediate-env-ah, env-ah, trace + trace-higher trace } fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), trace: (addr trace) { @@ -256,6 +271,7 @@ fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr hand } fn apply-add _args-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), trace: (addr trace) { + trace-text trace, "eval", "apply +" 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 @@ -307,12 +323,15 @@ fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell) { var stream-storage: (stream byte 0x40) var stream/ecx: (addr stream byte) <- address stream-storage - write stream, "lookup " + write stream, "look up " 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 + write stream, " in " + var env-ah/eax: (addr handle cell) <- address env-h + print-cell env-ah, stream, 0/no-trace trace trace, "eval", stream } trace-lower trace @@ -334,12 +353,25 @@ fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell) break-if-= lookup-symbol-in-hardcoded-globals sym, out, trace trace-higher trace + # trace "=> " out " (global)" {{{ + { + var error?/eax: boolean <- has-errors? trace + compare error?, 0/false + break-if-!= + var stream-storage: (stream byte 0x40) + var stream/ecx: (addr stream byte) <- address stream-storage + write stream, "=> " + print-cell out, stream, 0/no-trace + write stream, " (global)" + trace trace, "eval", stream + } + # }}} 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 + car env, env-head-ah, 0/no-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 @@ -370,7 +402,20 @@ fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell) compare match?, 0/false { break-if-= - cdr env-head, out, trace + cdr env-head, out, 0/no-trace + # trace "=> " out " (match)" {{{ + { + var error?/eax: boolean <- has-errors? trace + compare error?, 0/false + break-if-!= + var stream-storage: (stream byte 0x40) + var stream/ecx: (addr stream byte) <- address stream-storage + write stream, "=> " + print-cell out, stream, 0/no-trace + write stream, " (match)" + trace trace, "eval", stream + } + # }}} trace-higher trace return } @@ -380,6 +425,19 @@ fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell) cdr env, env-tail-ah, trace lookup-symbol sym, out, *env-tail-ah, trace trace-higher trace + # trace "=> " out " (recurse)" {{{ + { + var error?/eax: boolean <- has-errors? trace + compare error?, 0/false + break-if-!= + var stream-storage: (stream byte 0x40) + var stream/ecx: (addr stream byte) <- address stream-storage + write stream, "=> " + print-cell out, stream, 0/no-trace + write stream, " (recurse)" + trace trace, "eval", stream + } + # }}} } fn lookup-symbol-in-hardcoded-globals _sym: (addr cell), out: (addr handle cell), trace: (addr trace) { @@ -520,8 +578,8 @@ fn cell-isomorphic? _a: (addr cell), _b: (addr cell), trace: (addr trace) -> _/e compare b-type, *a-type-addr { break-if-= - trace-text trace, "eval", "=> false (type)" trace-higher trace + trace-text trace, "eval", "=> false (type)" return 0/false } # if types are number, compare number-data @@ -535,12 +593,12 @@ fn cell-isomorphic? _a: (addr cell), _b: (addr cell), trace: (addr trace) -> _/e compare a-val, *b-val-addr { break-if-= - trace-text trace, "eval", "=> false (numbers)" trace-higher trace + trace-text trace, "eval", "=> false (numbers)" return 0/false } - trace-text trace, "eval", "=> true (numbers)" trace-higher trace + trace-text trace, "eval", "=> true (numbers)" return 1/true } compare b-type, 2/symbol @@ -557,8 +615,17 @@ fn cell-isomorphic? _a: (addr cell), _b: (addr cell), trace: (addr trace) -> _/e 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 + { + compare match?, 0/false + break-if-= + trace-text trace, "eval", "=> true (symbols)" + } + { + compare match?, 0/false + break-if-!= + trace-text trace, "eval", "=> false (symbols)" + } return match? } # if a is nil, b should be nil @@ -573,24 +640,24 @@ fn cell-isomorphic? _a: (addr cell), _b: (addr cell), trace: (addr trace) -> _/e break-if-= compare b-is-nil?, 0/false break-if-= - trace-text trace, "eval", "=> true (nils)" trace-higher trace + trace-text trace, "eval", "=> true (nils)" 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 + trace-text trace, "eval", "=> false (b != nil)" 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 + trace-text trace, "eval", "=> false (a != nil)" return 0/false } } @@ -609,6 +676,8 @@ fn cell-isomorphic? _a: (addr cell), _b: (addr cell), trace: (addr trace) -> _/e var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace compare result, 0/false break-if-!= + trace-higher trace + trace-text trace, "eval", "=> false (car mismatch)" return 0/false } # recurse on cdrs @@ -618,6 +687,7 @@ fn cell-isomorphic? _a: (addr cell), _b: (addr cell), trace: (addr trace) -> _/e 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 + trace-higher trace return result } diff --git a/shell/trace.mu b/shell/trace.mu index 218e35d5..26393d2b 100644 --- a/shell/trace.mu +++ b/shell/trace.mu @@ -53,6 +53,11 @@ fn clear-trace _self: (addr trace) { fn has-errors? _self: (addr trace) -> _/eax: boolean { var self/eax: (addr trace) <- copy _self + { + compare self, 0 + break-if-!= + return 0/false + } var max/edx: (addr int) <- get self, first-free var trace-ah/eax: (addr handle array trace-line) <- get self, data var _trace/eax: (addr array trace-line) <- lookup *trace-ah |