From 770cac9412f95e0b305712239a86ff388467a1e1 Mon Sep 17 00:00:00 2001 From: "Kartik K. Agaram" Date: Sat, 10 Apr 2021 21:20:35 -0700 Subject: shell: UI now showing fake keyboard But we don't actually support fake keyboards anywhere yet. --- shell/evaluate.mu | 42 +++++++++++++++++++++--------------------- 1 file changed, 21 insertions(+), 21 deletions(-) (limited to 'shell/evaluate.mu') diff --git a/shell/evaluate.mu b/shell/evaluate.mu index 2966751e..ba13b494 100644 --- a/shell/evaluate.mu +++ b/shell/evaluate.mu @@ -1,7 +1,7 @@ # env is an alist of ((sym . val) (sym . val) ...) # we never modify `in` or `env` # ignore 'screen-cell' on a first reading; it's a hack for sandboxes -fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell) { +fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) { var in/esi: (addr handle cell) <- copy _in #? dump-cell in #? { @@ -47,7 +47,7 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel { break-if-!= trace-text trace, "eval", "symbol" - lookup-symbol in-addr, out, env-h, globals, trace, screen-cell + lookup-symbol in-addr, out, env-h, globals, trace, screen-cell, keyboard-cell trace-higher trace return } @@ -121,7 +121,7 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel rest-ah <- get rest, right rest <- lookup *rest-ah var second-arg-ah/edx: (addr handle cell) <- get rest, left - evaluate second-arg-ah, out, env-h, globals, trace, screen-cell + evaluate second-arg-ah, out, env-h, globals, trace, screen-cell, keyboard-cell trace-text trace, "eval", "saving global binding" var first-arg/eax: (addr cell) <- lookup *first-arg-ah var first-arg-data-ah/eax: (addr handle stream byte) <- get first-arg, text-data @@ -158,7 +158,7 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel var first-arg-ah/ecx: (addr handle cell) <- get rest, left var guard-h: (handle cell) var guard-ah/esi: (addr handle cell) <- address guard-h - evaluate first-arg-ah, guard-ah, env-h, globals, trace, screen-cell + evaluate first-arg-ah, guard-ah, env-h, globals, trace, screen-cell, keyboard-cell rest-ah <- get rest, right rest <- lookup *rest-ah var branch-ah/edi: (addr handle cell) <- get rest, left @@ -173,7 +173,7 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel rest <- lookup *rest-ah branch-ah <- get rest, left } - evaluate branch-ah, out, env-h, globals, trace, screen-cell + evaluate branch-ah, out, env-h, globals, trace, screen-cell, keyboard-cell trace-higher trace return } @@ -192,7 +192,7 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel 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-h, globals, trace, screen-cell + evaluate left-ah, left-out-ah, env-h, globals, trace, screen-cell, keyboard-cell # curr-out-ah <- get curr-out, right var right-ah/eax: (addr handle cell) <- get curr, right @@ -205,7 +205,7 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel var args-ah/edx: (addr handle cell) <- get evaluated-list, right #? dump-cell args-ah #? abort "aaa" - apply function-ah, args-ah, out, env-h, globals, trace, screen-cell + apply function-ah, args-ah, out, env-h, globals, trace, screen-cell, keyboard-cell trace-higher trace # trace "=> " out {{{ { @@ -218,7 +218,7 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel # }}} } -fn apply _f-ah: (addr handle cell), args-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell) { +fn apply _f-ah: (addr handle cell), args-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) { var f-ah/eax: (addr handle cell) <- copy _f-ah var _f/eax: (addr cell) <- lookup *f-ah var f/esi: (addr cell) <- copy _f @@ -257,14 +257,14 @@ fn apply _f-ah: (addr handle cell), args-ah: (addr handle cell), out: (addr hand 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, globals, trace, screen-cell + apply-function params-ah, args-ah, body-ah, out, env-h, globals, trace, screen-cell, keyboard-cell trace-higher trace return } error trace, "unknown function" } -fn apply-function params-ah: (addr handle cell), args-ah: (addr handle cell), _body-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell) { +fn apply-function params-ah: (addr handle cell), args-ah: (addr handle cell), _body-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) { # push bindings for params to env var new-env-storage: (handle cell) var new-env-ah/esi: (addr handle cell) <- address new-env-storage @@ -282,7 +282,7 @@ fn apply-function params-ah: (addr handle cell), args-ah: (addr handle cell), _b # evaluate each expression, writing result to `out` { var curr-ah/eax: (addr handle cell) <- get body, left - evaluate curr-ah, out, *new-env-ah, globals, trace, screen-cell + evaluate curr-ah, out, *new-env-ah, globals, trace, screen-cell, keyboard-cell } # body-ah <- get body, right @@ -375,7 +375,7 @@ fn push-bindings _params-ah: (addr handle cell), _args-ah: (addr handle cell), o trace-higher trace } -fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell) { +fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) { # trace sym { var stream-storage: (stream byte 0x40) @@ -408,7 +408,7 @@ fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell) var env-nil?/eax: boolean <- nil? env compare env-nil?, 0/false break-if-= - lookup-symbol-in-globals sym, out, globals, trace, screen-cell + lookup-symbol-in-globals sym, out, globals, trace, screen-cell, keyboard-cell trace-higher trace # trace "=> " out " (global)" {{{ { @@ -480,7 +480,7 @@ fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell) var env-tail-storage: (handle cell) var env-tail-ah/eax: (addr handle cell) <- address env-tail-storage cdr env, env-tail-ah, trace - lookup-symbol sym, out, *env-tail-ah, globals, trace, screen-cell + lookup-symbol sym, out, *env-tail-ah, globals, trace, screen-cell, keyboard-cell trace-higher trace # trace "=> " out " (recurse)" {{{ { @@ -518,7 +518,7 @@ fn test-lookup-symbol-in-env { var tmp-ah/edx: (addr handle cell) <- address tmp-storage new-symbol tmp-ah, "a" var in/eax: (addr cell) <- lookup *tmp-ah - lookup-symbol in, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen + lookup-symbol in, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard 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" @@ -540,7 +540,7 @@ fn test-lookup-symbol-in-globals { 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, *nil-ah, globals, 0/no-trace, 0/no-screen + lookup-symbol in, tmp-ah, *nil-ah, globals, 0/no-trace, 0/no-screen, 0/no-keyboard 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-globals/0" @@ -755,7 +755,7 @@ fn test-evaluate-is-well-behaved { var tmp-storage: (handle cell) var tmp-ah/edx: (addr handle cell) <- address tmp-storage new-symbol tmp-ah, "a" - evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, t, 0/no-screen + evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, t, 0/no-screen, 0/no-keyboard # doesn't die check-trace-contains t, "error", "unbound symbol: a", "F - test-evaluate-is-well-behaved" } @@ -769,7 +769,7 @@ fn test-evaluate-number { var tmp-storage: (handle cell) var tmp-ah/edx: (addr handle cell) <- address tmp-storage new-integer tmp-ah, 3 - evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen + evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard # var result/eax: (addr cell) <- lookup *tmp-ah var result-type/edx: (addr int) <- get result, type @@ -799,7 +799,7 @@ fn test-evaluate-symbol { var tmp-storage: (handle cell) var tmp-ah/edx: (addr handle cell) <- address tmp-storage new-symbol tmp-ah, "a" - evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen + evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard 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-symbol/0" @@ -821,7 +821,7 @@ fn test-evaluate-primitive-function { # eval +, nil env var tmp-storage: (handle cell) var tmp-ah/esi: (addr handle cell) <- address tmp-storage - evaluate add-ah, tmp-ah, *nil-ah, globals, 0/no-trace, 0/no-screen + evaluate add-ah, tmp-ah, *nil-ah, globals, 0/no-trace, 0/no-screen, 0/no-keyboard # var result/eax: (addr cell) <- lookup *tmp-ah var result-type/edx: (addr int) <- get result, type @@ -856,7 +856,7 @@ fn test-evaluate-primitive-function-call { var globals/edx: (addr global-table) <- address globals-storage initialize-globals globals # - evaluate tmp-ah, tmp-ah, *nil-ah, globals, t, 0/no-screen + evaluate tmp-ah, tmp-ah, *nil-ah, globals, t, 0/no-screen, 0/no-keyboard #? dump-trace t # var result/eax: (addr cell) <- lookup *tmp-ah -- cgit 1.4.1-2-gfad0