diff options
| -rw-r--r-- | shell/eval.mu | 156 | ||||
| -rw-r--r-- | shell/print.mu | 10 | ||||
| -rw-r--r-- | shell/tokenize.mu | 162 | ||||
| -rw-r--r-- | shell/trace.mu | 30 |
4 files changed, 338 insertions, 20 deletions
diff --git a/shell/eval.mu b/shell/eval.mu index da5dda19..9ca8d4bc 100644 --- a/shell/eval.mu +++ b/shell/eval.mu @@ -29,9 +29,108 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env: (addr cell), trace-higher trace return } - # TODO: pairs - copy-object _in, out - trace-higher trace + # in-addr is a pair + # TODO: special forms + 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 + var f/eax: (addr cell) <- lookup *f-ah + { + var f-type/ecx: (addr int) <- get f, type + compare *f-type, 4/primitive-function + break-if-!= + apply-primitive f, args-ah, out, env, trace + return + } + abort "unknown function" +} + +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 } fn lookup-symbol sym: (addr cell), out: (addr handle cell), _env: (addr cell), trace: (addr trace) { @@ -120,10 +219,10 @@ fn lookup-symbol-in-hardcoded-globals _sym: (addr cell), out: (addr handle cell) var _sym-data/eax: (addr stream byte) <- lookup *sym-data-ah var sym-data/esi: (addr stream byte) <- copy _sym-data { - var is-plus?/eax: boolean <- stream-data-equal? sym-data, "+" - compare is-plus?, 0/false + var is-add?/eax: boolean <- stream-data-equal? sym-data, "+" + compare is-add?, 0/false break-if-= - new-primitive-function out, 1/plus + new-primitive-function out, 1/add trace-text trace, "eval", "global +" return } @@ -183,7 +282,7 @@ fn test-lookup-symbol-in-hardcoded-globals { 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 - check-ints-equal *result-value, 1/plus, "F - test-lookup-symbol-in-hardcoded-globals/1" + check-ints-equal *result-value, 1/add, "F - test-lookup-symbol-in-hardcoded-globals/1" } fn car _in: (addr cell), out: (addr handle cell), trace: (addr trace) { @@ -419,18 +518,51 @@ fn test-evaluate-primitive-function { var nil-storage: (handle cell) var nil-ah/ecx: (addr handle cell) <- address nil-storage allocate-pair nil-ah - var plus-storage: (handle cell) - var plus-ah/ebx: (addr handle cell) <- address plus-storage - new-symbol plus-ah, "+" + var add-storage: (handle cell) + var add-ah/ebx: (addr handle cell) <- address add-storage + new-symbol add-ah, "+" # 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 - evaluate plus-ah, tmp-ah, env, 0/no-trace + evaluate add-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, 4/primitive-function, "F - test-evaluate-primitive-function/0" var result-value/eax: (addr int) <- get result, index-data - check-ints-equal *result-value, 1/plus, "F - test-evaluate-primitive-function/1" + 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" } diff --git a/shell/print.mu b/shell/print.mu index 32f5e725..46782705 100644 --- a/shell/print.mu +++ b/shell/print.mu @@ -35,6 +35,16 @@ fn print-cell _in: (addr handle cell), out: (addr stream byte), trace: (addr tra } } +# debug helper +fn dump-cell in-ah: (addr handle cell) { + var stream-storage: (stream byte 0x40) + var stream/edx: (addr stream byte) <- address stream-storage + print-cell in-ah, stream, 0/no-trace + var d1/eax: int <- copy 0 + var d2/ecx: int <- copy 0 + d1, d2 <- draw-stream-wrapping-right-then-down 0/screen, stream, 0/xmin, 0/ymin, 0x80/xmax, 0x30/ymax, 0/x, 0/y, 7/fg, 0/bg +} + fn print-symbol _in: (addr cell), out: (addr stream byte), trace: (addr trace) { trace-text trace, "print", "symbol" var in/esi: (addr cell) <- copy _in diff --git a/shell/tokenize.mu b/shell/tokenize.mu index 7beedf23..b6ca1ffd 100644 --- a/shell/tokenize.mu +++ b/shell/tokenize.mu @@ -73,6 +73,14 @@ fn next-token in: (addr gap-buffer), _out-cell: (addr cell), trace: (addr trace) next-bracket-token g, out, trace break $next-token:body } + # non-symbol operators + { + var operator?/eax: boolean <- is-operator-grapheme? g + compare operator?, 0/false + break-if-= + next-operator-token in, out, trace + break $next-token:body + } } trace-higher trace var stream-storage: (stream byte 0x40) @@ -120,6 +128,43 @@ fn next-symbol-token in: (addr gap-buffer), out: (addr stream byte), trace: (add trace trace, "read", stream } +fn next-operator-token in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) { + trace-text trace, "read", "looking for a operator" + trace-lower trace + $next-operator-token:loop: { + var done?/eax: boolean <- gap-buffer-scan-done? in + compare done?, 0/false + break-if-!= + var g/eax: grapheme <- peek-from-gap-buffer in + { + var stream-storage: (stream byte 0x40) + var stream/esi: (addr stream byte) <- address stream-storage + write stream, "next: " + var gval/eax: int <- copy g + write-int32-hex stream, gval + trace trace, "read", stream + } + # if non-operator, return + { + var operator-grapheme?/eax: boolean <- is-operator-grapheme? g + compare operator-grapheme?, 0/false + break-if-!= + trace-text trace, "read", "stop" + break $next-operator-token:loop + } + var g/eax: grapheme <- read-from-gap-buffer in + write-grapheme out, g + loop + } + trace-higher trace + var stream-storage: (stream byte 0x40) + var stream/esi: (addr stream byte) <- address stream-storage + write stream, "=> " + rewind-stream out + write-stream stream, out + trace trace, "read", stream +} + fn next-number-token in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) { trace-text trace, "read", "looking for a number" trace-lower trace @@ -194,11 +239,6 @@ fn is-symbol-grapheme? g: grapheme -> _/eax: boolean { break-if-!= return 0/false } - compare g, 0x27/single-quote - { - break-if-!= - return 0/false - } compare g, 0x60/backquote { break-if-!= @@ -253,6 +293,11 @@ fn is-symbol-grapheme? g: grapheme -> _/eax: boolean { break-if-!= return 0/false } + compare g, 0x27/single-quote + { + break-if-!= + return 0/false + } compare g, 0x2a/asterisk { break-if-!= @@ -268,13 +313,12 @@ fn is-symbol-grapheme? g: grapheme -> _/eax: boolean { break-if-!= return 0/false } - # '-' is a symbol char - compare g, 0x2e/period + compare g, 0x2d/dash # '-' not allowed in symbols { break-if-!= return 0/false } - compare g, 0x2f/slash + compare g, 0x2e/period { break-if-!= return 0/false @@ -373,6 +417,108 @@ fn is-bracket-grapheme? g: grapheme -> _/eax: boolean { return 0/false } +fn is-operator-grapheme? g: grapheme -> _/eax: boolean { + # '$' is a symbol char + compare g, 0x25/percent + { + break-if-!= + return 1/false + } + compare g, 0x26/ampersand + { + break-if-!= + return 1/true + } + compare g, 0x27/single-quote + { + break-if-!= + return 1/true + } + compare g, 0x2a/asterisk + { + break-if-!= + return 1/true + } + compare g, 0x2b/plus + { + break-if-!= + return 1/true + } + compare g, 0x2c/comma + { + break-if-!= + return 1/true + } + compare g, 0x2d/dash # '-' not allowed in symbols + { + break-if-!= + return 1/true + } + compare g, 0x2e/period + { + break-if-!= + return 1/true + } + compare g, 0x2f/slash + { + break-if-!= + return 1/true + } + compare g, 0x3a/colon + { + break-if-!= + return 1/true + } + compare g, 0x3b/semi-colon + { + break-if-!= + return 1/true + } + compare g, 0x3c/less-than + { + break-if-!= + return 1/true + } + compare g, 0x3d/equal + { + break-if-!= + return 1/true + } + compare g, 0x3e/greater-than + { + break-if-!= + return 1/true + } + # '?' is a symbol char + compare g, 0x40/at-sign + { + break-if-!= + return 1/true + } + compare g, 0x5c/backslash + { + break-if-!= + return 1/true + } + compare g, 0x5e/caret + { + break-if-!= + return 1/true + } + # '_' is a symbol char + compare g, 0x7c/vertical-line + { + break-if-!= + return 1/true + } + compare g, 0x7e/tilde + { + break-if-!= + return 1/true + } + return 0/false +} + fn is-number-token? _in: (addr cell) -> _/eax: boolean { var in/eax: (addr cell) <- copy _in var in-data-ah/eax: (addr handle stream byte) <- get in, text-data diff --git a/shell/trace.mu b/shell/trace.mu index 34303f43..218e35d5 100644 --- a/shell/trace.mu +++ b/shell/trace.mu @@ -255,6 +255,36 @@ fn trace-lines-equal? _a: (addr trace-line), _b: (addr trace-line) -> _/eax: boo return data-match? } +fn dump-trace _self: (addr trace) { + var already-hiding-lines?: boolean + var y/ecx: int <- copy 0 + var self/esi: (addr trace) <- copy _self + compare self, 0 + { + break-if-!= + return + } + var trace-ah/eax: (addr handle array trace-line) <- get self, data + var _trace/eax: (addr array trace-line) <- lookup *trace-ah + var trace/edi: (addr array trace-line) <- copy _trace + var i/edx: int <- copy 0 + var max-addr/ebx: (addr int) <- get self, first-free + var max/ebx: int <- copy *max-addr + $dump-trace:loop: { + compare i, max + break-if->= + $dump-trace:iter: { + var offset/ebx: (offset trace-line) <- compute-offset trace, i + var curr/ebx: (addr trace-line) <- index trace, offset + var curr-label-ah/eax: (addr handle array byte) <- get curr, label + var curr-label/eax: (addr array byte) <- lookup *curr-label-ah + y <- render-trace-line 0/screen, curr, 0, y, 0x80/width, 0x30/height, 7/fg, 0/bg + } + i <- increment + loop + } +} + ## UI stuff fn mark-lines-dirty _self: (addr trace) { |