Mu - shell/infix.mu

From e0b8eddb5b2463a6a2890fd2a089cc3cc1a0f711 Mon Sep 17 00:00:00 2001 From: Kartik Agaram Date: Wed, 23 Jun 2021 13:19:20 -0700 Subject: . --- html/109stream-equal.subx.html | 2 +- html/309stream.subx.html | 20 +- html/400.mu.html | 129 +- html/shell/environment.mu.html | 14 +- html/shell/evaluate.mu.html | 3186 ++++++++++++++--------------- html/shell/gap-buffer.mu.html | 540 +++-- html/shell/global.mu.html | 6 +- html/shell/infix.mu.html | 644 ++++++ html/shell/int-stack.mu.html | 135 ++ html/shell/macroexpand.mu.html | 60 +- html/shell/parenthesize.mu.html | 478 +++++ html/shell/parse.mu.html | 574 +++--- html/shell/primitives.mu.html | 4207 ++++++++++++++++++++------------------- html/shell/print.mu.html | 8 +- html/shell/read.mu.html | 39 +- html/shell/sandbox.mu.html | 256 +-- html/shell/tokenize.mu.html | 2138 ++++++++++---------- 17 files changed, 6890 insertions(+), 5546 deletions(-) create mode 100644 html/shell/infix.mu.html create mode 100644 html/shell/int-stack.mu.html create mode 100644 html/shell/parenthesize.mu.html (limited to 'html') diff --git a/html/109stream-equal.subx.html b/html/109stream-equal.subx.html index 95af3eba..2e5ff409 100644 --- a/html/109stream-equal.subx.html +++ b/html/109stream-equal.subx.html @@ -249,7 +249,7 @@ if ('onhashchange' in window) { 190 5d/pop-to-ebp 191 c3/return 192 -193 # helper for later tests +193 # helper for tests 194 check-stream-equal: # f: (addr stream byte), s: (addr array byte), msg: (addr array byte) 195 # . prologue 196 55/push-ebp diff --git a/html/309stream.subx.html b/html/309stream.subx.html index 8cb9f603..28b8ca66 100644 --- a/html/309stream.subx.html +++ b/html/309stream.subx.html @@ -264,7 +264,7 @@ if ('onhashchange' in window) { 208 c3/return 209 210 # compare all the data in two streams (ignoring the read pointer) -211 streams-data-equal?: # f: (addr stream byte), s: (addr array byte) -> result/eax: boolean +211 streams-data-equal?: # a: (addr stream byte), b: (addr array byte) -> result/eax: boolean 212 # pseudocode: 213 # awrite = a->write 214 # if (awrite != b->write) return false @@ -351,6 +351,24 @@ if ('onhashchange' in window) { 295 89/<- %esp 5/r32/ebp 296 5d/pop-to-ebp 297 c3/return +298 +299 # helper for tests +300 check-streams-data-equal: # s: (addr stream _), expected: (addr array _), msg: (addr array byte) +301 # . prologue +302 55/push-ebp +303 89/<- %ebp 4/r32/esp +304 # . save registers +305 50/push-eax +306 # +307 (streams-data-equal? *(ebp+8) *(ebp+0xc)) # => eax +308 (check-ints-equal %eax 1 *(ebp+0x10)) +309 $check-streams-equal:end: +310 # . restore registers +311 58/pop-to-eax +312 # . epilogue +313 89/<- %esp 5/r32/ebp +314 5d/pop-to-ebp +315 c3/return diff --git a/html/400.mu.html b/html/400.mu.html index 5208d50d..8eb6bd52 100644 --- a/html/400.mu.html +++ b/html/400.mu.html @@ -101,71 +101,72 @@ if ('onhashchange' in window) { 43 sig clear-stream f: (addr stream _) 44 sig rewind-stream f: (addr stream _) 45 sig stream-data-equal? f: (addr stream byte), s: (addr array byte) -> _/eax: boolean - 46 sig streams-data-equal? f: (addr stream byte), s: (addr stream byte) -> _/eax: boolean + 46 sig streams-data-equal? a: (addr stream byte), b: (addr stream byte) -> _/eax: boolean 47 sig check-stream-equal f: (addr stream byte), s: (addr array byte), msg: (addr array byte) - 48 sig next-stream-line-equal? f: (addr stream byte), s: (addr array byte) -> _/eax: boolean - 49 sig check-next-stream-line-equal f: (addr stream byte), s: (addr array byte), msg: (addr array byte) - 50 sig write f: (addr stream byte), s: (addr array byte) - 51 sig try-write f: (addr stream byte), s: (addr array byte) -> _/eax: boolean - 52 # probably a bad idea; I definitely want to discourage its use for streams of non-bytes - 53 sig stream-size f: (addr stream byte) -> _/eax: int - 54 sig space-remaining-in-stream f: (addr stream byte) -> _/eax: int - 55 sig write-stream f: (addr stream byte), s: (addr stream byte) - 56 sig read-byte s: (addr stream byte) -> _/eax: byte - 57 sig append-byte f: (addr stream byte), n: int # really just a byte, but I want to pass in literal numbers - 58 #sig to-hex-char in/eax: int -> out/eax: int - 59 sig append-byte-hex f: (addr stream byte), n: int # really just a byte, but I want to pass in literal numbers - 60 sig write-int32-hex f: (addr stream byte), n: int - 61 sig write-int32-hex-bits f: (addr stream byte), n: int, bits: int - 62 sig hex-int? in: (addr slice) -> _/eax: boolean - 63 sig parse-hex-int in: (addr array byte) -> _/eax: int - 64 sig parse-hex-int-from-slice in: (addr slice) -> _/eax: int - 65 #sig parse-hex-int-helper start: (addr byte), end: (addr byte) -> _/eax: int - 66 sig hex-digit? c: byte -> _/eax: boolean - 67 #sig from-hex-char in/eax: byte -> out/eax: nibble - 68 sig parse-decimal-int in: (addr array byte) -> _/eax: int - 69 sig parse-decimal-int-from-slice in: (addr slice) -> _/eax: int - 70 sig parse-decimal-int-from-stream in: (addr stream byte) -> _/eax: int - 71 #sig parse-decimal-int-helper start: (addr byte), end: (addr byte) -> _/eax: int - 72 sig decimal-size n: int -> _/eax: int - 73 #sig allocate ad: (addr allocation-descriptor), n: int, out: (addr handle _) - 74 #sig allocate-raw ad: (addr allocation-descriptor), n: int, out: (addr handle _) - 75 sig lookup h: (handle _T) -> _/eax: (addr _T) - 76 sig handle-equal? a: (handle _T), b: (handle _T) -> _/eax: boolean - 77 sig copy-handle src: (handle _T), dest: (addr handle _T) - 78 #sig allocate-region ad: (addr allocation-descriptor), n: int, out: (addr handle allocation-descriptor) - 79 #sig allocate-array ad: (addr allocation-descriptor), n: int, out: (addr handle _) - 80 sig copy-array ad: (addr allocation-descriptor), src: (addr array _T), out: (addr handle array _T) - 81 #sig zero-out start: (addr byte), size: int - 82 sig slice-empty? s: (addr slice) -> _/eax: boolean - 83 sig slice-equal? s: (addr slice), p: (addr array byte) -> _/eax: boolean - 84 sig slice-starts-with? s: (addr slice), head: (addr array byte) -> _/eax: boolean - 85 sig write-slice out: (addr stream byte), s: (addr slice) - 86 # bad name alert - 87 sig slice-to-string ad: (addr allocation-descriptor), in: (addr slice), out: (addr handle array byte) - 88 sig write-int32-decimal out: (addr stream byte), n: int - 89 sig decimal-digit? c: grapheme -> _/eax: boolean - 90 sig to-decimal-digit in: grapheme -> _/eax: int - 91 # bad name alert - 92 # next-word really tokenizes - 93 # next-raw-word really reads whitespace-separated words - 94 sig next-word line: (addr stream byte), out: (addr slice) # skips '#' comments - 95 sig next-raw-word line: (addr stream byte), out: (addr slice) # does not skip '#' comments - 96 sig stream-empty? s: (addr stream _) -> _/eax: boolean - 97 sig stream-full? s: (addr stream _) -> _/eax: boolean - 98 sig stream-to-array in: (addr stream _), out: (addr handle array _) - 99 sig unquote-stream-to-array in: (addr stream _), out: (addr handle array _) -100 sig stream-first s: (addr stream byte) -> _/eax: byte -101 sig stream-final s: (addr stream byte) -> _/eax: byte -102 -103 #sig copy-bytes src: (addr byte), dest: (addr byte), n: int -104 sig copy-array-object src: (addr array _), dest-ah: (addr handle array _) -105 sig array-equal? a: (addr array int), b: (addr array int) -> _/eax: boolean -106 sig parse-array-of-ints s: (addr array byte), out: (addr handle array int) -107 sig parse-array-of-decimal-ints s: (addr array byte), out: (addr handle array int) -108 sig check-array-equal a: (addr array int), expected: (addr string), msg: (addr string) -109 -110 sig integer-divide a: int, b: int -> _/eax: int, _/edx: int + 48 sig check-streams-data-equal s: (addr stream _), expected: (addr stream _), msg: (addr array byte) + 49 sig next-stream-line-equal? f: (addr stream byte), s: (addr array byte) -> _/eax: boolean + 50 sig check-next-stream-line-equal f: (addr stream byte), s: (addr array byte), msg: (addr array byte) + 51 sig write f: (addr stream byte), s: (addr array byte) + 52 sig try-write f: (addr stream byte), s: (addr array byte) -> _/eax: boolean + 53 # probably a bad idea; I definitely want to discourage its use for streams of non-bytes + 54 sig stream-size f: (addr stream byte) -> _/eax: int + 55 sig space-remaining-in-stream f: (addr stream byte) -> _/eax: int + 56 sig write-stream f: (addr stream byte), s: (addr stream byte) + 57 sig read-byte s: (addr stream byte) -> _/eax: byte + 58 sig append-byte f: (addr stream byte), n: int # really just a byte, but I want to pass in literal numbers + 59 #sig to-hex-char in/eax: int -> out/eax: int + 60 sig append-byte-hex f: (addr stream byte), n: int # really just a byte, but I want to pass in literal numbers + 61 sig write-int32-hex f: (addr stream byte), n: int + 62 sig write-int32-hex-bits f: (addr stream byte), n: int, bits: int + 63 sig hex-int? in: (addr slice) -> _/eax: boolean + 64 sig parse-hex-int in: (addr array byte) -> _/eax: int + 65 sig parse-hex-int-from-slice in: (addr slice) -> _/eax: int + 66 #sig parse-hex-int-helper start: (addr byte), end: (addr byte) -> _/eax: int + 67 sig hex-digit? c: byte -> _/eax: boolean + 68 #sig from-hex-char in/eax: byte -> out/eax: nibble + 69 sig parse-decimal-int in: (addr array byte) -> _/eax: int + 70 sig parse-decimal-int-from-slice in: (addr slice) -> _/eax: int + 71 sig parse-decimal-int-from-stream in: (addr stream byte) -> _/eax: int + 72 #sig parse-decimal-int-helper start: (addr byte), end: (addr byte) -> _/eax: int + 73 sig decimal-size n: int -> _/eax: int + 74 #sig allocate ad: (addr allocation-descriptor), n: int, out: (addr handle _) + 75 #sig allocate-raw ad: (addr allocation-descriptor), n: int, out: (addr handle _) + 76 sig lookup h: (handle _T) -> _/eax: (addr _T) + 77 sig handle-equal? a: (handle _T), b: (handle _T) -> _/eax: boolean + 78 sig copy-handle src: (handle _T), dest: (addr handle _T) + 79 #sig allocate-region ad: (addr allocation-descriptor), n: int, out: (addr handle allocation-descriptor) + 80 #sig allocate-array ad: (addr allocation-descriptor), n: int, out: (addr handle _) + 81 sig copy-array ad: (addr allocation-descriptor), src: (addr array _T), out: (addr handle array _T) + 82 #sig zero-out start: (addr byte), size: int + 83 sig slice-empty? s: (addr slice) -> _/eax: boolean + 84 sig slice-equal? s: (addr slice), p: (addr array byte) -> _/eax: boolean + 85 sig slice-starts-with? s: (addr slice), head: (addr array byte) -> _/eax: boolean + 86 sig write-slice out: (addr stream byte), s: (addr slice) + 87 # bad name alert + 88 sig slice-to-string ad: (addr allocation-descriptor), in: (addr slice), out: (addr handle array byte) + 89 sig write-int32-decimal out: (addr stream byte), n: int + 90 sig decimal-digit? c: grapheme -> _/eax: boolean + 91 sig to-decimal-digit in: grapheme -> _/eax: int + 92 # bad name alert + 93 # next-word really tokenizes + 94 # next-raw-word really reads whitespace-separated words + 95 sig next-word line: (addr stream byte), out: (addr slice) # skips '#' comments + 96 sig next-raw-word line: (addr stream byte), out: (addr slice) # does not skip '#' comments + 97 sig stream-empty? s: (addr stream _) -> _/eax: boolean + 98 sig stream-full? s: (addr stream _) -> _/eax: boolean + 99 sig stream-to-array in: (addr stream _), out: (addr handle array _) +100 sig unquote-stream-to-array in: (addr stream _), out: (addr handle array _) +101 sig stream-first s: (addr stream byte) -> _/eax: byte +102 sig stream-final s: (addr stream byte) -> _/eax: byte +103 +104 #sig copy-bytes src: (addr byte), dest: (addr byte), n: int +105 sig copy-array-object src: (addr array _), dest-ah: (addr handle array _) +106 sig array-equal? a: (addr array int), b: (addr array int) -> _/eax: boolean +107 sig parse-array-of-ints s: (addr array byte), out: (addr handle array int) +108 sig parse-array-of-decimal-ints s: (addr array byte), out: (addr handle array int) +109 sig check-array-equal a: (addr array int), expected: (addr string), msg: (addr string) +110 +111 sig integer-divide a: int, b: int -> _/eax: int, _/edx: int diff --git a/html/shell/environment.mu.html b/html/shell/environment.mu.html index 5c0c1ff7..a3b74963 100644 --- a/html/shell/environment.mu.html +++ b/html/shell/environment.mu.html @@ -404,7 +404,7 @@ if ('onhashchange' in window) { 338 # otherwise process like a regular gap-buffer 339 var partial-global-name-ah/eax: (addr handle gap-buffer) <- get self, partial-global-name 340 var partial-global-name/eax: (addr gap-buffer) <- lookup *partial-global-name-ah - 341 edit-gap-buffer partial-global-name, key + 341 edit-gap-buffer partial-global-name, key 342 return 343 } 344 # ctrl-g: go to a global (or the repl) @@ -1042,7 +1042,7 @@ if ('onhashchange' in window) { 976 var globals-cell-storage: (handle cell) 977 var globals-cell-ah/edx: (addr handle cell) <- address globals-cell-storage 978 clear-trace trace - 979 lookup-symbol globals-literal, globals-cell-ah, *initial-root, 0/no-globals, trace, 0/no-screen, 0/no-keyboard + 979 lookup-symbol globals-literal, globals-cell-ah, *initial-root, 0/no-globals, trace, 0/no-screen, 0/no-keyboard 980 var globals-cell/eax: (addr cell) <- lookup *globals-cell-ah 981 { 982 compare globals-cell, 0 @@ -1059,19 +1059,19 @@ if ('onhashchange' in window) { 993 var sandbox-cell-storage: (handle cell) 994 var sandbox-cell-ah/edx: (addr handle cell) <- address sandbox-cell-storage 995 clear-trace trace - 996 lookup-symbol sandbox-literal, sandbox-cell-ah, *initial-root, 0/no-globals, trace, 0/no-screen, 0/no-keyboard + 996 lookup-symbol sandbox-literal, sandbox-cell-ah, *initial-root, 0/no-globals, trace, 0/no-screen, 0/no-keyboard 997 var sandbox-cell/eax: (addr cell) <- lookup *sandbox-cell-ah 998 { 999 compare sandbox-cell, 0 1000 break-if-= -1001 # print: cell -> stream -1002 clear-trace trace -1003 print-cell sandbox-cell-ah, s, trace +1001 var sandbox-data-ah/eax: (addr handle stream byte) <- get sandbox-cell, text-data +1002 var _sandbox-data/eax: (addr stream byte) <- lookup *sandbox-data-ah +1003 var sandbox-data/ecx: (addr stream byte) <- copy _sandbox-data 1004 # stream -> gap-buffer 1005 var sandbox/eax: (addr sandbox) <- get self, sandbox 1006 var data-ah/eax: (addr handle gap-buffer) <- get sandbox, data 1007 var data/eax: (addr gap-buffer) <- lookup *data-ah -1008 load-gap-buffer-from-stream data, s +1008 load-gap-buffer-from-stream data, sandbox-data 1009 } 1010 } 1011 diff --git a/html/shell/evaluate.mu.html b/html/shell/evaluate.mu.html index cb252db0..a97443bf 100644 --- a/html/shell/evaluate.mu.html +++ b/html/shell/evaluate.mu.html @@ -125,7 +125,7 @@ if ('onhashchange' in window) { 58 #? compare foo, 0 59 #? loop-if-= 60 #? } - 61 +-- 19 lines: # trace "evaluate " in " in environment " env ----------------------------------------------------------------------------------------------------------------------------- + 61 +-- 19 lines: # trace "evaluate " in " in environment " env -------------------------------------------------------------------------------------------------------------------------------------------------------- 80 trace-lower trace 81 var in/eax: (addr cell) <- lookup *in-ah 82 { @@ -162,7 +162,7 @@ if ('onhashchange' in window) { 113 break-if-!= 114 trace-text trace, "eval", "symbol" 115 debug-print "a", 7/fg, 0/bg - 116 lookup-symbol in, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var + 116 lookup-symbol in, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var 117 debug-print "z", 7/fg, 0/bg 118 trace-higher trace 119 return @@ -190,8 +190,8 @@ if ('onhashchange' in window) { 141 var in/edx: (addr cell) <- copy in 142 var first-ah/ecx: (addr handle cell) <- get in, left 143 var first/eax: (addr cell) <- lookup *first-ah - 144 var litfn?/eax: boolean <- litfn? first - 145 compare litfn?, 0/false + 144 var litfn?/eax: boolean <- litfn? first + 145 compare litfn?, 0/false 146 break-if-= 147 trace-text trace, "eval", "literal function" 148 copy-object _in-ah, _out-ah @@ -204,8 +204,8 @@ if ('onhashchange' in window) { 155 var in/edx: (addr cell) <- copy in 156 var first-ah/ecx: (addr handle cell) <- get in, left 157 var first/eax: (addr cell) <- lookup *first-ah - 158 var litmac?/eax: boolean <- litmac? first - 159 compare litmac?, 0/false + 158 var litmac?/eax: boolean <- litmac? first + 159 compare litmac?, 0/false 160 break-if-= 161 trace-text trace, "eval", "literal macro" 162 copy-object _in-ah, _out-ah @@ -218,8 +218,8 @@ if ('onhashchange' in window) { 169 var in/edx: (addr cell) <- copy in 170 var first-ah/ecx: (addr handle cell) <- get in, left 171 var first/eax: (addr cell) <- lookup *first-ah - 172 var fn?/eax: boolean <- fn? first - 173 compare fn?, 0/false + 172 var fn?/eax: boolean <- fn? first + 173 compare fn?, 0/false 174 break-if-= 175 # turn (fn ...) into (litfn env ...) 176 trace-text trace, "eval", "anonymous function" @@ -264,1597 +264,1645 @@ if ('onhashchange' in window) { 215 # 216 trace-text trace, "eval", "backquote" 217 debug-print "`(", 7/fg, 0/bg - 218 evaluate-backquote rest-ah, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + 218 evaluate-backquote rest-ah, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number 219 debug-print ")", 7/fg, 0/bg 220 trace-higher trace 221 return 222 } - 223 $evaluate:define: { - 224 # trees starting with "define" define globals - 225 var expr/esi: (addr cell) <- copy in - 226 # if its first elem is not "define", break - 227 var first-ah/ecx: (addr handle cell) <- get in, left - 228 var rest-ah/edx: (addr handle cell) <- get in, right - 229 var first/eax: (addr cell) <- lookup *first-ah - 230 var define?/eax: boolean <- symbol-equal? first, "define" - 231 compare define?, 0/false - 232 break-if-= - 233 # - 234 trace-text trace, "eval", "define" - 235 trace-text trace, "eval", "evaluating second arg" - 236 var rest/eax: (addr cell) <- lookup *rest-ah - 237 var first-arg-ah/ecx: (addr handle cell) <- get rest, left - 238 { - 239 var first-arg/eax: (addr cell) <- lookup *first-arg-ah - 240 var first-arg-type/eax: (addr int) <- get first-arg, type - 241 compare *first-arg-type, 2/symbol - 242 break-if-= - 243 error trace, "first arg to define must be a symbol" - 244 trace-higher trace - 245 return - 246 } - 247 rest-ah <- get rest, right - 248 rest <- lookup *rest-ah - 249 var second-arg-ah/edx: (addr handle cell) <- get rest, left - 250 debug-print "P", 4/fg, 0/bg - 251 evaluate second-arg-ah, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number - 252 debug-print "Q", 4/fg, 0/bg - 253 # errors? skip - 254 { - 255 var error?/eax: boolean <- has-errors? trace - 256 compare error?, 0/false - 257 break-if-= - 258 trace-higher trace - 259 return - 260 } - 261 trace-text trace, "eval", "saving global binding" - 262 var first-arg/eax: (addr cell) <- lookup *first-arg-ah - 263 var first-arg-data-ah/eax: (addr handle stream byte) <- get first-arg, text-data - 264 var first-arg-data/eax: (addr stream byte) <- lookup *first-arg-data-ah - 265 var tmp-string: (handle array byte) - 266 var tmp-ah/edx: (addr handle array byte) <- address tmp-string - 267 rewind-stream first-arg-data - 268 stream-to-array first-arg-data, tmp-ah - 269 var first-arg-data-string/eax: (addr array byte) <- lookup *tmp-ah - 270 var out-ah/edi: (addr handle cell) <- copy _out-ah - 271 var defined-index: int - 272 var defined-index-addr/ecx: (addr int) <- address defined-index - 273 assign-or-create-global globals, first-arg-data-string, *out-ah, defined-index-addr, trace - 274 { - 275 compare definitions-created, 0 - 276 break-if-= - 277 write-to-stream definitions-created, defined-index-addr - 278 } - 279 trace-higher trace - 280 return - 281 } - 282 $evaluate:set: { - 283 # trees starting with "set" mutate bindings - 284 var expr/esi: (addr cell) <- copy in - 285 # if its first elem is not "set", break - 286 var first-ah/ecx: (addr handle cell) <- get in, left - 287 var rest-ah/edx: (addr handle cell) <- get in, right - 288 var first/eax: (addr cell) <- lookup *first-ah - 289 var set?/eax: boolean <- symbol-equal? first, "set" - 290 compare set?, 0/false - 291 break-if-= - 292 # - 293 trace-text trace, "eval", "set" - 294 trace-text trace, "eval", "evaluating second arg" - 295 var rest/eax: (addr cell) <- lookup *rest-ah - 296 var first-arg-ah/ecx: (addr handle cell) <- get rest, left - 297 { - 298 var first-arg/eax: (addr cell) <- lookup *first-arg-ah - 299 var first-arg-type/eax: (addr int) <- get first-arg, type - 300 compare *first-arg-type, 2/symbol + 223 $evaluate:apply: { + 224 var expr/esi: (addr cell) <- copy in + 225 # if its first elem is not "apply", break + 226 var first-ah/ecx: (addr handle cell) <- get in, left + 227 var rest-ah/edx: (addr handle cell) <- get in, right + 228 var first/eax: (addr cell) <- lookup *first-ah + 229 var apply?/eax: boolean <- symbol-equal? first, "apply" + 230 compare apply?, 0/false + 231 break-if-= + 232 # + 233 trace-text trace, "eval", "apply" + 234 trace-text trace, "eval", "evaluating first arg" + 235 var first-arg-value-h: (handle cell) + 236 var first-arg-value-ah/esi: (addr handle cell) <- address first-arg-value-h + 237 var rest/eax: (addr cell) <- lookup *rest-ah + 238 var first-arg-ah/ecx: (addr handle cell) <- get rest, left + 239 debug-print "A2", 4/fg, 0/bg + 240 evaluate first-arg-ah, first-arg-value-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + 241 debug-print "Y2", 4/fg, 0/bg + 242 # errors? skip + 243 { + 244 var error?/eax: boolean <- has-errors? trace + 245 compare error?, 0/false + 246 break-if-= + 247 trace-higher trace + 248 return + 249 } + 250 # + 251 trace-text trace, "eval", "evaluating second arg" + 252 var rest/eax: (addr cell) <- lookup *rest-ah + 253 rest-ah <- get rest, right + 254 rest <- lookup *rest-ah + 255 var second-ah/eax: (addr handle cell) <- get rest, left + 256 var second-arg-value-h: (handle cell) + 257 var second-arg-value-ah/edi: (addr handle cell) <- address second-arg-value-h + 258 debug-print "T2", 4/fg, 0/bg + 259 evaluate second-ah, second-arg-value-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + 260 debug-print "U2", 4/fg, 0/bg + 261 # apply + 262 apply first-arg-value-ah, second-arg-value-ah, _out-ah, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + 263 # + 264 trace-higher trace + 265 return + 266 } + 267 $evaluate:define: { + 268 # trees starting with "define" define globals + 269 var expr/esi: (addr cell) <- copy in + 270 # if its first elem is not "define", break + 271 var first-ah/ecx: (addr handle cell) <- get in, left + 272 var rest-ah/edx: (addr handle cell) <- get in, right + 273 var first/eax: (addr cell) <- lookup *first-ah + 274 var define?/eax: boolean <- symbol-equal? first, "define" + 275 compare define?, 0/false + 276 break-if-= + 277 # + 278 trace-text trace, "eval", "define" + 279 trace-text trace, "eval", "evaluating second arg" + 280 var rest/eax: (addr cell) <- lookup *rest-ah + 281 var first-arg-ah/ecx: (addr handle cell) <- get rest, left + 282 { + 283 var first-arg/eax: (addr cell) <- lookup *first-arg-ah + 284 var first-arg-type/eax: (addr int) <- get first-arg, type + 285 compare *first-arg-type, 2/symbol + 286 break-if-= + 287 error trace, "first arg to define must be a symbol" + 288 trace-higher trace + 289 return + 290 } + 291 rest-ah <- get rest, right + 292 rest <- lookup *rest-ah + 293 var second-arg-ah/edx: (addr handle cell) <- get rest, left + 294 debug-print "P", 4/fg, 0/bg + 295 evaluate second-arg-ah, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + 296 debug-print "Q", 4/fg, 0/bg + 297 # errors? skip + 298 { + 299 var error?/eax: boolean <- has-errors? trace + 300 compare error?, 0/false 301 break-if-= - 302 error trace, "first arg to set must be a symbol" - 303 trace-higher trace - 304 return - 305 } - 306 rest-ah <- get rest, right - 307 rest <- lookup *rest-ah - 308 var second-arg-ah/edx: (addr handle cell) <- get rest, left - 309 debug-print "P", 4/fg, 0/bg - 310 evaluate second-arg-ah, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number - 311 debug-print "Q", 4/fg, 0/bg - 312 # errors? skip - 313 { - 314 var error?/eax: boolean <- has-errors? trace - 315 compare error?, 0/false - 316 break-if-= - 317 trace-higher trace - 318 return - 319 } - 320 trace-text trace, "eval", "mutating binding" - 321 var first-arg/eax: (addr cell) <- lookup *first-arg-ah - 322 var first-arg-data-ah/eax: (addr handle stream byte) <- get first-arg, text-data - 323 var first-arg-data/eax: (addr stream byte) <- lookup *first-arg-data-ah - 324 mutate-binding first-arg-data, _out-ah, env-h, globals, trace - 325 trace-higher trace - 326 return - 327 } - 328 $evaluate:and: { - 329 var expr/esi: (addr cell) <- copy in - 330 # if its first elem is not "and", break - 331 var first-ah/ecx: (addr handle cell) <- get in, left - 332 var rest-ah/edx: (addr handle cell) <- get in, right - 333 var first/eax: (addr cell) <- lookup *first-ah - 334 var and?/eax: boolean <- symbol-equal? first, "and" - 335 compare and?, 0/false - 336 break-if-= - 337 # - 338 trace-text trace, "eval", "and" - 339 trace-text trace, "eval", "evaluating first arg" - 340 var rest/eax: (addr cell) <- lookup *rest-ah - 341 var first-arg-ah/ecx: (addr handle cell) <- get rest, left - 342 debug-print "R2", 4/fg, 0/bg - 343 evaluate first-arg-ah, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number - 344 debug-print "S2", 4/fg, 0/bg - 345 # errors? skip - 346 { - 347 var error?/eax: boolean <- has-errors? trace - 348 compare error?, 0/false - 349 break-if-= - 350 trace-higher trace - 351 return - 352 } - 353 # if first arg is nil, short-circuit - 354 var out-ah/eax: (addr handle cell) <- copy _out-ah - 355 var out/eax: (addr cell) <- lookup *out-ah - 356 var nil?/eax: boolean <- nil? out - 357 compare nil?, 0/false - 358 { - 359 break-if-= - 360 trace-higher trace - 361 return - 362 } - 363 var rest/eax: (addr cell) <- lookup *rest-ah - 364 rest-ah <- get rest, right - 365 rest <- lookup *rest-ah - 366 var second-ah/eax: (addr handle cell) <- get rest, left - 367 debug-print "T2", 4/fg, 0/bg - 368 evaluate second-ah, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number - 369 debug-print "U2", 4/fg, 0/bg - 370 trace-higher trace - 371 return - 372 } - 373 $evaluate:or: { - 374 var expr/esi: (addr cell) <- copy in - 375 # if its first elem is not "or", break - 376 var first-ah/ecx: (addr handle cell) <- get in, left - 377 var rest-ah/edx: (addr handle cell) <- get in, right - 378 var first/eax: (addr cell) <- lookup *first-ah - 379 var or?/eax: boolean <- symbol-equal? first, "or" - 380 compare or?, 0/false - 381 break-if-= - 382 # - 383 trace-text trace, "eval", "or" - 384 trace-text trace, "eval", "evaluating first arg" - 385 var rest/eax: (addr cell) <- lookup *rest-ah - 386 var first-arg-ah/ecx: (addr handle cell) <- get rest, left - 387 debug-print "R2", 4/fg, 0/bg - 388 evaluate first-arg-ah, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number - 389 debug-print "S2", 4/fg, 0/bg - 390 # errors? skip - 391 { - 392 var error?/eax: boolean <- has-errors? trace - 393 compare error?, 0/false - 394 break-if-= - 395 trace-higher trace - 396 return - 397 } - 398 # if first arg is not nil, short-circuit - 399 var out-ah/eax: (addr handle cell) <- copy _out-ah - 400 var out/eax: (addr cell) <- lookup *out-ah - 401 var nil?/eax: boolean <- nil? out - 402 compare nil?, 0/false - 403 { - 404 break-if-!= - 405 trace-higher trace - 406 return - 407 } - 408 var rest/eax: (addr cell) <- lookup *rest-ah - 409 rest-ah <- get rest, right - 410 rest <- lookup *rest-ah - 411 var second-ah/eax: (addr handle cell) <- get rest, left - 412 debug-print "T2", 4/fg, 0/bg - 413 evaluate second-ah, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number - 414 debug-print "U2", 4/fg, 0/bg - 415 # errors? skip - 416 { - 417 var error?/eax: boolean <- has-errors? trace - 418 compare error?, 0/false - 419 break-if-= - 420 trace-higher trace - 421 return - 422 } - 423 trace-higher trace - 424 return - 425 } - 426 $evaluate:if: { - 427 # trees starting with "if" are conditionals - 428 var expr/esi: (addr cell) <- copy in - 429 # if its first elem is not "if", break - 430 var first-ah/ecx: (addr handle cell) <- get in, left - 431 var rest-ah/edx: (addr handle cell) <- get in, right - 432 var first/eax: (addr cell) <- lookup *first-ah - 433 var if?/eax: boolean <- symbol-equal? first, "if" - 434 compare if?, 0/false - 435 break-if-= - 436 # - 437 trace-text trace, "eval", "if" - 438 trace-text trace, "eval", "evaluating first arg" - 439 var rest/eax: (addr cell) <- lookup *rest-ah - 440 var first-arg-ah/ecx: (addr handle cell) <- get rest, left - 441 var guard-h: (handle cell) - 442 var guard-ah/esi: (addr handle cell) <- address guard-h - 443 debug-print "R", 4/fg, 0/bg - 444 evaluate first-arg-ah, guard-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number - 445 debug-print "S", 4/fg, 0/bg - 446 # errors? skip - 447 { - 448 var error?/eax: boolean <- has-errors? trace - 449 compare error?, 0/false - 450 break-if-= + 302 trace-higher trace + 303 return + 304 } + 305 trace-text trace, "eval", "saving global binding" + 306 var first-arg/eax: (addr cell) <- lookup *first-arg-ah + 307 var first-arg-data-ah/eax: (addr handle stream byte) <- get first-arg, text-data + 308 var first-arg-data/eax: (addr stream byte) <- lookup *first-arg-data-ah + 309 var tmp-string: (handle array byte) + 310 var tmp-ah/edx: (addr handle array byte) <- address tmp-string + 311 rewind-stream first-arg-data + 312 stream-to-array first-arg-data, tmp-ah + 313 var first-arg-data-string/eax: (addr array byte) <- lookup *tmp-ah + 314 var out-ah/edi: (addr handle cell) <- copy _out-ah + 315 var defined-index: int + 316 var defined-index-addr/ecx: (addr int) <- address defined-index + 317 assign-or-create-global globals, first-arg-data-string, *out-ah, defined-index-addr, trace + 318 { + 319 compare definitions-created, 0 + 320 break-if-= + 321 write-to-stream definitions-created, defined-index-addr + 322 } + 323 trace-higher trace + 324 return + 325 } + 326 $evaluate:set: { + 327 # trees starting with "set" mutate bindings + 328 var expr/esi: (addr cell) <- copy in + 329 # if its first elem is not "set", break + 330 var first-ah/ecx: (addr handle cell) <- get in, left + 331 var rest-ah/edx: (addr handle cell) <- get in, right + 332 var first/eax: (addr cell) <- lookup *first-ah + 333 var set?/eax: boolean <- symbol-equal? first, "set" + 334 compare set?, 0/false + 335 break-if-= + 336 # + 337 trace-text trace, "eval", "set" + 338 trace-text trace, "eval", "evaluating second arg" + 339 var rest/eax: (addr cell) <- lookup *rest-ah + 340 var first-arg-ah/ecx: (addr handle cell) <- get rest, left + 341 { + 342 var first-arg/eax: (addr cell) <- lookup *first-arg-ah + 343 var first-arg-type/eax: (addr int) <- get first-arg, type + 344 compare *first-arg-type, 2/symbol + 345 break-if-= + 346 error trace, "first arg to set must be a symbol" + 347 trace-higher trace + 348 return + 349 } + 350 rest-ah <- get rest, right + 351 rest <- lookup *rest-ah + 352 var second-arg-ah/edx: (addr handle cell) <- get rest, left + 353 debug-print "P", 4/fg, 0/bg + 354 evaluate second-arg-ah, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + 355 debug-print "Q", 4/fg, 0/bg + 356 # errors? skip + 357 { + 358 var error?/eax: boolean <- has-errors? trace + 359 compare error?, 0/false + 360 break-if-= + 361 trace-higher trace + 362 return + 363 } + 364 trace-text trace, "eval", "mutating binding" + 365 var first-arg/eax: (addr cell) <- lookup *first-arg-ah + 366 var first-arg-data-ah/eax: (addr handle stream byte) <- get first-arg, text-data + 367 var first-arg-data/eax: (addr stream byte) <- lookup *first-arg-data-ah + 368 mutate-binding first-arg-data, _out-ah, env-h, globals, trace + 369 trace-higher trace + 370 return + 371 } + 372 $evaluate:and: { + 373 var expr/esi: (addr cell) <- copy in + 374 # if its first elem is not "and", break + 375 var first-ah/ecx: (addr handle cell) <- get in, left + 376 var rest-ah/edx: (addr handle cell) <- get in, right + 377 var first/eax: (addr cell) <- lookup *first-ah + 378 var and?/eax: boolean <- symbol-equal? first, "and" + 379 compare and?, 0/false + 380 break-if-= + 381 # + 382 trace-text trace, "eval", "and" + 383 trace-text trace, "eval", "evaluating first arg" + 384 var rest/eax: (addr cell) <- lookup *rest-ah + 385 var first-arg-ah/ecx: (addr handle cell) <- get rest, left + 386 debug-print "R2", 4/fg, 0/bg + 387 evaluate first-arg-ah, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + 388 debug-print "S2", 4/fg, 0/bg + 389 # errors? skip + 390 { + 391 var error?/eax: boolean <- has-errors? trace + 392 compare error?, 0/false + 393 break-if-= + 394 trace-higher trace + 395 return + 396 } + 397 # if first arg is nil, short-circuit + 398 var out-ah/eax: (addr handle cell) <- copy _out-ah + 399 var out/eax: (addr cell) <- lookup *out-ah + 400 var nil?/eax: boolean <- nil? out + 401 compare nil?, 0/false + 402 { + 403 break-if-= + 404 trace-higher trace + 405 return + 406 } + 407 # + 408 trace-text trace, "eval", "evaluating second arg" + 409 var rest/eax: (addr cell) <- lookup *rest-ah + 410 rest-ah <- get rest, right + 411 rest <- lookup *rest-ah + 412 var second-ah/eax: (addr handle cell) <- get rest, left + 413 debug-print "T2", 4/fg, 0/bg + 414 evaluate second-ah, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + 415 debug-print "U2", 4/fg, 0/bg + 416 trace-higher trace + 417 return + 418 } + 419 $evaluate:or: { + 420 var expr/esi: (addr cell) <- copy in + 421 # if its first elem is not "or", break + 422 var first-ah/ecx: (addr handle cell) <- get in, left + 423 var rest-ah/edx: (addr handle cell) <- get in, right + 424 var first/eax: (addr cell) <- lookup *first-ah + 425 var or?/eax: boolean <- symbol-equal? first, "or" + 426 compare or?, 0/false + 427 break-if-= + 428 # + 429 trace-text trace, "eval", "or" + 430 trace-text trace, "eval", "evaluating first arg" + 431 var rest/eax: (addr cell) <- lookup *rest-ah + 432 var first-arg-ah/ecx: (addr handle cell) <- get rest, left + 433 debug-print "R2", 4/fg, 0/bg + 434 evaluate first-arg-ah, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + 435 debug-print "S2", 4/fg, 0/bg + 436 # errors? skip + 437 { + 438 var error?/eax: boolean <- has-errors? trace + 439 compare error?, 0/false + 440 break-if-= + 441 trace-higher trace + 442 return + 443 } + 444 # if first arg is not nil, short-circuit + 445 var out-ah/eax: (addr handle cell) <- copy _out-ah + 446 var out/eax: (addr cell) <- lookup *out-ah + 447 var nil?/eax: boolean <- nil? out + 448 compare nil?, 0/false + 449 { + 450 break-if-!= 451 trace-higher trace 452 return 453 } - 454 rest-ah <- get rest, right - 455 rest <- lookup *rest-ah - 456 var branch-ah/edi: (addr handle cell) <- get rest, left - 457 var guard-a/eax: (addr cell) <- lookup *guard-ah - 458 var skip-to-third-arg?/eax: boolean <- nil? guard-a - 459 compare skip-to-third-arg?, 0/false - 460 { - 461 break-if-= - 462 trace-text trace, "eval", "skipping to third arg" - 463 var rest/eax: (addr cell) <- lookup *rest-ah - 464 rest-ah <- get rest, right - 465 rest <- lookup *rest-ah - 466 branch-ah <- get rest, left - 467 } - 468 debug-print "T", 4/fg, 0/bg - 469 evaluate branch-ah, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number - 470 debug-print "U", 4/fg, 0/bg + 454 # + 455 trace-text trace, "eval", "evaluating second arg" + 456 var rest/eax: (addr cell) <- lookup *rest-ah + 457 rest-ah <- get rest, right + 458 rest <- lookup *rest-ah + 459 var second-ah/eax: (addr handle cell) <- get rest, left + 460 debug-print "T2", 4/fg, 0/bg + 461 evaluate second-ah, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + 462 debug-print "U2", 4/fg, 0/bg + 463 # errors? skip + 464 { + 465 var error?/eax: boolean <- has-errors? trace + 466 compare error?, 0/false + 467 break-if-= + 468 trace-higher trace + 469 return + 470 } 471 trace-higher trace 472 return 473 } - 474 $evaluate:while: { - 475 # trees starting with "while" are loops + 474 $evaluate:if: { + 475 # trees starting with "if" are conditionals 476 var expr/esi: (addr cell) <- copy in - 477 # if its first elem is not "while", break + 477 # if its first elem is not "if", break 478 var first-ah/ecx: (addr handle cell) <- get in, left 479 var rest-ah/edx: (addr handle cell) <- get in, right 480 var first/eax: (addr cell) <- lookup *first-ah - 481 var first-type/ecx: (addr int) <- get first, type - 482 compare *first-type, 2/symbol - 483 break-if-!= - 484 var sym-data-ah/eax: (addr handle stream byte) <- get first, text-data - 485 var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah - 486 var while?/eax: boolean <- stream-data-equal? sym-data, "while" - 487 compare while?, 0/false - 488 break-if-= - 489 # - 490 trace-text trace, "eval", "while" - 491 var rest/eax: (addr cell) <- lookup *rest-ah - 492 var first-arg-ah/ecx: (addr handle cell) <- get rest, left - 493 rest-ah <- get rest, right - 494 var guard-h: (handle cell) - 495 var guard-ah/esi: (addr handle cell) <- address guard-h - 496 $evaluate:while:loop-execution: { - 497 { - 498 var error?/eax: boolean <- has-errors? trace - 499 compare error?, 0/false - 500 break-if-!= $evaluate:while:loop-execution - 501 } - 502 trace-text trace, "eval", "loop termination check" - 503 debug-print "V", 4/fg, 0/bg - 504 evaluate first-arg-ah, guard-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number - 505 debug-print "W", 4/fg, 0/bg - 506 # errors? skip - 507 { - 508 var error?/eax: boolean <- has-errors? trace - 509 compare error?, 0/false - 510 break-if-= - 511 trace-higher trace - 512 return - 513 } - 514 var guard-a/eax: (addr cell) <- lookup *guard-ah - 515 var done?/eax: boolean <- nil? guard-a - 516 compare done?, 0/false - 517 break-if-!= - 518 evaluate-exprs rest-ah, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number - 519 # errors? skip - 520 { - 521 var error?/eax: boolean <- has-errors? trace - 522 compare error?, 0/false - 523 break-if-= - 524 trace-higher trace - 525 return - 526 } - 527 loop - 528 } - 529 trace-text trace, "eval", "loop terminated" - 530 trace-higher trace - 531 return - 532 } - 533 +-- 15 lines: # trace "evaluate function call elements in " in -------------------------------------------------------------------------------------------------------------------------- - 548 trace-lower trace - 549 var evaluated-list-storage: (handle cell) - 550 var evaluated-list-ah/esi: (addr handle cell) <- address evaluated-list-storage - 551 var curr-out-ah/edx: (addr handle cell) <- copy evaluated-list-ah - 552 var curr/ecx: (addr cell) <- copy in - 553 $evaluate-list:loop: { - 554 allocate-pair curr-out-ah - 555 var nil?/eax: boolean <- nil? curr - 556 compare nil?, 0/false - 557 break-if-!= - 558 # eval left - 559 var curr-out/eax: (addr cell) <- lookup *curr-out-ah - 560 var left-out-ah/edi: (addr handle cell) <- get curr-out, left - 561 var left-ah/esi: (addr handle cell) <- get curr, left - 562 debug-print "A", 4/fg, 0/bg - 563 evaluate left-ah, left-out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number - 564 debug-print "B", 4/fg, 0/bg - 565 # errors? skip - 566 { - 567 var error?/eax: boolean <- has-errors? trace - 568 compare error?, 0/false - 569 break-if-= - 570 trace-higher trace - 571 trace-higher trace - 572 return - 573 } - 574 # - 575 curr-out-ah <- get curr-out, right - 576 var right-ah/eax: (addr handle cell) <- get curr, right - 577 var right/eax: (addr cell) <- lookup *right-ah - 578 curr <- copy right - 579 loop + 481 var if?/eax: boolean <- symbol-equal? first, "if" + 482 compare if?, 0/false + 483 break-if-= + 484 # + 485 trace-text trace, "eval", "if" + 486 trace-text trace, "eval", "evaluating first arg" + 487 var rest/eax: (addr cell) <- lookup *rest-ah + 488 var first-arg-ah/ecx: (addr handle cell) <- get rest, left + 489 var guard-h: (handle cell) + 490 var guard-ah/esi: (addr handle cell) <- address guard-h + 491 debug-print "R", 4/fg, 0/bg + 492 evaluate first-arg-ah, guard-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + 493 debug-print "S", 4/fg, 0/bg + 494 # errors? skip + 495 { + 496 var error?/eax: boolean <- has-errors? trace + 497 compare error?, 0/false + 498 break-if-= + 499 trace-higher trace + 500 return + 501 } + 502 rest-ah <- get rest, right + 503 rest <- lookup *rest-ah + 504 var branch-ah/edi: (addr handle cell) <- get rest, left + 505 var guard-a/eax: (addr cell) <- lookup *guard-ah + 506 var skip-to-third-arg?/eax: boolean <- nil? guard-a + 507 compare skip-to-third-arg?, 0/false + 508 { + 509 break-if-= + 510 trace-text trace, "eval", "skipping to third arg" + 511 var rest/eax: (addr cell) <- lookup *rest-ah + 512 rest-ah <- get rest, right + 513 rest <- lookup *rest-ah + 514 branch-ah <- get rest, left + 515 } + 516 debug-print "T", 4/fg, 0/bg + 517 evaluate branch-ah, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + 518 debug-print "U", 4/fg, 0/bg + 519 trace-higher trace + 520 return + 521 } + 522 $evaluate:while: { + 523 # trees starting with "while" are loops + 524 var expr/esi: (addr cell) <- copy in + 525 # if its first elem is not "while", break + 526 var first-ah/ecx: (addr handle cell) <- get in, left + 527 var rest-ah/edx: (addr handle cell) <- get in, right + 528 var first/eax: (addr cell) <- lookup *first-ah + 529 var first-type/ecx: (addr int) <- get first, type + 530 compare *first-type, 2/symbol + 531 break-if-!= + 532 var sym-data-ah/eax: (addr handle stream byte) <- get first, text-data + 533 var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah + 534 var while?/eax: boolean <- stream-data-equal? sym-data, "while" + 535 compare while?, 0/false + 536 break-if-= + 537 # + 538 trace-text trace, "eval", "while" + 539 var rest/eax: (addr cell) <- lookup *rest-ah + 540 var first-arg-ah/ecx: (addr handle cell) <- get rest, left + 541 rest-ah <- get rest, right + 542 var guard-h: (handle cell) + 543 var guard-ah/esi: (addr handle cell) <- address guard-h + 544 $evaluate:while:loop-execution: { + 545 { + 546 var error?/eax: boolean <- has-errors? trace + 547 compare error?, 0/false + 548 break-if-!= $evaluate:while:loop-execution + 549 } + 550 trace-text trace, "eval", "loop termination check" + 551 debug-print "V", 4/fg, 0/bg + 552 evaluate first-arg-ah, guard-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + 553 debug-print "W", 4/fg, 0/bg + 554 # errors? skip + 555 { + 556 var error?/eax: boolean <- has-errors? trace + 557 compare error?, 0/false + 558 break-if-= + 559 trace-higher trace + 560 return + 561 } + 562 var guard-a/eax: (addr cell) <- lookup *guard-ah + 563 var done?/eax: boolean <- nil? guard-a + 564 compare done?, 0/false + 565 break-if-!= + 566 evaluate-exprs rest-ah, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + 567 # errors? skip + 568 { + 569 var error?/eax: boolean <- has-errors? trace + 570 compare error?, 0/false + 571 break-if-= + 572 trace-higher trace + 573 return + 574 } + 575 loop + 576 } + 577 trace-text trace, "eval", "loop terminated" + 578 trace-higher trace + 579 return 580 } - 581 trace-higher trace - 582 var evaluated-list/eax: (addr cell) <- lookup *evaluated-list-ah - 583 var function-ah/ecx: (addr handle cell) <- get evaluated-list, left - 584 var args-ah/edx: (addr handle cell) <- get evaluated-list, right - 585 debug-print "C", 4/fg, 0/bg - 586 apply function-ah, args-ah, _out-ah, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number - 587 debug-print "Y", 4/fg, 0/bg - 588 trace-higher trace - 589 +-- 15 lines: # trace "=> " _out-ah ----------------------------------------------------------------------------------------------------------------------------------------------------- - 604 debug-print "Z", 4/fg, 0/bg - 605 } - 606 - 607 fn apply _f-ah: (addr handle cell), args-ah: (addr handle cell), out: (addr handle cell), globals: (addr global-table), trace: (addr trace), inner-screen-var: (addr handle cell), inner-keyboard-var: (addr handle cell), definitions-created: (addr stream int), call-number: (addr int) { - 608 var f-ah/eax: (addr handle cell) <- copy _f-ah - 609 var _f/eax: (addr cell) <- lookup *f-ah - 610 var f/esi: (addr cell) <- copy _f - 611 # call primitive functions - 612 { - 613 var f-type/eax: (addr int) <- get f, type - 614 compare *f-type, 4/primitive-function - 615 break-if-!= - 616 apply-primitive f, args-ah, out, globals, trace - 617 return - 618 } - 619 # if it's not a primitive function it must be an anonymous function - 620 +-- 19 lines: # trace "apply anonymous function " f " in environment " env -------------------------------------------------------------------------------------------------------------- - 639 trace-lower trace - 640 { - 641 var f-type/ecx: (addr int) <- get f, type - 642 compare *f-type, 0/pair - 643 break-if-!= - 644 var first-ah/eax: (addr handle cell) <- get f, left - 645 var first/eax: (addr cell) <- lookup *first-ah - 646 var litfn?/eax: boolean <- litfn? first - 647 compare litfn?, 0/false - 648 break-if-= - 649 var rest-ah/esi: (addr handle cell) <- get f, right - 650 var rest/eax: (addr cell) <- lookup *rest-ah - 651 var callee-env-ah/edx: (addr handle cell) <- get rest, left - 652 rest-ah <- get rest, right - 653 rest <- lookup *rest-ah - 654 var params-ah/ecx: (addr handle cell) <- get rest, left - 655 var body-ah/eax: (addr handle cell) <- get rest, right - 656 debug-print "D", 7/fg, 0/bg - 657 apply-function params-ah, args-ah, body-ah, out, *callee-env-ah, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number - 658 debug-print "Y", 7/fg, 0/bg - 659 trace-higher trace - 660 return - 661 } - 662 error trace, "unknown function" - 663 } - 664 - 665 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), inner-screen-var: (addr handle cell), inner-keyboard-var: (addr handle cell), definitions-created: (addr stream int), call-number: (addr int) { - 666 # push bindings for params to env - 667 var new-env-h: (handle cell) - 668 var new-env-ah/esi: (addr handle cell) <- address new-env-h - 669 push-bindings params-ah, args-ah, env-h, new-env-ah, trace - 670 # errors? skip - 671 { - 672 var error?/eax: boolean <- has-errors? trace - 673 compare error?, 0/false - 674 break-if-= - 675 return - 676 } - 677 # - 678 evaluate-exprs body-ah, out, new-env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number - 679 } - 680 - 681 fn evaluate-exprs _exprs-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), inner-screen-var: (addr handle cell), inner-keyboard-var: (addr handle cell), definitions-created: (addr stream int), call-number: (addr int) { - 682 # eval all exprs, writing result to `out` each time - 683 var exprs-ah/ecx: (addr handle cell) <- copy _exprs-ah - 684 $evaluate-exprs:loop: { - 685 var exprs/eax: (addr cell) <- lookup *exprs-ah - 686 # stop when exprs is nil - 687 { - 688 var exprs-nil?/eax: boolean <- nil? exprs - 689 compare exprs-nil?, 0/false - 690 break-if-!= $evaluate-exprs:loop - 691 } - 692 # evaluate each expression, writing result to `out` - 693 { - 694 var curr-ah/eax: (addr handle cell) <- get exprs, left - 695 debug-print "E", 7/fg, 0/bg - 696 evaluate curr-ah, out, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number - 697 debug-print "X", 7/fg, 0/bg - 698 # errors? skip - 699 { - 700 var error?/eax: boolean <- has-errors? trace - 701 compare error?, 0/false - 702 break-if-= - 703 return - 704 } - 705 } - 706 # - 707 exprs-ah <- get exprs, right - 708 loop + 581 +-- 15 lines: # trace "evaluate function call elements in " in ----------------------------------------------------------------------------------------------------------------------------------------------------- + 596 trace-lower trace + 597 var evaluated-list-storage: (handle cell) + 598 var evaluated-list-ah/esi: (addr handle cell) <- address evaluated-list-storage + 599 var curr-out-ah/edx: (addr handle cell) <- copy evaluated-list-ah + 600 var curr/ecx: (addr cell) <- copy in + 601 $evaluate-list:loop: { + 602 allocate-pair curr-out-ah + 603 var nil?/eax: boolean <- nil? curr + 604 compare nil?, 0/false + 605 break-if-!= + 606 # eval left + 607 var curr-out/eax: (addr cell) <- lookup *curr-out-ah + 608 var left-out-ah/edi: (addr handle cell) <- get curr-out, left + 609 var left-ah/esi: (addr handle cell) <- get curr, left + 610 debug-print "A", 4/fg, 0/bg + 611 evaluate left-ah, left-out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + 612 debug-print "B", 4/fg, 0/bg + 613 # errors? skip + 614 { + 615 var error?/eax: boolean <- has-errors? trace + 616 compare error?, 0/false + 617 break-if-= + 618 trace-higher trace + 619 trace-higher trace + 620 return + 621 } + 622 # + 623 curr-out-ah <- get curr-out, right + 624 var right-ah/eax: (addr handle cell) <- get curr, right + 625 var right/eax: (addr cell) <- lookup *right-ah + 626 curr <- copy right + 627 loop + 628 } + 629 trace-higher trace + 630 var evaluated-list/eax: (addr cell) <- lookup *evaluated-list-ah + 631 var function-ah/ecx: (addr handle cell) <- get evaluated-list, left + 632 var args-ah/edx: (addr handle cell) <- get evaluated-list, right + 633 debug-print "C", 4/fg, 0/bg + 634 apply function-ah, args-ah, _out-ah, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + 635 debug-print "Y", 4/fg, 0/bg + 636 trace-higher trace + 637 +-- 15 lines: # trace "=> " _out-ah -------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- + 652 debug-print "Z", 4/fg, 0/bg + 653 } + 654 + 655 fn apply _f-ah: (addr handle cell), args-ah: (addr handle cell), out: (addr handle cell), globals: (addr global-table), trace: (addr trace), inner-screen-var: (addr handle cell), inner-keyboard-var: (addr handle cell), definitions-created: (addr stream int), call-number: (addr int) { + 656 var f-ah/eax: (addr handle cell) <- copy _f-ah + 657 var _f/eax: (addr cell) <- lookup *f-ah + 658 var f/esi: (addr cell) <- copy _f + 659 # call primitive functions + 660 { + 661 var f-type/eax: (addr int) <- get f, type + 662 compare *f-type, 4/primitive-function + 663 break-if-!= + 664 apply-primitive f, args-ah, out, globals, trace + 665 return + 666 } + 667 # if it's not a primitive function it must be an anonymous function + 668 +-- 19 lines: # trace "apply anonymous function " f " in environment " env ----------------------------------------------------------------------------------------------------------------------------------------- + 687 trace-lower trace + 688 { + 689 var f-type/ecx: (addr int) <- get f, type + 690 compare *f-type, 0/pair + 691 break-if-!= + 692 var first-ah/eax: (addr handle cell) <- get f, left + 693 var first/eax: (addr cell) <- lookup *first-ah + 694 var litfn?/eax: boolean <- litfn? first + 695 compare litfn?, 0/false + 696 break-if-= + 697 var rest-ah/esi: (addr handle cell) <- get f, right + 698 var rest/eax: (addr cell) <- lookup *rest-ah + 699 var callee-env-ah/edx: (addr handle cell) <- get rest, left + 700 rest-ah <- get rest, right + 701 rest <- lookup *rest-ah + 702 var params-ah/ecx: (addr handle cell) <- get rest, left + 703 var body-ah/eax: (addr handle cell) <- get rest, right + 704 debug-print "D", 7/fg, 0/bg + 705 apply-function params-ah, args-ah, body-ah, out, *callee-env-ah, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + 706 debug-print "Y", 7/fg, 0/bg + 707 trace-higher trace + 708 return 709 } - 710 # `out` contains result of evaluating final expression + 710 error trace, "unknown function" 711 } 712 - 713 # Bind params to corresponding args and add the bindings to old-env. Return - 714 # the result in env-ah. - 715 # - 716 # We never modify old-env, but we point to it. This way other parts of the - 717 # interpreter can continue using old-env, and everything works harmoniously - 718 # even though no cells are copied around. - 719 # - 720 # env should always be a DAG (ignoring internals of values). It doesn't have - 721 # to be a tree (some values may be shared), but there are also no cycles. - 722 # - 723 # Learn more: https://en.wikipedia.org/wiki/Persistent_data_structure - 724 fn push-bindings _params-ah: (addr handle cell), _args-ah: (addr handle cell), old-env-h: (handle cell), env-ah: (addr handle cell), trace: (addr trace) { - 725 var params-ah/edx: (addr handle cell) <- copy _params-ah - 726 var args-ah/ebx: (addr handle cell) <- copy _args-ah - 727 var _params/eax: (addr cell) <- lookup *params-ah - 728 var params/esi: (addr cell) <- copy _params - 729 { - 730 var params-nil?/eax: boolean <- nil? params - 731 compare params-nil?, 0/false - 732 break-if-= - 733 # nil is a literal - 734 trace-text trace, "eval", "done with push-bindings" - 735 copy-handle old-env-h, env-ah - 736 return - 737 } - 738 # Params can only be symbols or pairs. Args can be anything. - 739 +-- 22 lines: # trace "pushing bindings from " params " to " args ----------------------------------------------------------------------------------------------------------------------- - 761 trace-lower trace - 762 var params-type/eax: (addr int) <- get params, type - 763 compare *params-type, 2/symbol - 764 { - 765 break-if-!= - 766 trace-text trace, "eval", "symbol; binding to all remaining args" - 767 # create a new binding - 768 var new-binding-storage: (handle cell) - 769 var new-binding-ah/eax: (addr handle cell) <- address new-binding-storage - 770 new-pair new-binding-ah, *params-ah, *args-ah - 771 # push it to env - 772 new-pair env-ah, *new-binding-ah, old-env-h - 773 trace-higher trace - 774 return - 775 } - 776 compare *params-type, 0/pair + 713 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), inner-screen-var: (addr handle cell), inner-keyboard-var: (addr handle cell), definitions-created: (addr stream int), call-number: (addr int) { + 714 # push bindings for params to env + 715 var new-env-h: (handle cell) + 716 var new-env-ah/esi: (addr handle cell) <- address new-env-h + 717 push-bindings params-ah, args-ah, env-h, new-env-ah, trace + 718 # errors? skip + 719 { + 720 var error?/eax: boolean <- has-errors? trace + 721 compare error?, 0/false + 722 break-if-= + 723 return + 724 } + 725 # + 726 evaluate-exprs body-ah, out, new-env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + 727 } + 728 + 729 fn evaluate-exprs _exprs-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), inner-screen-var: (addr handle cell), inner-keyboard-var: (addr handle cell), definitions-created: (addr stream int), call-number: (addr int) { + 730 # eval all exprs, writing result to `out` each time + 731 var exprs-ah/ecx: (addr handle cell) <- copy _exprs-ah + 732 $evaluate-exprs:loop: { + 733 var exprs/eax: (addr cell) <- lookup *exprs-ah + 734 # stop when exprs is nil + 735 { + 736 var exprs-nil?/eax: boolean <- nil? exprs + 737 compare exprs-nil?, 0/false + 738 break-if-!= $evaluate-exprs:loop + 739 } + 740 # evaluate each expression, writing result to `out` + 741 { + 742 var curr-ah/eax: (addr handle cell) <- get exprs, left + 743 debug-print "E", 7/fg, 0/bg + 744 evaluate curr-ah, out, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + 745 debug-print "X", 7/fg, 0/bg + 746 # errors? skip + 747 { + 748 var error?/eax: boolean <- has-errors? trace + 749 compare error?, 0/false + 750 break-if-= + 751 return + 752 } + 753 } + 754 # + 755 exprs-ah <- get exprs, right + 756 loop + 757 } + 758 # `out` contains result of evaluating final expression + 759 } + 760 + 761 # Bind params to corresponding args and add the bindings to old-env. Return + 762 # the result in env-ah. + 763 # + 764 # We never modify old-env, but we point to it. This way other parts of the + 765 # interpreter can continue using old-env, and everything works harmoniously + 766 # even though no cells are copied around. + 767 # + 768 # env should always be a DAG (ignoring internals of values). It doesn't have + 769 # to be a tree (some values may be shared), but there are also no cycles. + 770 # + 771 # Learn more: https://en.wikipedia.org/wiki/Persistent_data_structure + 772 fn push-bindings _params-ah: (addr handle cell), _args-ah: (addr handle cell), old-env-h: (handle cell), env-ah: (addr handle cell), trace: (addr trace) { + 773 var params-ah/edx: (addr handle cell) <- copy _params-ah + 774 var args-ah/ebx: (addr handle cell) <- copy _args-ah + 775 var _params/eax: (addr cell) <- lookup *params-ah + 776 var params/esi: (addr cell) <- copy _params 777 { - 778 break-if-= - 779 error trace, "cannot bind a non-symbol" - 780 trace-higher trace - 781 return - 782 } - 783 var _args/eax: (addr cell) <- lookup *args-ah - 784 var args/edi: (addr cell) <- copy _args - 785 # params is now a pair, so args must be also - 786 { - 787 var args-nil?/eax: boolean <- nil? args - 788 compare args-nil?, 0/false - 789 break-if-= - 790 error trace, "not enough args to bind" - 791 return - 792 } - 793 var args-type/eax: (addr int) <- get args, type - 794 compare *args-type, 0/pair - 795 { - 796 break-if-= - 797 error trace, "args not in a proper list" - 798 trace-higher trace - 799 return - 800 } - 801 var intermediate-env-storage: (handle cell) - 802 var intermediate-env-ah/edx: (addr handle cell) <- address intermediate-env-storage - 803 var first-param-ah/eax: (addr handle cell) <- get params, left - 804 var first-arg-ah/ecx: (addr handle cell) <- get args, left - 805 push-bindings first-param-ah, first-arg-ah, old-env-h, intermediate-env-ah, trace - 806 # errors? skip - 807 { - 808 var error?/eax: boolean <- has-errors? trace - 809 compare error?, 0/false - 810 break-if-= - 811 trace-higher trace - 812 return - 813 } - 814 var remaining-params-ah/eax: (addr handle cell) <- get params, right - 815 var remaining-args-ah/ecx: (addr handle cell) <- get args, right - 816 push-bindings remaining-params-ah, remaining-args-ah, *intermediate-env-ah, env-ah, trace - 817 trace-higher trace - 818 } - 819 - 820 fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), inner-screen-var: (addr handle cell), inner-keyboard-var: (addr handle cell) { - 821 # trace sym - 822 { - 823 var should-trace?/eax: boolean <- should-trace? trace - 824 compare should-trace?, 0/false - 825 break-if-= - 826 var stream-storage: (stream byte 0x800) # pessimistically sized just for the large alist loaded from disk in `main` - 827 var stream/ecx: (addr stream byte) <- address stream-storage - 828 write stream, "look up " - 829 var sym2/eax: (addr cell) <- copy sym - 830 var sym-data-ah/eax: (addr handle stream byte) <- get sym2, text-data - 831 var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah - 832 rewind-stream sym-data - 833 write-stream stream, sym-data - 834 write stream, " in " - 835 var env-ah/eax: (addr handle cell) <- address env-h - 836 var nested-trace-storage: trace - 837 var nested-trace/edi: (addr trace) <- address nested-trace-storage - 838 initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible - 839 print-cell env-ah, stream, nested-trace - 840 trace trace, "eval", stream - 841 } - 842 trace-lower trace - 843 var _env/eax: (addr cell) <- lookup env-h - 844 var env/ebx: (addr cell) <- copy _env - 845 # if env is not a list, error - 846 { - 847 var env-type/ecx: (addr int) <- get env, type - 848 compare *env-type, 0/pair - 849 break-if-= - 850 error trace, "eval found a non-list environment" - 851 trace-higher trace - 852 return - 853 } - 854 # if env is nil, look up in globals + 778 var params-nil?/eax: boolean <- nil? params + 779 compare params-nil?, 0/false + 780 break-if-= + 781 # nil is a literal + 782 trace-text trace, "eval", "done with push-bindings" + 783 copy-handle old-env-h, env-ah + 784 return + 785 } + 786 # Params can only be symbols or pairs. Args can be anything. + 787 +-- 22 lines: # trace "pushing bindings from " params " to " args -------------------------------------------------------------------------------------------------------------------------------------------------- + 809 trace-lower trace + 810 var params-type/eax: (addr int) <- get params, type + 811 compare *params-type, 2/symbol + 812 { + 813 break-if-!= + 814 trace-text trace, "eval", "symbol; binding to all remaining args" + 815 # create a new binding + 816 var new-binding-storage: (handle cell) + 817 var new-binding-ah/eax: (addr handle cell) <- address new-binding-storage + 818 new-pair new-binding-ah, *params-ah, *args-ah + 819 # push it to env + 820 new-pair env-ah, *new-binding-ah, old-env-h + 821 trace-higher trace + 822 return + 823 } + 824 compare *params-type, 0/pair + 825 { + 826 break-if-= + 827 error trace, "cannot bind a non-symbol" + 828 trace-higher trace + 829 return + 830 } + 831 var _args/eax: (addr cell) <- lookup *args-ah + 832 var args/edi: (addr cell) <- copy _args + 833 # params is now a pair, so args must be also + 834 { + 835 var args-nil?/eax: boolean <- nil? args + 836 compare args-nil?, 0/false + 837 break-if-= + 838 error trace, "not enough args to bind" + 839 return + 840 } + 841 var args-type/eax: (addr int) <- get args, type + 842 compare *args-type, 0/pair + 843 { + 844 break-if-= + 845 error trace, "args not in a proper list" + 846 trace-higher trace + 847 return + 848 } + 849 var intermediate-env-storage: (handle cell) + 850 var intermediate-env-ah/edx: (addr handle cell) <- address intermediate-env-storage + 851 var first-param-ah/eax: (addr handle cell) <- get params, left + 852 var first-arg-ah/ecx: (addr handle cell) <- get args, left + 853 push-bindings first-param-ah, first-arg-ah, old-env-h, intermediate-env-ah, trace + 854 # errors? skip 855 { - 856 var env-nil?/eax: boolean <- nil? env - 857 compare env-nil?, 0/false + 856 var error?/eax: boolean <- has-errors? trace + 857 compare error?, 0/false 858 break-if-= - 859 debug-print "b", 7/fg, 0/bg - 860 lookup-symbol-in-globals sym, out, globals, trace, inner-screen-var, inner-keyboard-var - 861 debug-print "x", 7/fg, 0/bg - 862 trace-higher trace - 863 +-- 19 lines: # trace "=> " out " (global)" --------------------------------------------------------------------------------------------------------------------------------------------- - 882 debug-print "y", 7/fg, 0/bg - 883 return - 884 } - 885 # check car - 886 var env-head-storage: (handle cell) - 887 var env-head-ah/eax: (addr handle cell) <- address env-head-storage - 888 car env, env-head-ah, trace - 889 var _env-head/eax: (addr cell) <- lookup *env-head-ah - 890 var env-head/ecx: (addr cell) <- copy _env-head - 891 # if car is not a list, abort - 892 { - 893 var env-head-type/eax: (addr int) <- get env-head, type - 894 compare *env-head-type, 0/pair - 895 break-if-= - 896 error trace, "environment is not a list of (key . value) pairs" - 897 trace-higher trace - 898 return - 899 } - 900 # check key - 901 var curr-key-storage: (handle cell) - 902 var curr-key-ah/eax: (addr handle cell) <- address curr-key-storage - 903 car env-head, curr-key-ah, trace - 904 var curr-key/eax: (addr cell) <- lookup *curr-key-ah - 905 # if key is not a symbol, abort - 906 { - 907 var curr-key-type/eax: (addr int) <- get curr-key, type - 908 compare *curr-key-type, 2/symbol - 909 break-if-= - 910 error trace, "environment contains a binding for a non-symbol" - 911 trace-higher trace - 912 return - 913 } - 914 # if key matches sym, return val - 915 var match?/eax: boolean <- cell-isomorphic? curr-key, sym, trace - 916 compare match?, 0/false - 917 { - 918 break-if-= - 919 cdr env-head, out, trace - 920 +-- 19 lines: # trace "=> " out " (match)" ---------------------------------------------------------------------------------------------------------------------------------------------- - 939 trace-higher trace - 940 return - 941 } - 942 # otherwise recurse - 943 var env-tail-storage: (handle cell) - 944 var env-tail-ah/eax: (addr handle cell) <- address env-tail-storage - 945 cdr env, env-tail-ah, trace - 946 lookup-symbol sym, out, *env-tail-ah, globals, trace, inner-screen-var, inner-keyboard-var - 947 trace-higher trace - 948 +-- 19 lines: # trace "=> " out " (recurse)" -------------------------------------------------------------------------------------------------------------------------------------------- - 967 } - 968 - 969 fn test-lookup-symbol-in-env { - 970 # tmp = (a . 3) - 971 var val-storage: (handle cell) - 972 var val-ah/ecx: (addr handle cell) <- address val-storage - 973 new-integer val-ah, 3 - 974 var key-storage: (handle cell) - 975 var key-ah/edx: (addr handle cell) <- address key-storage - 976 new-symbol key-ah, "a" - 977 var env-storage: (handle cell) - 978 var env-ah/ebx: (addr handle cell) <- address env-storage - 979 new-pair env-ah, *key-ah, *val-ah - 980 # env = ((a . 3)) - 981 var nil-storage: (handle cell) - 982 var nil-ah/ecx: (addr handle cell) <- address nil-storage - 983 allocate-pair nil-ah - 984 new-pair env-ah, *env-ah, *nil-ah - 985 # lookup sym(a) in env tmp - 986 var tmp-storage: (handle cell) - 987 var tmp-ah/edx: (addr handle cell) <- address tmp-storage - 988 new-symbol tmp-ah, "a" - 989 var in/eax: (addr cell) <- lookup *tmp-ah - 990 var trace-storage: trace - 991 var trace/edi: (addr trace) <- address trace-storage - 992 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible - 993 lookup-symbol in, tmp-ah, *env-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard - 994 var result/eax: (addr cell) <- lookup *tmp-ah - 995 var result-type/edx: (addr int) <- get result, type - 996 check-ints-equal *result-type, 1/number, "F - test-lookup-symbol-in-env/0" - 997 var result-value-addr/eax: (addr float) <- get result, number-data - 998 var result-value/eax: int <- convert *result-value-addr - 999 check-ints-equal result-value, 3, "F - test-lookup-symbol-in-env/1" -1000 } -1001 -1002 fn test-lookup-symbol-in-globals { -1003 var globals-storage: global-table -1004 var globals/edi: (addr global-table) <- address globals-storage -1005 initialize-globals globals -1006 # env = nil -1007 var nil-storage: (handle cell) -1008 var nil-ah/ecx: (addr handle cell) <- address nil-storage -1009 allocate-pair nil-ah -1010 # lookup sym(a), env -1011 var tmp-storage: (handle cell) -1012 var tmp-ah/ebx: (addr handle cell) <- address tmp-storage -1013 new-symbol tmp-ah, "+" -1014 var in/eax: (addr cell) <- lookup *tmp-ah -1015 var trace-storage: trace -1016 var trace/esi: (addr trace) <- address trace-storage -1017 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible -1018 lookup-symbol in, tmp-ah, *nil-ah, globals, trace, 0/no-screen, 0/no-keyboard -1019 var result/eax: (addr cell) <- lookup *tmp-ah -1020 var result-type/edx: (addr int) <- get result, type -1021 check-ints-equal *result-type, 4/primitive-function, "F - test-lookup-symbol-in-globals/0" -1022 var result-value/eax: (addr int) <- get result, index-data -1023 check-ints-equal *result-value, 1/add, "F - test-lookup-symbol-in-globals/1" -1024 } -1025 -1026 fn mutate-binding name: (addr stream byte), val: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace) { -1027 # trace name -1028 { -1029 var should-trace?/eax: boolean <- should-trace? trace -1030 compare should-trace?, 0/false -1031 break-if-= -1032 var stream-storage: (stream byte 0x800) # pessimistically sized just for the large alist loaded from disk in `main` -1033 var stream/ecx: (addr stream byte) <- address stream-storage -1034 write stream, "bind " -1035 rewind-stream name -1036 write-stream stream, name -1037 write stream, " to " -1038 var nested-trace-storage: trace -1039 var nested-trace/edi: (addr trace) <- address nested-trace-storage -1040 initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible -1041 print-cell val, stream, nested-trace -1042 write stream, " in " -1043 var env-ah/eax: (addr handle cell) <- address env-h -1044 clear-trace nested-trace -1045 print-cell env-ah, stream, nested-trace -1046 trace trace, "eval", stream -1047 } -1048 trace-lower trace -1049 var _env/eax: (addr cell) <- lookup env-h -1050 var env/ebx: (addr cell) <- copy _env -1051 # if env is not a list, abort -1052 { -1053 var env-type/ecx: (addr int) <- get env, type -1054 compare *env-type, 0/pair -1055 break-if-= -1056 error trace, "eval found a non-list environment" -1057 trace-higher trace -1058 return -1059 } -1060 # if env is nil, look in globals -1061 { -1062 var env-nil?/eax: boolean <- nil? env -1063 compare env-nil?, 0/false -1064 break-if-= -1065 debug-print "b", 3/fg, 0/bg -1066 mutate-binding-in-globals name, val, globals, trace -1067 debug-print "x", 3/fg, 0/bg -1068 trace-higher trace -1069 +-- 19 lines: # trace "=> " val " (global)" --------------------------------------------------------------------------------------------------------------------------------------------- -1088 debug-print "y", 3/fg, 0/bg -1089 return -1090 } -1091 # check car -1092 var env-head-storage: (handle cell) -1093 var env-head-ah/eax: (addr handle cell) <- address env-head-storage -1094 car env, env-head-ah, trace -1095 var _env-head/eax: (addr cell) <- lookup *env-head-ah -1096 var env-head/ecx: (addr cell) <- copy _env-head -1097 # if car is not a list, abort -1098 { -1099 var env-head-type/eax: (addr int) <- get env-head, type -1100 compare *env-head-type, 0/pair -1101 break-if-= -1102 error trace, "environment is not a list of (key . value) pairs" -1103 trace-higher trace -1104 return -1105 } -1106 # check key -1107 var curr-key-storage: (handle cell) -1108 var curr-key-ah/eax: (addr handle cell) <- address curr-key-storage -1109 car env-head, curr-key-ah, trace -1110 var curr-key/eax: (addr cell) <- lookup *curr-key-ah -1111 # if key is not a symbol, abort -1112 { -1113 var curr-key-type/eax: (addr int) <- get curr-key, type -1114 compare *curr-key-type, 2/symbol -1115 break-if-= -1116 error trace, "environment contains a binding for a non-symbol" -1117 trace-higher trace -1118 return -1119 } -1120 # if key matches name, return val -1121 var curr-key-data-ah/eax: (addr handle stream byte) <- get curr-key, text-data -1122 var curr-key-data/eax: (addr stream byte) <- lookup *curr-key-data-ah -1123 var match?/eax: boolean <- streams-data-equal? curr-key-data, name -1124 compare match?, 0/false -1125 { -1126 break-if-= -1127 var dest/eax: (addr handle cell) <- get env-head, right -1128 copy-object val, dest -1129 trace-text trace, "eval", "=> done" -1130 trace-higher trace -1131 return -1132 } -1133 # otherwise recurse -1134 var env-tail-storage: (handle cell) -1135 var env-tail-ah/eax: (addr handle cell) <- address env-tail-storage -1136 cdr env, env-tail-ah, trace -1137 mutate-binding name, val, *env-tail-ah, globals, trace -1138 trace-higher trace -1139 } -1140 -1141 fn car _in: (addr cell), out: (addr handle cell), trace: (addr trace) { -1142 trace-text trace, "eval", "car" -1143 trace-lower trace -1144 var in/eax: (addr cell) <- copy _in -1145 # if in is not a list, abort + 859 trace-higher trace + 860 return + 861 } + 862 var remaining-params-ah/eax: (addr handle cell) <- get params, right + 863 var remaining-args-ah/ecx: (addr handle cell) <- get args, right + 864 push-bindings remaining-params-ah, remaining-args-ah, *intermediate-env-ah, env-ah, trace + 865 trace-higher trace + 866 } + 867 + 868 fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), inner-screen-var: (addr handle cell), inner-keyboard-var: (addr handle cell) { + 869 # trace sym + 870 { + 871 var should-trace?/eax: boolean <- should-trace? trace + 872 compare should-trace?, 0/false + 873 break-if-= + 874 var stream-storage: (stream byte 0x800) # pessimistically sized just for the large alist loaded from disk in `main` + 875 var stream/ecx: (addr stream byte) <- address stream-storage + 876 write stream, "look up " + 877 var sym2/eax: (addr cell) <- copy sym + 878 var sym-data-ah/eax: (addr handle stream byte) <- get sym2, text-data + 879 var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah + 880 rewind-stream sym-data + 881 write-stream stream, sym-data + 882 write stream, " in " + 883 var env-ah/eax: (addr handle cell) <- address env-h + 884 var nested-trace-storage: trace + 885 var nested-trace/edi: (addr trace) <- address nested-trace-storage + 886 initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible + 887 print-cell env-ah, stream, nested-trace + 888 trace trace, "eval", stream + 889 } + 890 trace-lower trace + 891 var _env/eax: (addr cell) <- lookup env-h + 892 var env/ebx: (addr cell) <- copy _env + 893 # if env is not a list, error + 894 { + 895 var env-type/ecx: (addr int) <- get env, type + 896 compare *env-type, 0/pair + 897 break-if-= + 898 error trace, "eval found a non-list environment" + 899 trace-higher trace + 900 return + 901 } + 902 # if env is nil, look up in globals + 903 { + 904 var env-nil?/eax: boolean <- nil? env + 905 compare env-nil?, 0/false + 906 break-if-= + 907 debug-print "b", 7/fg, 0/bg + 908 lookup-symbol-in-globals sym, out, globals, trace, inner-screen-var, inner-keyboard-var + 909 debug-print "x", 7/fg, 0/bg + 910 trace-higher trace + 911 +-- 19 lines: # trace "=> " out " (global)" ------------------------------------------------------------------------------------------------------------------------------------------------------------------------ + 930 debug-print "y", 7/fg, 0/bg + 931 return + 932 } + 933 # check car + 934 var env-head-storage: (handle cell) + 935 var env-head-ah/eax: (addr handle cell) <- address env-head-storage + 936 car env, env-head-ah, trace + 937 var _env-head/eax: (addr cell) <- lookup *env-head-ah + 938 var env-head/ecx: (addr cell) <- copy _env-head + 939 # if car is not a list, abort + 940 { + 941 var env-head-type/eax: (addr int) <- get env-head, type + 942 compare *env-head-type, 0/pair + 943 break-if-= + 944 error trace, "environment is not a list of (key . value) pairs" + 945 trace-higher trace + 946 return + 947 } + 948 # check key + 949 var curr-key-storage: (handle cell) + 950 var curr-key-ah/eax: (addr handle cell) <- address curr-key-storage + 951 car env-head, curr-key-ah, trace + 952 var curr-key/eax: (addr cell) <- lookup *curr-key-ah + 953 # if key is not a symbol, abort + 954 { + 955 var curr-key-type/eax: (addr int) <- get curr-key, type + 956 compare *curr-key-type, 2/symbol + 957 break-if-= + 958 error trace, "environment contains a binding for a non-symbol" + 959 trace-higher trace + 960 return + 961 } + 962 # if key matches sym, return val + 963 var match?/eax: boolean <- cell-isomorphic? curr-key, sym, trace + 964 compare match?, 0/false + 965 { + 966 break-if-= + 967 cdr env-head, out, trace + 968 +-- 19 lines: # trace "=> " out " (match)" ------------------------------------------------------------------------------------------------------------------------------------------------------------------------- + 987 trace-higher trace + 988 return + 989 } + 990 # otherwise recurse + 991 var env-tail-storage: (handle cell) + 992 var env-tail-ah/eax: (addr handle cell) <- address env-tail-storage + 993 cdr env, env-tail-ah, trace + 994 lookup-symbol sym, out, *env-tail-ah, globals, trace, inner-screen-var, inner-keyboard-var + 995 trace-higher trace + 996 +-- 19 lines: # trace "=> " out " (recurse)" ----------------------------------------------------------------------------------------------------------------------------------------------------------------------- +1015 } +1016 +1017 fn test-lookup-symbol-in-env { +1018 # tmp = (a . 3) +1019 var val-storage: (handle cell) +1020 var val-ah/ecx: (addr handle cell) <- address val-storage +1021 new-integer val-ah, 3 +1022 var key-storage: (handle cell) +1023 var key-ah/edx: (addr handle cell) <- address key-storage +1024 new-symbol key-ah, "a" +1025 var env-storage: (handle cell) +1026 var env-ah/ebx: (addr handle cell) <- address env-storage +1027 new-pair env-ah, *key-ah, *val-ah +1028 # env = ((a . 3)) +1029 var nil-storage: (handle cell) +1030 var nil-ah/ecx: (addr handle cell) <- address nil-storage +1031 allocate-pair nil-ah +1032 new-pair env-ah, *env-ah, *nil-ah +1033 # lookup sym(a) in env tmp +1034 var tmp-storage: (handle cell) +1035 var tmp-ah/edx: (addr handle cell) <- address tmp-storage +1036 new-symbol tmp-ah, "a" +1037 var in/eax: (addr cell) <- lookup *tmp-ah +1038 var trace-storage: trace +1039 var trace/edi: (addr trace) <- address trace-storage +1040 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible +1041 lookup-symbol in, tmp-ah, *env-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard +1042 var result/eax: (addr cell) <- lookup *tmp-ah +1043 var result-type/edx: (addr int) <- get result, type +1044 check-ints-equal *result-type, 1/number, "F - test-lookup-symbol-in-env/0" +1045 var result-value-addr/eax: (addr float) <- get result, number-data +1046 var result-value/eax: int <- convert *result-value-addr +1047 check-ints-equal result-value, 3, "F - test-lookup-symbol-in-env/1" +1048 } +1049 +1050 fn test-lookup-symbol-in-globals { +1051 var globals-storage: global-table +1052 var globals/edi: (addr global-table) <- address globals-storage +1053 initialize-globals globals +1054 # env = nil +1055 var nil-storage: (handle cell) +1056 var nil-ah/ecx: (addr handle cell) <- address nil-storage +1057 allocate-pair nil-ah +1058 # lookup sym(a), env +1059 var tmp-storage: (handle cell) +1060 var tmp-ah/ebx: (addr handle cell) <- address tmp-storage +1061 new-symbol tmp-ah, "+" +1062 var in/eax: (addr cell) <- lookup *tmp-ah +1063 var trace-storage: trace +1064 var trace/esi: (addr trace) <- address trace-storage +1065 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible +1066 lookup-symbol in, tmp-ah, *nil-ah, globals, trace, 0/no-screen, 0/no-keyboard +1067 var result/eax: (addr cell) <- lookup *tmp-ah +1068 var result-type/edx: (addr int) <- get result, type +1069 check-ints-equal *result-type, 4/primitive-function, "F - test-lookup-symbol-in-globals/0" +1070 var result-value/eax: (addr int) <- get result, index-data +1071 check-ints-equal *result-value, 1/add, "F - test-lookup-symbol-in-globals/1" +1072 } +1073 +1074 fn mutate-binding name: (addr stream byte), val: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace) { +1075 # trace name +1076 { +1077 var should-trace?/eax: boolean <- should-trace? trace +1078 compare should-trace?, 0/false +1079 break-if-= +1080 var stream-storage: (stream byte 0x800) # pessimistically sized just for the large alist loaded from disk in `main` +1081 var stream/ecx: (addr stream byte) <- address stream-storage +1082 write stream, "bind " +1083 rewind-stream name +1084 write-stream stream, name +1085 write stream, " to " +1086 var nested-trace-storage: trace +1087 var nested-trace/edi: (addr trace) <- address nested-trace-storage +1088 initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible +1089 print-cell val, stream, nested-trace +1090 write stream, " in " +1091 var env-ah/eax: (addr handle cell) <- address env-h +1092 clear-trace nested-trace +1093 print-cell env-ah, stream, nested-trace +1094 trace trace, "eval", stream +1095 } +1096 trace-lower trace +1097 var _env/eax: (addr cell) <- lookup env-h +1098 var env/ebx: (addr cell) <- copy _env +1099 # if env is not a list, abort +1100 { +1101 var env-type/ecx: (addr int) <- get env, type +1102 compare *env-type, 0/pair +1103 break-if-= +1104 error trace, "eval found a non-list environment" +1105 trace-higher trace +1106 return +1107 } +1108 # if env is nil, look in globals +1109 { +1110 var env-nil?/eax: boolean <- nil? env +1111 compare env-nil?, 0/false +1112 break-if-= +1113 debug-print "b", 3/fg, 0/bg +1114 mutate-binding-in-globals name, val, globals, trace +1115 debug-print "x", 3/fg, 0/bg +1116 trace-higher trace +1117 +-- 19 lines: # trace "=> " val " (global)" ------------------------------------------------------------------------------------------------------------------------------------------------------------------------ +1136 debug-print "y", 3/fg, 0/bg +1137 return +1138 } +1139 # check car +1140 var env-head-storage: (handle cell) +1141 var env-head-ah/eax: (addr handle cell) <- address env-head-storage +1142 car env, env-head-ah, trace +1143 var _env-head/eax: (addr cell) <- lookup *env-head-ah +1144 var env-head/ecx: (addr cell) <- copy _env-head +1145 # if car is not a list, abort 1146 { -1147 var in-type/ecx: (addr int) <- get in, type -1148 compare *in-type, 0/pair +1147 var env-head-type/eax: (addr int) <- get env-head, type +1148 compare *env-head-type, 0/pair 1149 break-if-= -1150 error trace, "car on a non-list" +1150 error trace, "environment is not a list of (key . value) pairs" 1151 trace-higher trace 1152 return 1153 } -1154 # if in is nil, abort -1155 { -1156 var in-nil?/eax: boolean <- nil? in -1157 compare in-nil?, 0/false -1158 break-if-= -1159 error trace, "car on nil" -1160 trace-higher trace -1161 return -1162 } -1163 var in-left/eax: (addr handle cell) <- get in, left -1164 copy-object in-left, out -1165 trace-higher trace -1166 return -1167 } -1168 -1169 fn cdr _in: (addr cell), out: (addr handle cell), trace: (addr trace) { -1170 trace-text trace, "eval", "cdr" -1171 trace-lower trace -1172 var in/eax: (addr cell) <- copy _in -1173 # if in is not a list, abort -1174 { -1175 var in-type/ecx: (addr int) <- get in, type -1176 compare *in-type, 0/pair -1177 break-if-= -1178 error trace, "car on a non-list" -1179 trace-higher trace -1180 return -1181 } -1182 # if in is nil, abort -1183 { -1184 var in-nil?/eax: boolean <- nil? in -1185 compare in-nil?, 0/false -1186 break-if-= -1187 error trace, "car on nil" -1188 trace-higher trace -1189 return -1190 } -1191 var in-right/eax: (addr handle cell) <- get in, right -1192 copy-object in-right, out -1193 trace-higher trace -1194 return -1195 } -1196 -1197 fn cell-isomorphic? _a: (addr cell), _b: (addr cell), trace: (addr trace) -> _/eax: boolean { -1198 trace-text trace, "eval", "cell-isomorphic?" -1199 trace-lower trace -1200 var a/esi: (addr cell) <- copy _a -1201 var b/edi: (addr cell) <- copy _b -1202 # if types don't match, return false -1203 var a-type-addr/eax: (addr int) <- get a, type -1204 var b-type-addr/ecx: (addr int) <- get b, type -1205 var b-type/ecx: int <- copy *b-type-addr -1206 compare b-type, *a-type-addr -1207 { -1208 break-if-= -1209 trace-higher trace -1210 trace-text trace, "eval", "=> false (type)" -1211 return 0/false -1212 } -1213 # if types are number, compare number-data -1214 # TODO: exactly comparing floats is a bad idea -1215 compare b-type, 1/number -1216 { -1217 break-if-!= -1218 var a-val-addr/eax: (addr float) <- get a, number-data -1219 var b-val-addr/ecx: (addr float) <- get b, number-data -1220 var a-val/xmm0: float <- copy *a-val-addr -1221 compare a-val, *b-val-addr -1222 { -1223 break-if-= -1224 trace-higher trace -1225 trace-text trace, "eval", "=> false (numbers)" -1226 return 0/false -1227 } -1228 trace-higher trace -1229 trace-text trace, "eval", "=> true (numbers)" -1230 return 1/true -1231 } -1232 $cell-isomorphic?:text-data: { -1233 { -1234 compare b-type, 2/symbol -1235 break-if-= -1236 compare b-type, 3/stream -1237 break-if-= -1238 break $cell-isomorphic?:text-data -1239 } -1240 var b-val-ah/eax: (addr handle stream byte) <- get b, text-data -1241 var _b-val/eax: (addr stream byte) <- lookup *b-val-ah -1242 var b-val/ecx: (addr stream byte) <- copy _b-val -1243 var a-val-ah/eax: (addr handle stream byte) <- get a, text-data -1244 var a-val/eax: (addr stream byte) <- lookup *a-val-ah -1245 var tmp-array: (handle array byte) -1246 var tmp-ah/edx: (addr handle array byte) <- address tmp-array -1247 rewind-stream a-val -1248 stream-to-array a-val, tmp-ah -1249 var tmp/eax: (addr array byte) <- lookup *tmp-ah -1250 var match?/eax: boolean <- stream-data-equal? b-val, tmp -1251 trace-higher trace -1252 { -1253 compare match?, 0/false -1254 break-if-= -1255 trace-text trace, "eval", "=> true (symbols)" -1256 } -1257 { -1258 compare match?, 0/false -1259 break-if-!= -1260 trace-text trace, "eval", "=> false (symbols)" -1261 } -1262 return match? -1263 } -1264 # if objects are primitive functions, compare index-data -1265 compare b-type, 4/primitive -1266 { -1267 break-if-!= -1268 var a-val-addr/eax: (addr int) <- get a, index-data -1269 var b-val-addr/ecx: (addr int) <- get b, index-data -1270 var a-val/eax: int <- copy *a-val-addr -1271 compare a-val, *b-val-addr -1272 { -1273 break-if-= -1274 trace-higher trace -1275 trace-text trace, "eval", "=> false (primitives)" -1276 return 0/false -1277 } -1278 trace-higher trace -1279 trace-text trace, "eval", "=> true (primitives)" -1280 return 1/true -1281 } -1282 # if objects are screens, check if they're the same object -1283 compare b-type, 5/screen -1284 { -1285 break-if-!= -1286 var a-val-addr/eax: (addr handle screen) <- get a, screen-data -1287 var b-val-addr/ecx: (addr handle screen) <- get b, screen-data -1288 var result/eax: boolean <- handle-equal? *a-val-addr, *b-val-addr -1289 compare result, 0/false -1290 return result -1291 } -1292 # if objects are keyboards, check if they have the same contents -1293 compare b-type, 6/keyboard -1294 { -1295 break-if-!= -1296 var a-val-addr/ecx: (addr handle gap-buffer) <- get a, keyboard-data -1297 var _a/eax: (addr gap-buffer) <- lookup *a-val-addr -1298 var a/ecx: (addr gap-buffer) <- copy _a -1299 var b-val-addr/eax: (addr handle gap-buffer) <- get b, keyboard-data -1300 var b/eax: (addr gap-buffer) <- lookup *b-val-addr -1301 var result/eax: boolean <- gap-buffers-equal? a, b -1302 return result -1303 } -1304 # if a is nil, b should be nil -1305 { -1306 # (assumes nil? returns 0 or 1) -1307 var _b-nil?/eax: boolean <- nil? b -1308 var b-nil?/ecx: boolean <- copy _b-nil? -1309 var a-nil?/eax: boolean <- nil? a -1310 # a == nil and b == nil => return true -1311 { -1312 compare a-nil?, 0/false -1313 break-if-= -1314 compare b-nil?, 0/false -1315 break-if-= -1316 trace-higher trace -1317 trace-text trace, "eval", "=> true (nils)" -1318 return 1/true -1319 } -1320 # a == nil => return false -1321 { -1322 compare a-nil?, 0/false -1323 break-if-= -1324 trace-higher trace -1325 trace-text trace, "eval", "=> false (b != nil)" -1326 return 0/false -1327 } -1328 # b == nil => return false -1329 { -1330 compare b-nil?, 0/false -1331 break-if-= -1332 trace-higher trace -1333 trace-text trace, "eval", "=> false (a != nil)" -1334 return 0/false -1335 } -1336 } -1337 # a and b are pairs -1338 var a-tmp-storage: (handle cell) -1339 var a-tmp-ah/edx: (addr handle cell) <- address a-tmp-storage -1340 var b-tmp-storage: (handle cell) -1341 var b-tmp-ah/ebx: (addr handle cell) <- address b-tmp-storage -1342 # if cars aren't equal, return false -1343 car a, a-tmp-ah, trace -1344 car b, b-tmp-ah, trace -1345 { -1346 var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah -1347 var a-tmp/ecx: (addr cell) <- copy _a-tmp -1348 var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah -1349 var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace -1350 compare result, 0/false -1351 break-if-!= -1352 trace-higher trace -1353 trace-text trace, "eval", "=> false (car mismatch)" -1354 return 0/false -1355 } -1356 # recurse on cdrs -1357 cdr a, a-tmp-ah, trace -1358 cdr b, b-tmp-ah, trace -1359 var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah -1360 var a-tmp/ecx: (addr cell) <- copy _a-tmp -1361 var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah -1362 var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace -1363 trace-higher trace -1364 return result -1365 } -1366 -1367 fn fn? _x: (addr cell) -> _/eax: boolean { -1368 var x/esi: (addr cell) <- copy _x -1369 var type/eax: (addr int) <- get x, type -1370 compare *type, 2/symbol -1371 { -1372 break-if-= -1373 return 0/false -1374 } -1375 var contents-ah/eax: (addr handle stream byte) <- get x, text-data -1376 var contents/eax: (addr stream byte) <- lookup *contents-ah -1377 var result/eax: boolean <- stream-data-equal? contents, "fn" -1378 return result -1379 } -1380 -1381 fn litfn? _x: (addr cell) -> _/eax: boolean { -1382 var x/esi: (addr cell) <- copy _x -1383 var type/eax: (addr int) <- get x, type -1384 compare *type, 2/symbol -1385 { -1386 break-if-= -1387 return 0/false -1388 } -1389 var contents-ah/eax: (addr handle stream byte) <- get x, text-data -1390 var contents/eax: (addr stream byte) <- lookup *contents-ah -1391 var result/eax: boolean <- stream-data-equal? contents, "litfn" -1392 return result -1393 } -1394 -1395 fn litmac? _x: (addr cell) -> _/eax: boolean { -1396 var x/esi: (addr cell) <- copy _x -1397 var type/eax: (addr int) <- get x, type -1398 compare *type, 2/symbol -1399 { -1400 break-if-= -1401 return 0/false -1402 } -1403 var contents-ah/eax: (addr handle stream byte) <- get x, text-data -1404 var contents/eax: (addr stream byte) <- lookup *contents-ah -1405 var result/eax: boolean <- stream-data-equal? contents, "litmac" -1406 return result -1407 } -1408 -1409 fn test-evaluate-is-well-behaved { -1410 var t-storage: trace -1411 var t/esi: (addr trace) <- address t-storage -1412 initialize-trace t, 0x100/max-depth, 0x10/capacity, 0/visible # we don't use trace UI -1413 # env = nil -1414 var env-storage: (handle cell) -1415 var env-ah/ecx: (addr handle cell) <- address env-storage -1416 allocate-pair env-ah -1417 # eval sym(a), nil env -1418 var tmp-storage: (handle cell) -1419 var tmp-ah/edx: (addr handle cell) <- address tmp-storage -1420 new-symbol tmp-ah, "a" -1421 evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, t, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number -1422 # doesn't die -1423 check-trace-contains t, "error", "unbound symbol: a", "F - test-evaluate-is-well-behaved" -1424 } -1425 -1426 fn test-evaluate-number { -1427 # env = nil -1428 var env-storage: (handle cell) -1429 var env-ah/ecx: (addr handle cell) <- address env-storage -1430 allocate-pair env-ah -1431 # tmp = 3 -1432 var tmp-storage: (handle cell) -1433 var tmp-ah/edx: (addr handle cell) <- address tmp-storage -1434 new-integer tmp-ah, 3 -1435 var trace-storage: trace -1436 var trace/edi: (addr trace) <- address trace-storage -1437 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible -1438 evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number -1439 # -1440 var result/eax: (addr cell) <- lookup *tmp-ah -1441 var result-type/edx: (addr int) <- get result, type -1442 check-ints-equal *result-type, 1/number, "F - test-evaluate-number/0" -1443 var result-value-addr/eax: (addr float) <- get result, number-data -1444 var result-value/eax: int <- convert *result-value-addr -1445 check-ints-equal result-value, 3, "F - test-evaluate-number/1" -1446 } -1447 -1448 fn test-evaluate-symbol { -1449 # tmp = (a . 3) -1450 var val-storage: (handle cell) -1451 var val-ah/ecx: (addr handle cell) <- address val-storage -1452 new-integer val-ah, 3 -1453 var key-storage: (handle cell) -1454 var key-ah/edx: (addr handle cell) <- address key-storage -1455 new-symbol key-ah, "a" -1456 var env-storage: (handle cell) -1457 var env-ah/ebx: (addr handle cell) <- address env-storage -1458 new-pair env-ah, *key-ah, *val-ah -1459 # env = ((a . 3)) -1460 var nil-storage: (handle cell) -1461 var nil-ah/ecx: (addr handle cell) <- address nil-storage -1462 allocate-pair nil-ah -1463 new-pair env-ah, *env-ah, *nil-ah -1464 # eval sym(a), env -1465 var tmp-storage: (handle cell) -1466 var tmp-ah/edx: (addr handle cell) <- address tmp-storage -1467 new-symbol tmp-ah, "a" -1468 var trace-storage: trace -1469 var trace/edi: (addr trace) <- address trace-storage -1470 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible -1471 evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number -1472 var result/eax: (addr cell) <- lookup *tmp-ah -1473 var result-type/edx: (addr int) <- get result, type -1474 check-ints-equal *result-type, 1/number, "F - test-evaluate-symbol/0" -1475 var result-value-addr/eax: (addr float) <- get result, number-data -1476 var result-value/eax: int <- convert *result-value-addr -1477 check-ints-equal result-value, 3, "F - test-evaluate-symbol/1" -1478 } -1479 -1480 fn test-evaluate-quote { -1481 # env = nil -1482 var nil-storage: (handle cell) -1483 var nil-ah/ecx: (addr handle cell) <- address nil-storage -1484 allocate-pair nil-ah -1485 # eval `a, env -1486 var tmp-storage: (handle cell) -1487 var tmp-ah/edx: (addr handle cell) <- address tmp-storage -1488 new-symbol tmp-ah, "'" -1489 var tmp2-storage: (handle cell) -1490 var tmp2-ah/ebx: (addr handle cell) <- address tmp2-storage -1491 new-symbol tmp2-ah, "a" -1492 new-pair tmp-ah, *tmp-ah, *tmp2-ah -1493 var trace-storage: trace -1494 var trace/edi: (addr trace) <- address trace-storage -1495 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible -1496 evaluate tmp-ah, tmp-ah, *nil-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number -1497 var result/eax: (addr cell) <- lookup *tmp-ah -1498 var result-type/edx: (addr int) <- get result, type -1499 check-ints-equal *result-type, 2/symbol, "F - test-evaluate-quote/0" -1500 var sym?/eax: boolean <- symbol-equal? result, "a" -1501 check sym?, "F - test-evaluate-quote/1" -1502 } -1503 -1504 fn test-evaluate-primitive-function { -1505 var globals-storage: global-table -1506 var globals/edi: (addr global-table) <- address globals-storage -1507 initialize-globals globals +1154 # check key +1155 var curr-key-storage: (handle cell) +1156 var curr-key-ah/eax: (addr handle cell) <- address curr-key-storage +1157 car env-head, curr-key-ah, trace +1158 var curr-key/eax: (addr cell) <- lookup *curr-key-ah +1159 # if key is not a symbol, abort +1160 { +1161 var curr-key-type/eax: (addr int) <- get curr-key, type +1162 compare *curr-key-type, 2/symbol +1163 break-if-= +1164 error trace, "environment contains a binding for a non-symbol" +1165 trace-higher trace +1166 return +1167 } +1168 # if key matches name, return val +1169 var curr-key-data-ah/eax: (addr handle stream byte) <- get curr-key, text-data +1170 var curr-key-data/eax: (addr stream byte) <- lookup *curr-key-data-ah +1171 var match?/eax: boolean <- streams-data-equal? curr-key-data, name +1172 compare match?, 0/false +1173 { +1174 break-if-= +1175 var dest/eax: (addr handle cell) <- get env-head, right +1176 copy-object val, dest +1177 trace-text trace, "eval", "=> done" +1178 trace-higher trace +1179 return +1180 } +1181 # otherwise recurse +1182 var env-tail-storage: (handle cell) +1183 var env-tail-ah/eax: (addr handle cell) <- address env-tail-storage +1184 cdr env, env-tail-ah, trace +1185 mutate-binding name, val, *env-tail-ah, globals, trace +1186 trace-higher trace +1187 } +1188 +1189 fn car _in: (addr cell), out: (addr handle cell), trace: (addr trace) { +1190 trace-text trace, "eval", "car" +1191 trace-lower trace +1192 var in/eax: (addr cell) <- copy _in +1193 # if in is not a list, abort +1194 { +1195 var in-type/ecx: (addr int) <- get in, type +1196 compare *in-type, 0/pair +1197 break-if-= +1198 error trace, "car on a non-list" +1199 trace-higher trace +1200 return +1201 } +1202 # if in is nil, abort +1203 { +1204 var in-nil?/eax: boolean <- nil? in +1205 compare in-nil?, 0/false +1206 break-if-= +1207 error trace, "car on nil" +1208 trace-higher trace +1209 return +1210 } +1211 var in-left/eax: (addr handle cell) <- get in, left +1212 copy-object in-left, out +1213 trace-higher trace +1214 return +1215 } +1216 +1217 fn cdr _in: (addr cell), out: (addr handle cell), trace: (addr trace) { +1218 trace-text trace, "eval", "cdr" +1219 trace-lower trace +1220 var in/eax: (addr cell) <- copy _in +1221 # if in is not a list, abort +1222 { +1223 var in-type/ecx: (addr int) <- get in, type +1224 compare *in-type, 0/pair +1225 break-if-= +1226 error trace, "car on a non-list" +1227 trace-higher trace +1228 return +1229 } +1230 # if in is nil, abort +1231 { +1232 var in-nil?/eax: boolean <- nil? in +1233 compare in-nil?, 0/false +1234 break-if-= +1235 error trace, "car on nil" +1236 trace-higher trace +1237 return +1238 } +1239 var in-right/eax: (addr handle cell) <- get in, right +1240 copy-object in-right, out +1241 trace-higher trace +1242 return +1243 } +1244 +1245 fn cell-isomorphic? _a: (addr cell), _b: (addr cell), trace: (addr trace) -> _/eax: boolean { +1246 trace-text trace, "eval", "cell-isomorphic?" +1247 trace-lower trace +1248 var a/esi: (addr cell) <- copy _a +1249 var b/edi: (addr cell) <- copy _b +1250 # if types don't match, return false +1251 var a-type-addr/eax: (addr int) <- get a, type +1252 var b-type-addr/ecx: (addr int) <- get b, type +1253 var b-type/ecx: int <- copy *b-type-addr +1254 compare b-type, *a-type-addr +1255 { +1256 break-if-= +1257 trace-higher trace +1258 trace-text trace, "eval", "=> false (type)" +1259 return 0/false +1260 } +1261 # if types are number, compare number-data +1262 # TODO: exactly comparing floats is a bad idea +1263 compare b-type, 1/number +1264 { +1265 break-if-!= +1266 var a-val-addr/eax: (addr float) <- get a, number-data +1267 var b-val-addr/ecx: (addr float) <- get b, number-data +1268 var a-val/xmm0: float <- copy *a-val-addr +1269 compare a-val, *b-val-addr +1270 { +1271 break-if-= +1272 trace-higher trace +1273 trace-text trace, "eval", "=> false (numbers)" +1274 return 0/false +1275 } +1276 trace-higher trace +1277 trace-text trace, "eval", "=> true (numbers)" +1278 return 1/true +1279 } +1280 $cell-isomorphic?:text-data: { +1281 { +1282 compare b-type, 2/symbol +1283 break-if-= +1284 compare b-type, 3/stream +1285 break-if-= +1286 break $cell-isomorphic?:text-data +1287 } +1288 var b-val-ah/eax: (addr handle stream byte) <- get b, text-data +1289 var _b-val/eax: (addr stream byte) <- lookup *b-val-ah +1290 var b-val/ecx: (addr stream byte) <- copy _b-val +1291 var a-val-ah/eax: (addr handle stream byte) <- get a, text-data +1292 var a-val/eax: (addr stream byte) <- lookup *a-val-ah +1293 var tmp-array: (handle array byte) +1294 var tmp-ah/edx: (addr handle array byte) <- address tmp-array +1295 rewind-stream a-val +1296 stream-to-array a-val, tmp-ah +1297 var tmp/eax: (addr array byte) <- lookup *tmp-ah +1298 var match?/eax: boolean <- stream-data-equal? b-val, tmp +1299 trace-higher trace +1300 { +1301 compare match?, 0/false +1302 break-if-= +1303 trace-text trace, "eval", "=> true (symbols)" +1304 } +1305 { +1306 compare match?, 0/false +1307 break-if-!= +1308 trace-text trace, "eval", "=> false (symbols)" +1309 } +1310 return match? +1311 } +1312 # if objects are primitive functions, compare index-data +1313 compare b-type, 4/primitive +1314 { +1315 break-if-!= +1316 var a-val-addr/eax: (addr int) <- get a, index-data +1317 var b-val-addr/ecx: (addr int) <- get b, index-data +1318 var a-val/eax: int <- copy *a-val-addr +1319 compare a-val, *b-val-addr +1320 { +1321 break-if-= +1322 trace-higher trace +1323 trace-text trace, "eval", "=> false (primitives)" +1324 return 0/false +1325 } +1326 trace-higher trace +1327 trace-text trace, "eval", "=> true (primitives)" +1328 return 1/true +1329 } +1330 # if objects are screens, check if they're the same object +1331 compare b-type, 5/screen +1332 { +1333 break-if-!= +1334 var a-val-addr/eax: (addr handle screen) <- get a, screen-data +1335 var b-val-addr/ecx: (addr handle screen) <- get b, screen-data +1336 var result/eax: boolean <- handle-equal? *a-val-addr, *b-val-addr +1337 compare result, 0/false +1338 return result +1339 } +1340 # if objects are keyboards, check if they have the same contents +1341 compare b-type, 6/keyboard +1342 { +1343 break-if-!= +1344 var a-val-addr/ecx: (addr handle gap-buffer) <- get a, keyboard-data +1345 var _a/eax: (addr gap-buffer) <- lookup *a-val-addr +1346 var a/ecx: (addr gap-buffer) <- copy _a +1347 var b-val-addr/eax: (addr handle gap-buffer) <- get b, keyboard-data +1348 var b/eax: (addr gap-buffer) <- lookup *b-val-addr +1349 var result/eax: boolean <- gap-buffers-equal? a, b +1350 return result +1351 } +1352 # if a is nil, b should be nil +1353 { +1354 # (assumes nil? returns 0 or 1) +1355 var _b-nil?/eax: boolean <- nil? b +1356 var b-nil?/ecx: boolean <- copy _b-nil? +1357 var a-nil?/eax: boolean <- nil? a +1358 # a == nil and b == nil => return true +1359 { +1360 compare a-nil?, 0/false +1361 break-if-= +1362 compare b-nil?, 0/false +1363 break-if-= +1364 trace-higher trace +1365 trace-text trace, "eval", "=> true (nils)" +1366 return 1/true +1367 } +1368 # a == nil => return false +1369 { +1370 compare a-nil?, 0/false +1371 break-if-= +1372 trace-higher trace +1373 trace-text trace, "eval", "=> false (b != nil)" +1374 return 0/false +1375 } +1376 # b == nil => return false +1377 { +1378 compare b-nil?, 0/false +1379 break-if-= +1380 trace-higher trace +1381 trace-text trace, "eval", "=> false (a != nil)" +1382 return 0/false +1383 } +1384 } +1385 # a and b are pairs +1386 var a-tmp-storage: (handle cell) +1387 var a-tmp-ah/edx: (addr handle cell) <- address a-tmp-storage +1388 var b-tmp-storage: (handle cell) +1389 var b-tmp-ah/ebx: (addr handle cell) <- address b-tmp-storage +1390 # if cars aren't equal, return false +1391 car a, a-tmp-ah, trace +1392 car b, b-tmp-ah, trace +1393 { +1394 var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah +1395 var a-tmp/ecx: (addr cell) <- copy _a-tmp +1396 var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah +1397 var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace +1398 compare result, 0/false +1399 break-if-!= +1400 trace-higher trace +1401 trace-text trace, "eval", "=> false (car mismatch)" +1402 return 0/false +1403 } +1404 # recurse on cdrs +1405 cdr a, a-tmp-ah, trace +1406 cdr b, b-tmp-ah, trace +1407 var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah +1408 var a-tmp/ecx: (addr cell) <- copy _a-tmp +1409 var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah +1410 var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace +1411 trace-higher trace +1412 return result +1413 } +1414 +1415 fn fn? _x: (addr cell) -> _/eax: boolean { +1416 var x/esi: (addr cell) <- copy _x +1417 var type/eax: (addr int) <- get x, type +1418 compare *type, 2/symbol +1419 { +1420 break-if-= +1421 return 0/false +1422 } +1423 var contents-ah/eax: (addr handle stream byte) <- get x, text-data +1424 var contents/eax: (addr stream byte) <- lookup *contents-ah +1425 var result/eax: boolean <- stream-data-equal? contents, "fn" +1426 return result +1427 } +1428 +1429 fn litfn? _x: (addr cell) -> _/eax: boolean { +1430 var x/esi: (addr cell) <- copy _x +1431 var type/eax: (addr int) <- get x, type +1432 compare *type, 2/symbol +1433 { +1434 break-if-= +1435 return 0/false +1436 } +1437 var contents-ah/eax: (addr handle stream byte) <- get x, text-data +1438 var contents/eax: (addr stream byte) <- lookup *contents-ah +1439 var result/eax: boolean <- stream-data-equal? contents, "litfn" +1440 return result +1441 } +1442 +1443 fn litmac? _x: (addr cell) -> _/eax: boolean { +1444 var x/esi: (addr cell) <- copy _x +1445 var type/eax: (addr int) <- get x, type +1446 compare *type, 2/symbol +1447 { +1448 break-if-= +1449 return 0/false +1450 } +1451 var contents-ah/eax: (addr handle stream byte) <- get x, text-data +1452 var contents/eax: (addr stream byte) <- lookup *contents-ah +1453 var result/eax: boolean <- stream-data-equal? contents, "litmac" +1454 return result +1455 } +1456 +1457 fn test-evaluate-is-well-behaved { +1458 var t-storage: trace +1459 var t/esi: (addr trace) <- address t-storage +1460 initialize-trace t, 0x100/max-depth, 0x10/capacity, 0/visible # we don't use trace UI +1461 # env = nil +1462 var env-storage: (handle cell) +1463 var env-ah/ecx: (addr handle cell) <- address env-storage +1464 allocate-pair env-ah +1465 # eval sym(a), nil env +1466 var tmp-storage: (handle cell) +1467 var tmp-ah/edx: (addr handle cell) <- address tmp-storage +1468 new-symbol tmp-ah, "a" +1469 evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, t, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number +1470 # doesn't die +1471 check-trace-contains t, "error", "unbound symbol: a", "F - test-evaluate-is-well-behaved" +1472 } +1473 +1474 fn test-evaluate-number { +1475 # env = nil +1476 var env-storage: (handle cell) +1477 var env-ah/ecx: (addr handle cell) <- address env-storage +1478 allocate-pair env-ah +1479 # tmp = 3 +1480 var tmp-storage: (handle cell) +1481 var tmp-ah/edx: (addr handle cell) <- address tmp-storage +1482 new-integer tmp-ah, 3 +1483 var trace-storage: trace +1484 var trace/edi: (addr trace) <- address trace-storage +1485 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible +1486 evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number +1487 # +1488 var result/eax: (addr cell) <- lookup *tmp-ah +1489 var result-type/edx: (addr int) <- get result, type +1490 check-ints-equal *result-type, 1/number, "F - test-evaluate-number/0" +1491 var result-value-addr/eax: (addr float) <- get result, number-data +1492 var result-value/eax: int <- convert *result-value-addr +1493 check-ints-equal result-value, 3, "F - test-evaluate-number/1" +1494 } +1495 +1496 fn test-evaluate-symbol { +1497 # tmp = (a . 3) +1498 var val-storage: (handle cell) +1499 var val-ah/ecx: (addr handle cell) <- address val-storage +1500 new-integer val-ah, 3 +1501 var key-storage: (handle cell) +1502 var key-ah/edx: (addr handle cell) <- address key-storage +1503 new-symbol key-ah, "a" +1504 var env-storage: (handle cell) +1505 var env-ah/ebx: (addr handle cell) <- address env-storage +1506 new-pair env-ah, *key-ah, *val-ah +1507 # env = ((a . 3)) 1508 var nil-storage: (handle cell) 1509 var nil-ah/ecx: (addr handle cell) <- address nil-storage 1510 allocate-pair nil-ah -1511 var add-storage: (handle cell) -1512 var add-ah/ebx: (addr handle cell) <- address add-storage -1513 new-symbol add-ah, "+" -1514 # eval +, nil env -1515 var tmp-storage: (handle cell) -1516 var tmp-ah/esi: (addr handle cell) <- address tmp-storage -1517 var trace-storage: trace -1518 var trace/edx: (addr trace) <- address trace-storage -1519 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible -1520 evaluate add-ah, tmp-ah, *nil-ah, globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number -1521 # -1522 var result/eax: (addr cell) <- lookup *tmp-ah -1523 var result-type/edx: (addr int) <- get result, type -1524 check-ints-equal *result-type, 4/primitive-function, "F - test-evaluate-primitive-function/0" -1525 var result-value/eax: (addr int) <- get result, index-data -1526 check-ints-equal *result-value, 1/add, "F - test-evaluate-primitive-function/1" -1527 } -1528 -1529 fn test-evaluate-primitive-function-call { -1530 var t-storage: trace -1531 var t/edi: (addr trace) <- address t-storage -1532 initialize-trace t, 0x100/max-depth, 0x100/capacity, 0/visible # we don't use trace UI -1533 # -1534 var nil-storage: (handle cell) -1535 var nil-ah/ecx: (addr handle cell) <- address nil-storage -1536 allocate-pair nil-ah -1537 var one-storage: (handle cell) -1538 var one-ah/edx: (addr handle cell) <- address one-storage -1539 new-integer one-ah, 1 -1540 var add-storage: (handle cell) -1541 var add-ah/ebx: (addr handle cell) <- address add-storage -1542 new-symbol add-ah, "+" -1543 # input is (+ 1 1) -1544 var tmp-storage: (handle cell) -1545 var tmp-ah/esi: (addr handle cell) <- address tmp-storage -1546 new-pair tmp-ah, *one-ah, *nil-ah -1547 new-pair tmp-ah, *one-ah, *tmp-ah -1548 new-pair tmp-ah, *add-ah, *tmp-ah -1549 #? dump-cell tmp-ah -1550 # -1551 var globals-storage: global-table -1552 var globals/edx: (addr global-table) <- address globals-storage -1553 initialize-globals globals -1554 # -1555 evaluate tmp-ah, tmp-ah, *nil-ah, globals, t, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number -1556 #? dump-trace t -1557 # -1558 var result/eax: (addr cell) <- lookup *tmp-ah -1559 var result-type/edx: (addr int) <- get result, type -1560 check-ints-equal *result-type, 1/number, "F - test-evaluate-primitive-function-call/0" -1561 var result-value-addr/eax: (addr float) <- get result, number-data -1562 var result-value/eax: int <- convert *result-value-addr -1563 check-ints-equal result-value, 2, "F - test-evaluate-primitive-function-call/1" -1564 } -1565 -1566 fn test-evaluate-backquote { -1567 # env = nil -1568 var nil-storage: (handle cell) -1569 var nil-ah/ecx: (addr handle cell) <- address nil-storage -1570 allocate-pair nil-ah -1571 # eval `a, env -1572 var tmp-storage: (handle cell) -1573 var tmp-ah/edx: (addr handle cell) <- address tmp-storage -1574 new-symbol tmp-ah, "`" -1575 var tmp2-storage: (handle cell) -1576 var tmp2-ah/ebx: (addr handle cell) <- address tmp2-storage -1577 new-symbol tmp2-ah, "a" -1578 new-pair tmp-ah, *tmp-ah, *tmp2-ah -1579 clear-object tmp2-ah -1580 var trace-storage: trace -1581 var trace/edi: (addr trace) <- address trace-storage -1582 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible -1583 evaluate tmp-ah, tmp2-ah, *nil-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number -1584 var result/eax: (addr cell) <- lookup *tmp2-ah -1585 var result-type/edx: (addr int) <- get result, type -1586 check-ints-equal *result-type, 2/symbol, "F - test-evaluate-backquote/0" -1587 var sym?/eax: boolean <- symbol-equal? result, "a" -1588 check sym?, "F - test-evaluate-backquote/1" -1589 } -1590 -1591 fn evaluate-backquote _in-ah: (addr handle cell), _out-ah: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), inner-screen-var: (addr handle cell), inner-keyboard-var: (addr handle cell), definitions-created: (addr stream int), call-number: (addr int) { -1592 # stack overflow? # disable when enabling Really-debug-print -1593 #? dump-cell-from-cursor-over-full-screen _in-ah -1594 check-stack -1595 { -1596 var inner-screen-var/eax: (addr handle cell) <- copy inner-screen-var -1597 compare inner-screen-var, 0 -1598 break-if-= -1599 var inner-screen-var-addr/eax: (addr cell) <- lookup *inner-screen-var -1600 compare inner-screen-var-addr, 0 -1601 break-if-= -1602 # if inner-screen-var exists, we're probably not in a test -1603 show-stack-state -1604 } -1605 # errors? skip -1606 { -1607 var error?/eax: boolean <- has-errors? trace -1608 compare error?, 0/false -1609 break-if-= -1610 return -1611 } -1612 trace-lower trace -1613 var in-ah/esi: (addr handle cell) <- copy _in-ah -1614 var in/eax: (addr cell) <- lookup *in-ah -1615 { -1616 var nil?/eax: boolean <- nil? in -1617 compare nil?, 0/false -1618 break-if-= -1619 # nil is a literal -1620 trace-text trace, "eval", "backquote nil" -1621 copy-object _in-ah, _out-ah -1622 trace-higher trace -1623 return -1624 } -1625 var in-type/ecx: (addr int) <- get in, type -1626 compare *in-type, 0/pair -1627 { -1628 break-if-= -1629 # copy non-pairs directly -1630 # TODO: streams might need to be copied -1631 trace-text trace, "eval", "backquote atom" -1632 copy-object _in-ah, _out-ah -1633 trace-higher trace -1634 return -1635 } -1636 # 'in' is a pair -1637 debug-print "()", 4/fg, 0/bg -1638 var in-ah/esi: (addr handle cell) <- copy _in-ah -1639 var _in/eax: (addr cell) <- lookup *in-ah -1640 var in/ebx: (addr cell) <- copy _in -1641 var in-left-ah/ecx: (addr handle cell) <- get in, left -1642 debug-print "10", 4/fg, 0/bg -1643 # check for unquote -1644 $macroexpand-iter:unquote: { -1645 var in-left/eax: (addr cell) <- lookup *in-left-ah -1646 var unquote?/eax: boolean <- symbol-equal? in-left, "," -1647 compare unquote?, 0/false -1648 break-if-= -1649 trace-text trace, "eval", "unquote" -1650 var rest-ah/eax: (addr handle cell) <- get in, right -1651 debug-print ",", 3/fg, 0/bg -1652 evaluate rest-ah, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number -1653 debug-print ",)", 3/fg, 0/bg -1654 trace-higher trace -1655 return -1656 } -1657 # check for unquote-splice in in-left -1658 debug-print "11", 4/fg, 0/bg -1659 var out-ah/edi: (addr handle cell) <- copy _out-ah -1660 $macroexpand-iter:unquote-splice: { -1661 #? dump-cell-from-cursor-over-full-screen in-left-ah -1662 var in-left/eax: (addr cell) <- lookup *in-left-ah -1663 { -1664 debug-print "12", 4/fg, 0/bg -1665 { -1666 var in-left-is-nil?/eax: boolean <- nil? in-left -1667 compare in-left-is-nil?, 0/false -1668 } -1669 break-if-!= $macroexpand-iter:unquote-splice -1670 var in-left-type/ecx: (addr int) <- get in-left, type -1671 debug-print "13", 4/fg, 0/bg -1672 compare *in-left-type, 0/pair -1673 break-if-!= $macroexpand-iter:unquote-splice -1674 var in-left-left-ah/eax: (addr handle cell) <- get in-left, left -1675 debug-print "14", 4/fg, 0/bg -1676 var in-left-left/eax: (addr cell) <- lookup *in-left-left-ah -1677 debug-print "15", 4/fg, 0/bg -1678 var in-left-left-type/ecx: (addr int) <- get in-left-left, type -1679 var left-is-unquote-splice?/eax: boolean <- symbol-equal? in-left-left, ",@" -1680 debug-print "16", 4/fg, 0/bg -1681 compare left-is-unquote-splice?, 0/false -1682 } -1683 break-if-= -1684 debug-print "17", 4/fg, 0/bg -1685 trace-text trace, "eval", "unquote-splice" -1686 var in-unquote-payload-ah/eax: (addr handle cell) <- get in-left, right -1687 evaluate in-unquote-payload-ah, out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number -1688 # errors? skip -1689 { -1690 var error?/eax: boolean <- has-errors? trace -1691 compare error?, 0/false -1692 break-if-= -1693 trace-higher trace -1694 return -1695 } -1696 # while (*out-ah != null) out-ah = cdr(out-ah) -1697 { -1698 var out/eax: (addr cell) <- lookup *out-ah -1699 { -1700 var done?/eax: boolean <- nil? out -1701 compare done?, 0/false -1702 } -1703 break-if-!= -1704 out-ah <- get out, right -1705 loop -1706 } -1707 # append result of in-right -1708 var in-right-ah/ecx: (addr handle cell) <- get in, right -1709 evaluate-backquote in-right-ah, out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number -1710 trace-higher trace -1711 return -1712 } -1713 debug-print "19", 4/fg, 0/bg -1714 # otherwise continue copying -1715 trace-text trace, "eval", "backquote: copy" -1716 var out-ah/edi: (addr handle cell) <- copy _out-ah -1717 allocate-pair out-ah -1718 debug-print "20", 7/fg, 0/bg -1719 #? dump-cell-from-cursor-over-full-screen out-ah -1720 var out/eax: (addr cell) <- lookup *out-ah -1721 var out-left-ah/edx: (addr handle cell) <- get out, left -1722 debug-print "`(l", 3/fg, 0/bg -1723 evaluate-backquote in-left-ah, out-left-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number -1724 debug-print "`r)", 3/fg, 0/bg -1725 # errors? skip -1726 { -1727 var error?/eax: boolean <- has-errors? trace -1728 compare error?, 0/false -1729 break-if-= -1730 trace-higher trace -1731 return -1732 } -1733 var in-right-ah/ecx: (addr handle cell) <- get in, right -1734 var out-right-ah/edx: (addr handle cell) <- get out, right -1735 debug-print "`r(", 3/fg, 0/bg -1736 evaluate-backquote in-right-ah, out-right-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number -1737 debug-print "`r)", 3/fg, 0/bg -1738 trace-higher trace -1739 } -1740 -1741 fn test-evaluate-backquote-list { -1742 var nil-storage: (handle cell) -1743 var nil-ah/ecx: (addr handle cell) <- address nil-storage -1744 allocate-pair nil-ah -1745 var backquote-storage: (handle cell) -1746 var backquote-ah/edx: (addr handle cell) <- address backquote-storage -1747 new-symbol backquote-ah, "`" -1748 # input is `(a b) -1749 var a-storage: (handle cell) -1750 var a-ah/ebx: (addr handle cell) <- address a-storage -1751 new-symbol a-ah, "a" -1752 var b-storage: (handle cell) -1753 var b-ah/esi: (addr handle cell) <- address b-storage -1754 new-symbol b-ah, "b" -1755 var tmp-storage: (handle cell) -1756 var tmp-ah/eax: (addr handle cell) <- address tmp-storage -1757 new-pair tmp-ah, *b-ah, *nil-ah -1758 new-pair tmp-ah, *a-ah, *tmp-ah -1759 new-pair tmp-ah, *backquote-ah, *tmp-ah -1760 # -1761 var trace-storage: trace -1762 var trace/edi: (addr trace) <- address trace-storage -1763 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible -1764 evaluate tmp-ah, tmp-ah, *nil-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number -1765 # result is (a b) -1766 var result/eax: (addr cell) <- lookup *tmp-ah -1767 { -1768 var result-type/eax: (addr int) <- get result, type -1769 check-ints-equal *result-type, 0/pair, "F - test-evaluate-backquote-list/0" -1770 } -1771 { -1772 var a1-ah/eax: (addr handle cell) <- get result, left -1773 var a1/eax: (addr cell) <- lookup *a1-ah -1774 var check1/eax: boolean <- symbol-equal? a1, "a" -1775 check check1, "F - test-evaluate-backquote-list/1" -1776 } -1777 var rest-ah/eax: (addr handle cell) <- get result, right -1778 var rest/eax: (addr cell) <- lookup *rest-ah -1779 { -1780 var a2-ah/eax: (addr handle cell) <- get rest, left -1781 var a2/eax: (addr cell) <- lookup *a2-ah -1782 var check2/eax: boolean <- symbol-equal? a2, "b" -1783 check check2, "F - test-evaluate-backquote-list/2" -1784 } -1785 var rest-ah/eax: (addr handle cell) <- get rest, right -1786 var rest/eax: (addr cell) <- lookup *rest-ah -1787 var check3/eax: boolean <- nil? rest -1788 check check3, "F - test-evaluate-backquote-list/3" -1789 } -1790 -1791 fn test-evaluate-backquote-list-with-unquote { -1792 var nil-h: (handle cell) -1793 var nil-ah/eax: (addr handle cell) <- address nil-h -1794 allocate-pair nil-ah -1795 var backquote-h: (handle cell) -1796 var backquote-ah/eax: (addr handle cell) <- address backquote-h -1797 new-symbol backquote-ah, "`" -1798 var unquote-h: (handle cell) -1799 var unquote-ah/eax: (addr handle cell) <- address unquote-h -1800 new-symbol unquote-ah, "," -1801 var a-h: (handle cell) -1802 var a-ah/eax: (addr handle cell) <- address a-h -1803 new-symbol a-ah, "a" -1804 var b-h: (handle cell) -1805 var b-ah/eax: (addr handle cell) <- address b-h -1806 new-symbol b-ah, "b" -1807 # env = ((b . 3)) -1808 var val-h: (handle cell) -1809 var val-ah/eax: (addr handle cell) <- address val-h -1810 new-integer val-ah, 3 -1811 var env-h: (handle cell) -1812 var env-ah/eax: (addr handle cell) <- address env-h -1813 new-pair env-ah, b-h, val-h -1814 new-pair env-ah, env-h, nil-h -1815 # input is `(a ,b) -1816 var tmp-h: (handle cell) -1817 var tmp-ah/eax: (addr handle cell) <- address tmp-h -1818 # tmp = cons(unquote, b) -1819 new-pair tmp-ah, unquote-h, b-h -1820 # tmp = cons(tmp, nil) -1821 new-pair tmp-ah, tmp-h, nil-h -1822 # tmp = cons(a, tmp) -1823 new-pair tmp-ah, a-h, tmp-h -1824 # tmp = cons(backquote, tmp) -1825 new-pair tmp-ah, backquote-h, tmp-h -1826 # -1827 var trace-storage: trace -1828 var trace/edi: (addr trace) <- address trace-storage -1829 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible -1830 evaluate tmp-ah, tmp-ah, env-h, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number -1831 # result is (a 3) -1832 var result/eax: (addr cell) <- lookup *tmp-ah -1833 { -1834 var result-type/eax: (addr int) <- get result, type -1835 check-ints-equal *result-type, 0/pair, "F - test-evaluate-backquote-list-with-unquote/0" -1836 } -1837 { -1838 var a1-ah/eax: (addr handle cell) <- get result, left -1839 var a1/eax: (addr cell) <- lookup *a1-ah -1840 var check1/eax: boolean <- symbol-equal? a1, "a" -1841 check check1, "F - test-evaluate-backquote-list-with-unquote/1" -1842 } -1843 var rest-ah/eax: (addr handle cell) <- get result, right -1844 var rest/eax: (addr cell) <- lookup *rest-ah -1845 { -1846 var a2-ah/eax: (addr handle cell) <- get rest, left -1847 var a2/eax: (addr cell) <- lookup *a2-ah -1848 var a2-value-addr/eax: (addr float) <- get a2, number-data -1849 var a2-value/eax: int <- convert *a2-value-addr -1850 check-ints-equal a2-value, 3, "F - test-evaluate-backquote-list-with-unquote/2" -1851 } -1852 var rest-ah/eax: (addr handle cell) <- get rest, right -1853 var rest/eax: (addr cell) <- lookup *rest-ah -1854 var check3/eax: boolean <- nil? rest -1855 check check3, "F - test-evaluate-backquote-list-with-unquote/3" -1856 } -1857 -1858 fn test-evaluate-backquote-list-with-unquote-splice { -1859 var nil-h: (handle cell) -1860 var nil-ah/eax: (addr handle cell) <- address nil-h -1861 allocate-pair nil-ah -1862 var backquote-h: (handle cell) -1863 var backquote-ah/eax: (addr handle cell) <- address backquote-h -1864 new-symbol backquote-ah, "`" -1865 var unquote-splice-h: (handle cell) -1866 var unquote-splice-ah/eax: (addr handle cell) <- address unquote-splice-h -1867 new-symbol unquote-splice-ah, ",@" -1868 var a-h: (handle cell) -1869 var a-ah/eax: (addr handle cell) <- address a-h -1870 new-symbol a-ah, "a" -1871 var b-h: (handle cell) -1872 var b-ah/eax: (addr handle cell) <- address b-h -1873 new-symbol b-ah, "b" -1874 # env = ((b . (a 3))) -1875 var val-h: (handle cell) -1876 var val-ah/eax: (addr handle cell) <- address val-h -1877 new-integer val-ah, 3 -1878 new-pair val-ah, val-h, nil-h -1879 new-pair val-ah, a-h, val-h -1880 var env-h: (handle cell) -1881 var env-ah/eax: (addr handle cell) <- address env-h -1882 new-pair env-ah, b-h, val-h -1883 new-pair env-ah, env-h, nil-h -1884 # input is `(a ,@b b) -1885 var tmp-h: (handle cell) -1886 var tmp-ah/eax: (addr handle cell) <- address tmp-h -1887 # tmp = cons(b, nil) -1888 new-pair tmp-ah, b-h, nil-h -1889 # tmp2 = cons(unquote-splice, b) -1890 var tmp2-h: (handle cell) -1891 var tmp2-ah/ecx: (addr handle cell) <- address tmp2-h -1892 new-pair tmp2-ah, unquote-splice-h, b-h -1893 # tmp = cons(tmp2, tmp) -1894 new-pair tmp-ah, tmp2-h, tmp-h -1895 # tmp = cons(a, tmp) -1896 new-pair tmp-ah, a-h, tmp-h -1897 # tmp = cons(backquote, tmp) -1898 new-pair tmp-ah, backquote-h, tmp-h -1899 #? dump-cell-from-cursor-over-full-screen tmp-ah -1900 # -1901 var trace-storage: trace -1902 var trace/edi: (addr trace) <- address trace-storage -1903 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible -1904 evaluate tmp-ah, tmp-ah, env-h, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number -1905 # result is (a a 3 b) -1906 #? dump-cell-from-cursor-over-full-screen tmp-ah -1907 var result/eax: (addr cell) <- lookup *tmp-ah -1908 { -1909 var result-type/eax: (addr int) <- get result, type -1910 check-ints-equal *result-type, 0/pair, "F - test-evaluate-backquote-list-with-unquote-splice/0" -1911 } -1912 { -1913 var a1-ah/eax: (addr handle cell) <- get result, left -1914 var a1/eax: (addr cell) <- lookup *a1-ah -1915 var check1/eax: boolean <- symbol-equal? a1, "a" -1916 check check1, "F - test-evaluate-backquote-list-with-unquote-splice/1" -1917 } -1918 var rest-ah/eax: (addr handle cell) <- get result, right -1919 var rest/eax: (addr cell) <- lookup *rest-ah -1920 { -1921 var a2-ah/eax: (addr handle cell) <- get rest, left -1922 var a2/eax: (addr cell) <- lookup *a2-ah -1923 var check2/eax: boolean <- symbol-equal? a2, "a" -1924 check check2, "F - test-evaluate-backquote-list-with-unquote-splice/2" -1925 } -1926 var rest-ah/eax: (addr handle cell) <- get rest, right -1927 var rest/eax: (addr cell) <- lookup *rest-ah -1928 { -1929 var a3-ah/eax: (addr handle cell) <- get rest, left -1930 var a3/eax: (addr cell) <- lookup *a3-ah -1931 var a3-value-addr/eax: (addr float) <- get a3, number-data -1932 var a3-value/eax: int <- convert *a3-value-addr -1933 check-ints-equal a3-value, 3, "F - test-evaluate-backquote-list-with-unquote-splice/3" -1934 } -1935 var rest-ah/eax: (addr handle cell) <- get rest, right -1936 var rest/eax: (addr cell) <- lookup *rest-ah -1937 { -1938 var a4-ah/eax: (addr handle cell) <- get rest, left -1939 var a4/eax: (addr cell) <- lookup *a4-ah -1940 var check4/eax: boolean <- symbol-equal? a4, "b" -1941 check check4, "F - test-evaluate-backquote-list-with-unquote-splice/4" -1942 } -1943 var rest-ah/eax: (addr handle cell) <- get rest, right -1944 var rest/eax: (addr cell) <- lookup *rest-ah -1945 var check5/eax: boolean <- nil? rest -1946 check check5, "F - test-evaluate-backquote-list-with-unquote-splice/5" -1947 } +1511 new-pair env-ah, *env-ah, *nil-ah +1512 # eval sym(a), env +1513 var tmp-storage: (handle cell) +1514 var tmp-ah/edx: (addr handle cell) <- address tmp-storage +1515 new-symbol tmp-ah, "a" +1516 var trace-storage: trace +1517 var trace/edi: (addr trace) <- address trace-storage +1518 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible +1519 evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number +1520 var result/eax: (addr cell) <- lookup *tmp-ah +1521 var result-type/edx: (addr int) <- get result, type +1522 check-ints-equal *result-type, 1/number, "F - test-evaluate-symbol/0" +1523 var result-value-addr/eax: (addr float) <- get result, number-data +1524 var result-value/eax: int <- convert *result-value-addr +1525 check-ints-equal result-value, 3, "F - test-evaluate-symbol/1" +1526 } +1527 +1528 fn test-evaluate-quote { +1529 # env = nil +1530 var nil-storage: (handle cell) +1531 var nil-ah/ecx: (addr handle cell) <- address nil-storage +1532 allocate-pair nil-ah +1533 # eval `a, env +1534 var tmp-storage: (handle cell) +1535 var tmp-ah/edx: (addr handle cell) <- address tmp-storage +1536 new-symbol tmp-ah, "'" +1537 var tmp2-storage: (handle cell) +1538 var tmp2-ah/ebx: (addr handle cell) <- address tmp2-storage +1539 new-symbol tmp2-ah, "a" +1540 new-pair tmp-ah, *tmp-ah, *tmp2-ah +1541 var trace-storage: trace +1542 var trace/edi: (addr trace) <- address trace-storage +1543 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible +1544 evaluate tmp-ah, tmp-ah, *nil-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number +1545 var result/eax: (addr cell) <- lookup *tmp-ah +1546 var result-type/edx: (addr int) <- get result, type +1547 check-ints-equal *result-type, 2/symbol, "F - test-evaluate-quote/0" +1548 var sym?/eax: boolean <- symbol-equal? result, "a" +1549 check sym?, "F - test-evaluate-quote/1" +1550 } +1551 +1552 fn test-evaluate-primitive-function { +1553 var globals-storage: global-table +1554 var globals/edi: (addr global-table) <- address globals-storage +1555 initialize-globals globals +1556 var nil-storage: (handle cell) +1557 var nil-ah/ecx: (addr handle cell) <- address nil-storage +1558 allocate-pair nil-ah +1559 var add-storage: (handle cell) +1560 var add-ah/ebx: (addr handle cell) <- address add-storage +1561 new-symbol add-ah, "+" +1562 # eval +, nil env +1563 var tmp-storage: (handle cell) +1564 var tmp-ah/esi: (addr handle cell) <- address tmp-storage +1565 var trace-storage: trace +1566 var trace/edx: (addr trace) <- address trace-storage +1567 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible +1568 evaluate add-ah, tmp-ah, *nil-ah, globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number +1569 # +1570 var result/eax: (addr cell) <- lookup *tmp-ah +1571 var result-type/edx: (addr int) <- get result, type +1572 check-ints-equal *result-type, 4/primitive-function, "F - test-evaluate-primitive-function/0" +1573 var result-value/eax: (addr int) <- get result, index-data +1574 check-ints-equal *result-value, 1/add, "F - test-evaluate-primitive-function/1" +1575 } +1576 +1577 fn test-evaluate-primitive-function-call { +1578 var t-storage: trace +1579 var t/edi: (addr trace) <- address t-storage +1580 initialize-trace t, 0x100/max-depth, 0x100/capacity, 0/visible # we don't use trace UI +1581 # +1582 var nil-storage: (handle cell) +1583 var nil-ah/ecx: (addr handle cell) <- address nil-storage +1584 allocate-pair nil-ah +1585 var one-storage: (handle cell) +1586 var one-ah/edx: (addr handle cell) <- address one-storage +1587 new-integer one-ah, 1 +1588 var add-storage: (handle cell) +1589 var add-ah/ebx: (addr handle cell) <- address add-storage +1590 new-symbol add-ah, "+" +1591 # input is (+ 1 1) +1592 var tmp-storage: (handle cell) +1593 var tmp-ah/esi: (addr handle cell) <- address tmp-storage +1594 new-pair tmp-ah, *one-ah, *nil-ah +1595 new-pair tmp-ah, *one-ah, *tmp-ah +1596 new-pair tmp-ah, *add-ah, *tmp-ah +1597 #? dump-cell tmp-ah +1598 # +1599 var globals-storage: global-table +1600 var globals/edx: (addr global-table) <- address globals-storage +1601 initialize-globals globals +1602 # +1603 evaluate tmp-ah, tmp-ah, *nil-ah, globals, t, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number +1604 #? dump-trace t +1605 # +1606 var result/eax: (addr cell) <- lookup *tmp-ah +1607 var result-type/edx: (addr int) <- get result, type +1608 check-ints-equal *result-type, 1/number, "F - test-evaluate-primitive-function-call/0" +1609 var result-value-addr/eax: (addr float) <- get result, number-data +1610 var result-value/eax: int <- convert *result-value-addr +1611 check-ints-equal result-value, 2, "F - test-evaluate-primitive-function-call/1" +1612 } +1613 +1614 fn test-evaluate-backquote { +1615 # env = nil +1616 var nil-storage: (handle cell) +1617 var nil-ah/ecx: (addr handle cell) <- address nil-storage +1618 allocate-pair nil-ah +1619 # eval `a, env +1620 var tmp-storage: (handle cell) +1621 var tmp-ah/edx: (addr handle cell) <- address tmp-storage +1622 new-symbol tmp-ah, "`" +1623 var tmp2-storage: (handle cell) +1624 var tmp2-ah/ebx: (addr handle cell) <- address tmp2-storage +1625 new-symbol tmp2-ah, "a" +1626 new-pair tmp-ah, *tmp-ah, *tmp2-ah +1627 clear-object tmp2-ah +1628 var trace-storage: trace +1629 var trace/edi: (addr trace) <- address trace-storage +1630 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible +1631 evaluate tmp-ah, tmp2-ah, *nil-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number +1632 var result/eax: (addr cell) <- lookup *tmp2-ah +1633 var result-type/edx: (addr int) <- get result, type +1634 check-ints-equal *result-type, 2/symbol, "F - test-evaluate-backquote/0" +1635 var sym?/eax: boolean <- symbol-equal? result, "a" +1636 check sym?, "F - test-evaluate-backquote/1" +1637 } +1638 +1639 fn evaluate-backquote _in-ah: (addr handle cell), _out-ah: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), inner-screen-var: (addr handle cell), inner-keyboard-var: (addr handle cell), definitions-created: (addr stream int), call-number: (addr int) { +1640 # stack overflow? # disable when enabling Really-debug-print +1641 #? dump-cell-from-cursor-over-full-screen _in-ah +1642 check-stack +1643 { +1644 var inner-screen-var/eax: (addr handle cell) <- copy inner-screen-var +1645 compare inner-screen-var, 0 +1646 break-if-= +1647 var inner-screen-var-addr/eax: (addr cell) <- lookup *inner-screen-var +1648 compare inner-screen-var-addr, 0 +1649 break-if-= +1650 # if inner-screen-var exists, we're probably not in a test +1651 show-stack-state +1652 } +1653 # errors? skip +1654 { +1655 var error?/eax: boolean <- has-errors? trace +1656 compare error?, 0/false +1657 break-if-= +1658 return +1659 } +1660 trace-lower trace +1661 var in-ah/esi: (addr handle cell) <- copy _in-ah +1662 var in/eax: (addr cell) <- lookup *in-ah +1663 { +1664 var nil?/eax: boolean <- nil? in +1665 compare nil?, 0/false +1666 break-if-= +1667 # nil is a literal +1668 trace-text trace, "eval", "backquote nil" +1669 copy-object _in-ah, _out-ah +1670 trace-higher trace +1671 return +1672 } +1673 var in-type/ecx: (addr int) <- get in, type +1674 compare *in-type, 0/pair +1675 { +1676 break-if-= +1677 # copy non-pairs directly +1678 # TODO: streams might need to be copied +1679 trace-text trace, "eval", "backquote atom" +1680 copy-object _in-ah, _out-ah +1681 trace-higher trace +1682 return +1683 } +1684 # 'in' is a pair +1685 debug-print "()", 4/fg, 0/bg +1686 var in-ah/esi: (addr handle cell) <- copy _in-ah +1687 var _in/eax: (addr cell) <- lookup *in-ah +1688 var in/ebx: (addr cell) <- copy _in +1689 var in-left-ah/ecx: (addr handle cell) <- get in, left +1690 debug-print "10", 4/fg, 0/bg +1691 # check for unquote +1692 $evaluate-backquote:unquote: { +1693 var in-left/eax: (addr cell) <- lookup *in-left-ah +1694 var unquote?/eax: boolean <- symbol-equal? in-left, "," +1695 compare unquote?, 0/false +1696 break-if-= +1697 trace-text trace, "eval", "unquote" +1698 var rest-ah/eax: (addr handle cell) <- get in, right +1699 debug-print ",", 3/fg, 0/bg +1700 evaluate rest-ah, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number +1701 debug-print ",)", 3/fg, 0/bg +1702 trace-higher trace +1703 return +1704 } +1705 # check for unquote-splice in in-left +1706 debug-print "11", 4/fg, 0/bg +1707 var out-ah/edi: (addr handle cell) <- copy _out-ah +1708 $evaluate-backquote:unquote-splice: { +1709 #? dump-cell-from-cursor-over-full-screen in-left-ah +1710 var in-left/eax: (addr cell) <- lookup *in-left-ah +1711 { +1712 debug-print "12", 4/fg, 0/bg +1713 { +1714 var in-left-is-nil?/eax: boolean <- nil? in-left +1715 compare in-left-is-nil?, 0/false +1716 } +1717 break-if-!= $evaluate-backquote:unquote-splice +1718 var in-left-type/ecx: (addr int) <- get in-left, type +1719 debug-print "13", 4/fg, 0/bg +1720 compare *in-left-type, 0/pair +1721 break-if-!= $evaluate-backquote:unquote-splice +1722 var in-left-left-ah/eax: (addr handle cell) <- get in-left, left +1723 debug-print "14", 4/fg, 0/bg +1724 var in-left-left/eax: (addr cell) <- lookup *in-left-left-ah +1725 debug-print "15", 4/fg, 0/bg +1726 var in-left-left-type/ecx: (addr int) <- get in-left-left, type +1727 var left-is-unquote-splice?/eax: boolean <- symbol-equal? in-left-left, ",@" +1728 debug-print "16", 4/fg, 0/bg +1729 compare left-is-unquote-splice?, 0/false +1730 } +1731 break-if-= +1732 debug-print "17", 4/fg, 0/bg +1733 trace-text trace, "eval", "unquote-splice" +1734 var in-unquote-payload-ah/eax: (addr handle cell) <- get in-left, right +1735 evaluate in-unquote-payload-ah, out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number +1736 # errors? skip +1737 { +1738 var error?/eax: boolean <- has-errors? trace +1739 compare error?, 0/false +1740 break-if-= +1741 trace-higher trace +1742 return +1743 } +1744 # while (*out-ah != null) out-ah = cdr(out-ah) +1745 { +1746 var out/eax: (addr cell) <- lookup *out-ah +1747 { +1748 var done?/eax: boolean <- nil? out +1749 compare done?, 0/false +1750 } +1751 break-if-!= +1752 out-ah <- get out, right +1753 loop +1754 } +1755 # append result of in-right +1756 var in-right-ah/ecx: (addr handle cell) <- get in, right +1757 evaluate-backquote in-right-ah, out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number +1758 trace-higher trace +1759 return +1760 } +1761 debug-print "19", 4/fg, 0/bg +1762 # otherwise continue copying +1763 trace-text trace, "eval", "backquote: copy" +1764 var out-ah/edi: (addr handle cell) <- copy _out-ah +1765 allocate-pair out-ah +1766 debug-print "20", 7/fg, 0/bg +1767 #? dump-cell-from-cursor-over-full-screen out-ah +1768 var out/eax: (addr cell) <- lookup *out-ah +1769 var out-left-ah/edx: (addr handle cell) <- get out, left +1770 debug-print "`(l", 3/fg, 0/bg +1771 evaluate-backquote in-left-ah, out-left-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number +1772 debug-print "`r)", 3/fg, 0/bg +1773 # errors? skip +1774 { +1775 var error?/eax: boolean <- has-errors? trace +1776 compare error?, 0/false +1777 break-if-= +1778 trace-higher trace +1779 return +1780 } +1781 var in-right-ah/ecx: (addr handle cell) <- get in, right +1782 var out-right-ah/edx: (addr handle cell) <- get out, right +1783 debug-print "`r(", 3/fg, 0/bg +1784 evaluate-backquote in-right-ah, out-right-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number +1785 debug-print "`r)", 3/fg, 0/bg +1786 trace-higher trace +1787 } +1788 +1789 fn test-evaluate-backquote-list { +1790 var nil-storage: (handle cell) +1791 var nil-ah/ecx: (addr handle cell) <- address nil-storage +1792 allocate-pair nil-ah +1793 var backquote-storage: (handle cell) +1794 var backquote-ah/edx: (addr handle cell) <- address backquote-storage +1795 new-symbol backquote-ah, "`" +1796 # input is `(a b) +1797 var a-storage: (handle cell) +1798 var a-ah/ebx: (addr handle cell) <- address a-storage +1799 new-symbol a-ah, "a" +1800 var b-storage: (handle cell) +1801 var b-ah/esi: (addr handle cell) <- address b-storage +1802 new-symbol b-ah, "b" +1803 var tmp-storage: (handle cell) +1804 var tmp-ah/eax: (addr handle cell) <- address tmp-storage +1805 new-pair tmp-ah, *b-ah, *nil-ah +1806 new-pair tmp-ah, *a-ah, *tmp-ah +1807 new-pair tmp-ah, *backquote-ah, *tmp-ah +1808 # +1809 var trace-storage: trace +1810 var trace/edi: (addr trace) <- address trace-storage +1811 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible +1812 evaluate tmp-ah, tmp-ah, *nil-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number +1813 # result is (a b) +1814 var result/eax: (addr cell) <- lookup *tmp-ah +1815 { +1816 var result-type/eax: (addr int) <- get result, type +1817 check-ints-equal *result-type, 0/pair, "F - test-evaluate-backquote-list/0" +1818 } +1819 { +1820 var a1-ah/eax: (addr handle cell) <- get result, left +1821 var a1/eax: (addr cell) <- lookup *a1-ah +1822 var check1/eax: boolean <- symbol-equal? a1, "a" +1823 check check1, "F - test-evaluate-backquote-list/1" +1824 } +1825 var rest-ah/eax: (addr handle cell) <- get result, right +1826 var rest/eax: (addr cell) <- lookup *rest-ah +1827 { +1828 var a2-ah/eax: (addr handle cell) <- get rest, left +1829 var a2/eax: (addr cell) <- lookup *a2-ah +1830 var check2/eax: boolean <- symbol-equal? a2, "b" +1831 check check2, "F - test-evaluate-backquote-list/2" +1832 } +1833 var rest-ah/eax: (addr handle cell) <- get rest, right +1834 var rest/eax: (addr cell) <- lookup *rest-ah +1835 var check3/eax: boolean <- nil? rest +1836 check check3, "F - test-evaluate-backquote-list/3" +1837 } +1838 +1839 fn test-evaluate-backquote-list-with-unquote { +1840 var nil-h: (handle cell) +1841 var nil-ah/eax: (addr handle cell) <- address nil-h +1842 allocate-pair nil-ah +1843 var backquote-h: (handle cell) +1844 var backquote-ah/eax: (addr handle cell) <- address backquote-h +1845 new-symbol backquote-ah, "`" +1846 var unquote-h: (handle cell) +1847 var unquote-ah/eax: (addr handle cell) <- address unquote-h +1848 new-symbol unquote-ah, "," +1849 var a-h: (handle cell) +1850 var a-ah/eax: (addr handle cell) <- address a-h +1851 new-symbol a-ah, "a" +1852 var b-h: (handle cell) +1853 var b-ah/eax: (addr handle cell) <- address b-h +1854 new-symbol b-ah, "b" +1855 # env = ((b . 3)) +1856 var val-h: (handle cell) +1857 var val-ah/eax: (addr handle cell) <- address val-h +1858 new-integer val-ah, 3 +1859 var env-h: (handle cell) +1860 var env-ah/eax: (addr handle cell) <- address env-h +1861 new-pair env-ah, b-h, val-h +1862 new-pair env-ah, env-h, nil-h +1863 # input is `(a ,b) +1864 var tmp-h: (handle cell) +1865 var tmp-ah/eax: (addr handle cell) <- address tmp-h +1866 # tmp = cons(unquote, b) +1867 new-pair tmp-ah, unquote-h, b-h +1868 # tmp = cons(tmp, nil) +1869 new-pair tmp-ah, tmp-h, nil-h +1870 # tmp = cons(a, tmp) +1871 new-pair tmp-ah, a-h, tmp-h +1872 # tmp = cons(backquote, tmp) +1873 new-pair tmp-ah, backquote-h, tmp-h +1874 # +1875 var trace-storage: trace +1876 var trace/edi: (addr trace) <- address trace-storage +1877 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible +1878 evaluate tmp-ah, tmp-ah, env-h, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number +1879 # result is (a 3) +1880 var result/eax: (addr cell) <- lookup *tmp-ah +1881 { +1882 var result-type/eax: (addr int) <- get result, type +1883 check-ints-equal *result-type, 0/pair, "F - test-evaluate-backquote-list-with-unquote/0" +1884 } +1885 { +1886 var a1-ah/eax: (addr handle cell) <- get result, left +1887 var a1/eax: (addr cell) <- lookup *a1-ah +1888 var check1/eax: boolean <- symbol-equal? a1, "a" +1889 check check1, "F - test-evaluate-backquote-list-with-unquote/1" +1890 } +1891 var rest-ah/eax: (addr handle cell) <- get result, right +1892 var rest/eax: (addr cell) <- lookup *rest-ah +1893 { +1894 var a2-ah/eax: (addr handle cell) <- get rest, left +1895 var a2/eax: (addr cell) <- lookup *a2-ah +1896 var a2-value-addr/eax: (addr float) <- get a2, number-data +1897 var a2-value/eax: int <- convert *a2-value-addr +1898 check-ints-equal a2-value, 3, "F - test-evaluate-backquote-list-with-unquote/2" +1899 } +1900 var rest-ah/eax: (addr handle cell) <- get rest, right +1901 var rest/eax: (addr cell) <- lookup *rest-ah +1902 var check3/eax: boolean <- nil? rest +1903 check check3, "F - test-evaluate-backquote-list-with-unquote/3" +1904 } +1905 +1906 fn test-evaluate-backquote-list-with-unquote-splice { +1907 var nil-h: (handle cell) +1908 var nil-ah/eax: (addr handle cell) <- address nil-h +1909 allocate-pair nil-ah +1910 var backquote-h: (handle cell) +1911 var backquote-ah/eax: (addr handle cell) <- address backquote-h +1912 new-symbol backquote-ah, "`" +1913 var unquote-splice-h: (handle cell) +1914 var unquote-splice-ah/eax: (addr handle cell) <- address unquote-splice-h +1915 new-symbol unquote-splice-ah, ",@" +1916 var a-h: (handle cell) +1917 var a-ah/eax: (addr handle cell) <- address a-h +1918 new-symbol a-ah, "a" +1919 var b-h: (handle cell) +1920 var b-ah/eax: (addr handle cell) <- address b-h +1921 new-symbol b-ah, "b" +1922 # env = ((b . (a 3))) +1923 var val-h: (handle cell) +1924 var val-ah/eax: (addr handle cell) <- address val-h +1925 new-integer val-ah, 3 +1926 new-pair val-ah, val-h, nil-h +1927 new-pair val-ah, a-h, val-h +1928 var env-h: (handle cell) +1929 var env-ah/eax: (addr handle cell) <- address env-h +1930 new-pair env-ah, b-h, val-h +1931 new-pair env-ah, env-h, nil-h +1932 # input is `(a ,@b b) +1933 var tmp-h: (handle cell) +1934 var tmp-ah/eax: (addr handle cell) <- address tmp-h +1935 # tmp = cons(b, nil) +1936 new-pair tmp-ah, b-h, nil-h +1937 # tmp2 = cons(unquote-splice, b) +1938 var tmp2-h: (handle cell) +1939 var tmp2-ah/ecx: (addr handle cell) <- address tmp2-h +1940 new-pair tmp2-ah, unquote-splice-h, b-h +1941 # tmp = cons(tmp2, tmp) +1942 new-pair tmp-ah, tmp2-h, tmp-h +1943 # tmp = cons(a, tmp) +1944 new-pair tmp-ah, a-h, tmp-h +1945 # tmp = cons(backquote, tmp) +1946 new-pair tmp-ah, backquote-h, tmp-h +1947 #? dump-cell-from-cursor-over-full-screen tmp-ah +1948 # +1949 var trace-storage: trace +1950 var trace/edi: (addr trace) <- address trace-storage +1951 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible +1952 evaluate tmp-ah, tmp-ah, env-h, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number +1953 # result is (a a 3 b) +1954 #? dump-cell-from-cursor-over-full-screen tmp-ah +1955 var result/eax: (addr cell) <- lookup *tmp-ah +1956 { +1957 var result-type/eax: (addr int) <- get result, type +1958 check-ints-equal *result-type, 0/pair, "F - test-evaluate-backquote-list-with-unquote-splice/0" +1959 } +1960 { +1961 var a1-ah/eax: (addr handle cell) <- get result, left +1962 var a1/eax: (addr cell) <- lookup *a1-ah +1963 var check1/eax: boolean <- symbol-equal? a1, "a" +1964 check check1, "F - test-evaluate-backquote-list-with-unquote-splice/1" +1965 } +1966 var rest-ah/eax: (addr handle cell) <- get result, right +1967 var rest/eax: (addr cell) <- lookup *rest-ah +1968 { +1969 var a2-ah/eax: (addr handle cell) <- get rest, left +1970 var a2/eax: (addr cell) <- lookup *a2-ah +1971 var check2/eax: boolean <- symbol-equal? a2, "a" +1972 check check2, "F - test-evaluate-backquote-list-with-unquote-splice/2" +1973 } +1974 var rest-ah/eax: (addr handle cell) <- get rest, right +1975 var rest/eax: (addr cell) <- lookup *rest-ah +1976 { +1977 var a3-ah/eax: (addr handle cell) <- get rest, left +1978 var a3/eax: (addr cell) <- lookup *a3-ah +1979 var a3-value-addr/eax: (addr float) <- get a3, number-data +1980 var a3-value/eax: int <- convert *a3-value-addr +1981 check-ints-equal a3-value, 3, "F - test-evaluate-backquote-list-with-unquote-splice/3" +1982 } +1983 var rest-ah/eax: (addr handle cell) <- get rest, right +1984 var rest/eax: (addr cell) <- lookup *rest-ah +1985 { +1986 var a4-ah/eax: (addr handle cell) <- get rest, left +1987 var a4/eax: (addr cell) <- lookup *a4-ah +1988 var check4/eax: boolean <- symbol-equal? a4, "b" +1989 check check4, "F - test-evaluate-backquote-list-with-unquote-splice/4" +1990 } +1991 var rest-ah/eax: (addr handle cell) <- get rest, right +1992 var rest/eax: (addr cell) <- lookup *rest-ah +1993 var check5/eax: boolean <- nil? rest +1994 check check5, "F - test-evaluate-backquote-list-with-unquote-splice/5" +1995 } diff --git a/html/shell/gap-buffer.mu.html b/html/shell/gap-buffer.mu.html index f22c381f..a45380dd 100644 --- a/html/shell/gap-buffer.mu.html +++ b/html/shell/gap-buffer.mu.html @@ -140,7 +140,7 @@ if ('onhashchange' in window) { 75 compare key, 0/null 76 break-if-= 77 var g/eax: grapheme <- copy key - 78 edit-gap-buffer self, g + 78 edit-gap-buffer self, g 79 loop 80 } 81 } @@ -1252,7 +1252,7 @@ if ('onhashchange' in window) { 1187 check-ints-equal x, 0/nul, "F - test-read-from-gap-buffer/right-4" 1188 } 1189 -1190 fn skip-whitespace-from-gap-buffer self: (addr gap-buffer) { +1190 fn skip-spaces-from-gap-buffer self: (addr gap-buffer) { 1191 var done?/eax: boolean <- gap-buffer-scan-done? self 1192 compare done?, 0/false 1193 break-if-!= @@ -1260,281 +1260,279 @@ if ('onhashchange' in window) { 1195 { 1196 compare g, 0x20/space 1197 break-if-= -1198 compare g, 0xa/newline -1199 break-if-= -1200 return -1201 } -1202 g <- read-from-gap-buffer self -1203 loop -1204 } -1205 -1206 fn edit-gap-buffer self: (addr gap-buffer), key: grapheme { -1207 var g/edx: grapheme <- copy key -1208 { -1209 compare g, 8/backspace -1210 break-if-!= -1211 delete-before-gap self -1212 return -1213 } -1214 { -1215 compare g, 0x80/left-arrow -1216 break-if-!= -1217 var dummy/eax: grapheme <- gap-left self -1218 return -1219 } -1220 { -1221 compare g, 0x83/right-arrow -1222 break-if-!= -1223 var dummy/eax: grapheme <- gap-right self -1224 return -1225 } -1226 { -1227 compare g, 6/ctrl-f -1228 break-if-!= -1229 gap-to-start-of-next-word self -1230 return -1231 } -1232 { -1233 compare g, 2/ctrl-b -1234 break-if-!= -1235 gap-to-end-of-previous-word self -1236 return -1237 } -1238 { -1239 compare g, 1/ctrl-a -1240 break-if-!= -1241 gap-to-previous-start-of-line self -1242 return -1243 } -1244 { -1245 compare g, 5/ctrl-e -1246 break-if-!= -1247 gap-to-next-end-of-line self -1248 return -1249 } -1250 { -1251 compare g, 0x81/down-arrow -1252 break-if-!= -1253 gap-down self -1254 return -1255 } -1256 { -1257 compare g, 0x82/up-arrow -1258 break-if-!= -1259 gap-up self -1260 return -1261 } -1262 { -1263 compare g, 0x15/ctrl-u -1264 break-if-!= -1265 clear-gap-buffer self -1266 return -1267 } -1268 { -1269 compare g, 9/tab -1270 break-if-!= -1271 # tab = 2 spaces -1272 add-code-point-at-gap self, 0x20/space -1273 add-code-point-at-gap self, 0x20/space -1274 return -1275 } -1276 # default: insert character -1277 add-grapheme-at-gap self, g -1278 } -1279 -1280 fn gap-to-start-of-next-word self: (addr gap-buffer) { -1281 var curr/eax: grapheme <- copy 0 -1282 # skip to next space -1283 { -1284 curr <- gap-right self -1285 compare curr, -1 +1198 return +1199 } +1200 g <- read-from-gap-buffer self +1201 loop +1202 } +1203 +1204 fn edit-gap-buffer self: (addr gap-buffer), key: grapheme { +1205 var g/edx: grapheme <- copy key +1206 { +1207 compare g, 8/backspace +1208 break-if-!= +1209 delete-before-gap self +1210 return +1211 } +1212 { +1213 compare g, 0x80/left-arrow +1214 break-if-!= +1215 var dummy/eax: grapheme <- gap-left self +1216 return +1217 } +1218 { +1219 compare g, 0x83/right-arrow +1220 break-if-!= +1221 var dummy/eax: grapheme <- gap-right self +1222 return +1223 } +1224 { +1225 compare g, 6/ctrl-f +1226 break-if-!= +1227 gap-to-start-of-next-word self +1228 return +1229 } +1230 { +1231 compare g, 2/ctrl-b +1232 break-if-!= +1233 gap-to-end-of-previous-word self +1234 return +1235 } +1236 { +1237 compare g, 1/ctrl-a +1238 break-if-!= +1239 gap-to-previous-start-of-line self +1240 return +1241 } +1242 { +1243 compare g, 5/ctrl-e +1244 break-if-!= +1245 gap-to-next-end-of-line self +1246 return +1247 } +1248 { +1249 compare g, 0x81/down-arrow +1250 break-if-!= +1251 gap-down self +1252 return +1253 } +1254 { +1255 compare g, 0x82/up-arrow +1256 break-if-!= +1257 gap-up self +1258 return +1259 } +1260 { +1261 compare g, 0x15/ctrl-u +1262 break-if-!= +1263 clear-gap-buffer self +1264 return +1265 } +1266 { +1267 compare g, 9/tab +1268 break-if-!= +1269 # tab = 2 spaces +1270 add-code-point-at-gap self, 0x20/space +1271 add-code-point-at-gap self, 0x20/space +1272 return +1273 } +1274 # default: insert character +1275 add-grapheme-at-gap self, g +1276 } +1277 +1278 fn gap-to-start-of-next-word self: (addr gap-buffer) { +1279 var curr/eax: grapheme <- copy 0 +1280 # skip to next space +1281 { +1282 curr <- gap-right self +1283 compare curr, -1 +1284 break-if-= +1285 compare curr, 0x20/space 1286 break-if-= -1287 compare curr, 0x20/space +1287 compare curr, 0xa/newline 1288 break-if-= -1289 compare curr, 0xa/newline -1290 break-if-= -1291 loop -1292 } -1293 # skip past spaces -1294 { -1295 curr <- gap-right self -1296 compare curr, -1 -1297 break-if-= -1298 compare curr, 0x20/space +1289 loop +1290 } +1291 # skip past spaces +1292 { +1293 curr <- gap-right self +1294 compare curr, -1 +1295 break-if-= +1296 compare curr, 0x20/space +1297 loop-if-= +1298 compare curr, 0xa/space 1299 loop-if-= -1300 compare curr, 0xa/space -1301 loop-if-= -1302 curr <- gap-left self -1303 break -1304 } -1305 } -1306 -1307 fn gap-to-end-of-previous-word self: (addr gap-buffer) { -1308 var curr/eax: grapheme <- copy 0 -1309 # skip to previous space -1310 { -1311 curr <- gap-left self -1312 compare curr, -1 +1300 curr <- gap-left self +1301 break +1302 } +1303 } +1304 +1305 fn gap-to-end-of-previous-word self: (addr gap-buffer) { +1306 var curr/eax: grapheme <- copy 0 +1307 # skip to previous space +1308 { +1309 curr <- gap-left self +1310 compare curr, -1 +1311 break-if-= +1312 compare curr, 0x20/space 1313 break-if-= -1314 compare curr, 0x20/space +1314 compare curr, 0xa/newline 1315 break-if-= -1316 compare curr, 0xa/newline -1317 break-if-= -1318 loop -1319 } -1320 # skip past all spaces but one -1321 { -1322 curr <- gap-left self -1323 compare curr, -1 -1324 break-if-= -1325 compare curr, 0x20/space +1316 loop +1317 } +1318 # skip past all spaces but one +1319 { +1320 curr <- gap-left self +1321 compare curr, -1 +1322 break-if-= +1323 compare curr, 0x20/space +1324 loop-if-= +1325 compare curr, 0xa/space 1326 loop-if-= -1327 compare curr, 0xa/space -1328 loop-if-= -1329 curr <- gap-right self -1330 break -1331 } -1332 } -1333 -1334 fn gap-to-previous-start-of-line self: (addr gap-buffer) { -1335 # skip past immediate newline -1336 var dummy/eax: grapheme <- gap-left self -1337 # skip to previous newline -1338 { -1339 dummy <- gap-left self -1340 { -1341 compare dummy, -1 -1342 break-if-!= -1343 return -1344 } -1345 { -1346 compare dummy, 0xa/newline -1347 break-if-!= -1348 dummy <- gap-right self -1349 return -1350 } -1351 loop -1352 } -1353 } -1354 -1355 fn gap-to-next-end-of-line self: (addr gap-buffer) { -1356 # skip past immediate newline -1357 var dummy/eax: grapheme <- gap-right self -1358 # skip to next newline -1359 { -1360 dummy <- gap-right self -1361 { -1362 compare dummy, -1 -1363 break-if-!= -1364 return -1365 } -1366 { -1367 compare dummy, 0xa/newline -1368 break-if-!= -1369 dummy <- gap-left self -1370 return -1371 } -1372 loop -1373 } -1374 } -1375 -1376 fn gap-up self: (addr gap-buffer) { -1377 # compute column -1378 var col/edx: int <- count-columns-to-start-of-line self -1379 # -1380 gap-to-previous-start-of-line self -1381 # skip ahead by up to col on previous line -1382 var i/ecx: int <- copy 0 -1383 { -1384 compare i, col -1385 break-if->= -1386 var curr/eax: grapheme <- gap-right self -1387 { -1388 compare curr, -1 -1389 break-if-!= -1390 return -1391 } -1392 compare curr, 0xa/newline -1393 { -1394 break-if-!= -1395 curr <- gap-left self -1396 return -1397 } -1398 i <- increment -1399 loop -1400 } -1401 } -1402 -1403 fn gap-down self: (addr gap-buffer) { -1404 # compute column -1405 var col/edx: int <- count-columns-to-start-of-line self -1406 # skip to start of next line -1407 gap-to-end-of-line self -1408 var dummy/eax: grapheme <- gap-right self -1409 # skip ahead by up to col on previous line -1410 var i/ecx: int <- copy 0 -1411 { -1412 compare i, col -1413 break-if->= -1414 var curr/eax: grapheme <- gap-right self -1415 { -1416 compare curr, -1 -1417 break-if-!= -1418 return -1419 } -1420 compare curr, 0xa/newline -1421 { -1422 break-if-!= -1423 curr <- gap-left self -1424 return -1425 } -1426 i <- increment -1427 loop -1428 } -1429 } -1430 -1431 fn count-columns-to-start-of-line self: (addr gap-buffer) -> _/edx: int { -1432 var count/edx: int <- copy 0 -1433 var dummy/eax: grapheme <- copy 0 -1434 # skip to previous newline -1435 { -1436 dummy <- gap-left self -1437 { -1438 compare dummy, -1 -1439 break-if-!= -1440 return count -1441 } -1442 { -1443 compare dummy, 0xa/newline -1444 break-if-!= -1445 dummy <- gap-right self -1446 return count -1447 } -1448 count <- increment -1449 loop -1450 } -1451 return count -1452 } -1453 -1454 fn gap-to-end-of-line self: (addr gap-buffer) { -1455 var dummy/eax: grapheme <- copy 0 -1456 # skip to next newline -1457 { -1458 dummy <- gap-right self -1459 { -1460 compare dummy, -1 -1461 break-if-!= -1462 return -1463 } -1464 { -1465 compare dummy, 0xa/newline -1466 break-if-!= -1467 dummy <- gap-left self -1468 return -1469 } -1470 loop -1471 } -1472 } +1327 curr <- gap-right self +1328 break +1329 } +1330 } +1331 +1332 fn gap-to-previous-start-of-line self: (addr gap-buffer) { +1333 # skip past immediate newline +1334 var dummy/eax: grapheme <- gap-left self +1335 # skip to previous newline +1336 { +1337 dummy <- gap-left self +1338 { +1339 compare dummy, -1 +1340 break-if-!= +1341 return +1342 } +1343 { +1344 compare dummy, 0xa/newline +1345 break-if-!= +1346 dummy <- gap-right self +1347 return +1348 } +1349 loop +1350 } +1351 } +1352 +1353 fn gap-to-next-end-of-line self: (addr gap-buffer) { +1354 # skip past immediate newline +1355 var dummy/eax: grapheme <- gap-right self +1356 # skip to next newline +1357 { +1358 dummy <- gap-right self +1359 { +1360 compare dummy, -1 +1361 break-if-!= +1362 return +1363 } +1364 { +1365 compare dummy, 0xa/newline +1366 break-if-!= +1367 dummy <- gap-left self +1368 return +1369 } +1370 loop +1371 } +1372 } +1373 +1374 fn gap-up self: (addr gap-buffer) { +1375 # compute column +1376 var col/edx: int <- count-columns-to-start-of-line self +1377 # +1378 gap-to-previous-start-of-line self +1379 # skip ahead by up to col on previous line +1380 var i/ecx: int <- copy 0 +1381 { +1382 compare i, col +1383 break-if->= +1384 var curr/eax: grapheme <- gap-right self +1385 { +1386 compare curr, -1 +1387 break-if-!= +1388 return +1389 } +1390 compare curr, 0xa/newline +1391 { +1392 break-if-!= +1393 curr <- gap-left self +1394 return +1395 } +1396 i <- increment +1397 loop +1398 } +1399 } +1400 +1401 fn gap-down self: (addr gap-buffer) { +1402 # compute column +1403 var col/edx: int <- count-columns-to-start-of-line self +1404 # skip to start of next line +1405 gap-to-end-of-line self +1406 var dummy/eax: grapheme <- gap-right self +1407 # skip ahead by up to col on previous line +1408 var i/ecx: int <- copy 0 +1409 { +1410 compare i, col +1411 break-if->= +1412 var curr/eax: grapheme <- gap-right self +1413 { +1414 compare curr, -1 +1415 break-if-!= +1416 return +1417 } +1418 compare curr, 0xa/newline +1419 { +1420 break-if-!= +1421 curr <- gap-left self +1422 return +1423 } +1424 i <- increment +1425 loop +1426 } +1427 } +1428 +1429 fn count-columns-to-start-of-line self: (addr gap-buffer) -> _/edx: int { +1430 var count/edx: int <- copy 0 +1431 var dummy/eax: grapheme <- copy 0 +1432 # skip to previous newline +1433 { +1434 dummy <- gap-left self +1435 { +1436 compare dummy, -1 +1437 break-if-!= +1438 return count +1439 } +1440 { +1441 compare dummy, 0xa/newline +1442 break-if-!= +1443 dummy <- gap-right self +1444 return count +1445 } +1446 count <- increment +1447 loop +1448 } +1449 return count +1450 } +1451 +1452 fn gap-to-end-of-line self: (addr gap-buffer) { +1453 var dummy/eax: grapheme <- copy 0 +1454 # skip to next newline +1455 { +1456 dummy <- gap-right self +1457 { +1458 compare dummy, -1 +1459 break-if-!= +1460 return +1461 } +1462 { +1463 compare dummy, 0xa/newline +1464 break-if-!= +1465 dummy <- gap-left self +1466 return +1467 } +1468 loop +1469 } +1470 } diff --git a/html/shell/global.mu.html b/html/shell/global.mu.html index 01cdd2cc..38b55519 100644 --- a/html/shell/global.mu.html +++ b/html/shell/global.mu.html @@ -193,7 +193,7 @@ if ('onhashchange' in window) { 129 { 130 var curr-offset/ebx: (offset global) <- compute-offset data, curr-index 131 var curr/ebx: (addr global) <- index data, curr-offset -132 var continue?/eax: boolean <- primitive-global? curr +132 var continue?/eax: boolean <- primitive-global? curr 133 compare continue?, 0/false 134 break-if-= 135 curr-index <- increment @@ -260,7 +260,7 @@ if ('onhashchange' in window) { 196 loop 197 } 198 # render primitives on top -199 render-primitives screen, 1/xmin=padding-left, 0x55/xmax, 0x2f/ymax +199 render-primitives screen, 1/xmin=padding-left, 0x55/xmax, 0x2f/ymax 200 } 201 202 fn render-globals-menu screen: (addr screen), _self: (addr global-table) { @@ -308,7 +308,7 @@ if ('onhashchange' in window) { 244 var curr-global/eax: (addr global) <- index data, cursor-offset 245 var curr-editor-ah/eax: (addr handle gap-buffer) <- get curr-global, input 246 var curr-editor/eax: (addr gap-buffer) <- lookup *curr-editor-ah -247 edit-gap-buffer curr-editor, key +247 edit-gap-buffer curr-editor, key 248 } 249 250 fn create-empty-global _self: (addr global-table), name-stream: (addr stream byte), capacity: int { diff --git a/html/shell/infix.mu.html b/html/shell/infix.mu.html new file mode 100644 index 00000000..f3529c96 --- /dev/null +++ b/html/shell/infix.mu.html @@ -0,0 +1,644 @@ + + + + +Mu - shell/infix.mu + + + + + + + + + + +https://github.com/akkartik/mu/blob/main/shell/infix.mu +

+  1 fn transform-infix x-ah: (addr handle cell), trace: (addr trace) {
+  2   trace-text trace, "infix", "transform infix"
+  3   trace-lower trace
+  4 #?   trace-text trace, "infix", "todo"
+  5 #?   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "a:", 2/fg 0/bg
+  6 #?   dump-cell-from-cursor-over-full-screen x-ah, 7/fg 0/bg
+  7   transform-infix-2 x-ah, trace, 1/at-head-of-list
+  8   trace-higher trace
+  9 }
+ 10 
+ 11 # Break any symbols containing operators down in place into s-expressions
+ 12 # Transform (... sym op sym ...) greedily in place into (... (op sym sym) ...)
+ 13 # Lisp code typed in at the keyboard will never have cycles
+ 14 fn transform-infix-2 _x-ah: (addr handle cell), trace: (addr trace), at-head-of-list?: boolean {
+ 15   var x-ah/edi: (addr handle cell) <- copy _x-ah
+ 16   var x/eax: (addr cell) <- lookup *x-ah
+ 17 +-- 14 lines: # trace x-ah -----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
+ 31   trace-lower trace
+ 32 #?   {
+ 33 #?     var foo/eax: int <- copy x
+ 34 #?     draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, foo, 7/fg 0/bg
+ 35 #?   }
+ 36 #?   dump-cell-from-cursor-over-full-screen x-ah, 5/fg 0/bg
+ 37   # null? return
+ 38   compare x, 0
+ 39   {
+ 40     break-if-!=
+ 41     trace-higher trace
+ 42     trace-text trace, "infix", "=> NULL"
+ 43     return
+ 44   }
+ 45   # nil? return
+ 46   {
+ 47     var nil?/eax: boolean <- nil? x
+ 48     compare nil?, 0/false
+ 49     break-if-=
+ 50     trace-higher trace
+ 51     trace-text trace, "infix", "=> nil"
+ 52     return
+ 53   }
+ 54   var x-type/ecx: (addr int) <- get x, type
+ 55   # symbol? maybe break it down into a pair
+ 56   {
+ 57     compare *x-type, 2/symbol
+ 58     break-if-!=
+ 59     tokenize-infix x-ah, trace
+ 60   }
+ 61   # not a pair? return
+ 62 #?   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "a", 4/fg 0/bg
+ 63 #?   draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, *x-type, 5/fg 0/bg
+ 64   {
+ 65     compare *x-type, 0/pair
+ 66     break-if-=
+ 67     trace-higher trace
+ 68 +-- 15 lines: # trace "=> " x-ah -----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
+ 83 #?     draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "^", 4/fg 0/bg
+ 84     return
+ 85   }
+ 86 #?   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "b", 4/fg 0/bg
+ 87   # singleton operator? unwrap
+ 88   {
+ 89     var first-ah/ecx: (addr handle cell) <- get x, left
+ 90     {
+ 91       var first/eax: (addr cell) <- lookup *first-ah
+ 92       var infix?/eax: boolean <- operator-symbol? first
+ 93       compare infix?, 0/false
+ 94     }
+ 95     break-if-=
+ 96     var rest-ah/eax: (addr handle cell) <- get x, right
+ 97     var rest/eax: (addr cell) <- lookup *rest-ah
+ 98     var rest-nil?/eax: boolean <- nil? rest
+ 99     compare rest-nil?, 0/false
+100     break-if-=
+101     copy-object first-ah, x-ah
+102     trace-higher trace
+103 +-- 15 lines: # trace "=> " x-ah -----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
+118     return
+119   }
+120 #?   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "c", 4/fg 0/bg
+121   ## non-singleton pair
+122   # try to "pinch out" (op expr op ...) into ((op expr) op ...)
+123   # (op expr expr ...) => operator in prefix position; do nothing
+124   {
+125     compare at-head-of-list?, 0/false
+126     break-if-=
+127     var first-ah/ecx: (addr handle cell) <- get x, left
+128     var rest-ah/esi: (addr handle cell) <- get x, right
+129     var first/eax: (addr cell) <- lookup *first-ah
+130     var first-infix?/eax: boolean <- operator-symbol? first
+131     compare first-infix?, 0/false
+132     break-if-=
+133     var rest/eax: (addr cell) <- lookup *rest-ah
+134     {
+135       var continue?/eax: boolean <- not-null-not-nil-pair? rest
+136       compare continue?, 0/false
+137     }
+138     break-if-=
+139     var second-ah/edx: (addr handle cell) <- get rest, left
+140     rest-ah <- get rest, right
+141     var rest/eax: (addr cell) <- lookup *rest-ah
+142     {
+143       var continue?/eax: boolean <- not-null-not-nil-pair? rest
+144       compare continue?, 0/false
+145     }
+146     break-if-=
+147     var third-ah/ebx: (addr handle cell) <- get rest, left
+148     {
+149       var third/eax: (addr cell) <- lookup *third-ah
+150       var third-is-operator?/eax: boolean <- operator-symbol? third
+151       compare third-is-operator?, 0/false
+152     }
+153     break-if-=
+154     # if first and third are operators, bud out first two
+155     var saved-rest-h: (handle cell)
+156     var saved-rest-ah/eax: (addr handle cell) <- address saved-rest-h
+157     copy-object rest-ah, saved-rest-ah
+158     nil rest-ah
+159     var result-h: (handle cell)
+160     var result-ah/eax: (addr handle cell) <- address result-h
+161     new-pair result-ah, *x-ah, saved-rest-h
+162     # save
+163     copy-object result-ah, x-ah
+164     # there was a mutation; rerun
+165     transform-infix-2 x-ah, trace, 1/at-head-of-list
+166   }
+167   # try to "pinch out" (... expr op expr ...) pattern
+168   $transform-infix-2:pinch: {
+169     # scan past first three elements
+170     var first-ah/ecx: (addr handle cell) <- get x, left
+171     var rest-ah/esi: (addr handle cell) <- get x, right
+172     {
+173       var quote-or-unquote?/eax: boolean <- quote-or-unquote? first-ah
+174       compare quote-or-unquote?, 0/false
+175     }
+176     break-if-!=
+177     var rest/eax: (addr cell) <- lookup *rest-ah
+178     {
+179       var continue?/eax: boolean <- not-null-not-nil-pair? rest
+180       compare continue?, 0/false
+181     }
+182     break-if-=
+183 #?     draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "d", 4/fg 0/bg
+184 #?     dump-cell-from-cursor-over-full-screen rest-ah, 7/fg 0/bg
+185     var second-ah/edx: (addr handle cell) <- get rest, left
+186     rest-ah <- get rest, right
+187     var rest/eax: (addr cell) <- lookup *rest-ah
+188     {
+189       var continue?/eax: boolean <- not-null-not-nil-pair? rest
+190       compare continue?, 0/false
+191     }
+192     break-if-=
+193 #?     draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "e", 4/fg 0/bg
+194     var third-ah/ebx: (addr handle cell) <- get rest, left
+195     rest-ah <- get rest, right
+196     # if second is not an operator, break
+197     {
+198       var second/eax: (addr cell) <- lookup *second-ah
+199       var infix?/eax: boolean <- operator-symbol? second
+200       compare infix?, 0/false
+201     }
+202     break-if-=
+203 #?     draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "f", 4/fg 0/bg
+204     # swap the top 2
+205     swap-cells first-ah, second-ah
+206     ## if we're at the head of the list and there's just three elements, stop there
+207     {
+208       compare at-head-of-list?, 0/false
+209       break-if-=
+210       rest <- lookup *rest-ah
+211       var rest-nil?/eax: boolean <- nil? rest
+212       compare rest-nil?, 0/false
+213       break-if-!= $transform-infix-2:pinch
+214     }
+215     ## otherwise perform a more complex 'rotation'
+216 #?     draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "g", 4/fg 0/bg
+217     # save and clear third->right
+218     var saved-rest-h: (handle cell)
+219     var saved-rest-ah/eax: (addr handle cell) <- address saved-rest-h
+220     copy-object rest-ah, saved-rest-ah
+221     nil rest-ah
+222     # create new-node out of first..third and rest
+223     var result-h: (handle cell)
+224     var result-ah/eax: (addr handle cell) <- address result-h
+225     new-pair result-ah, *x-ah, saved-rest-h
+226     # save
+227     copy-object result-ah, x-ah
+228     # there was a mutation; rerun
+229     transform-infix-2 x-ah, trace, 1/at-head-of-list
+230     return
+231   }
+232   # recurse
+233 #?   dump-cell-from-cursor-over-full-screen x-ah, 1/fg 0/bg
+234   var left-ah/ecx: (addr handle cell) <- get x, left
+235 #?   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "x", 1/fg 0/bg
+236 #?   dump-cell-from-cursor-over-full-screen left-ah, 2/fg 0/bg
+237   transform-infix-2 left-ah, trace, 1/at-head-of-list
+238   var right-ah/edx: (addr handle cell) <- get x, right
+239 #?   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "y", 1/fg 0/bg
+240 #?   dump-cell-from-cursor-over-full-screen right-ah, 3/fg 0/bg
+241   var right-at-head-of-list?/eax: boolean <- copy at-head-of-list?
+242   {
+243     compare right-at-head-of-list?, 0/false
+244     break-if-=
+245     # if left is a quote or unquote, cdr is still head of list
+246     {
+247       var left-is-quote-or-unquote?/eax: boolean <- quote-or-unquote? left-ah
+248       compare left-is-quote-or-unquote?, 0/false
+249     }
+250     break-if-!=
+251     right-at-head-of-list? <- copy 0/false
+252   }
+253   transform-infix-2 right-ah, trace, right-at-head-of-list?
+254 #?   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "z", 1/fg 0/bg
+255   trace-higher trace
+256 +-- 15 lines: # trace "=> " x-ah -----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
+271 }
+272 
+273 fn not-null-not-nil-pair? _x: (addr cell) -> _/eax: boolean {
+274   var x/esi: (addr cell) <- copy _x
+275   compare x, 0
+276   {
+277     break-if-!=
+278     return 0/false
+279   }
+280   var x-type/eax: (addr int) <- get x, type
+281   compare *x-type, 0/pair
+282   {
+283     break-if-=
+284     return 0/false
+285   }
+286   var nil?/eax: boolean <- nil? x
+287   compare nil?, 0/false
+288   {
+289     break-if-=
+290     return 0/false
+291   }
+292   return 1/true
+293 }
+294 
+295 fn swap-cells a-ah: (addr handle cell), b-ah: (addr handle cell) {
+296   var tmp-h: (handle cell)
+297   var tmp-ah/eax: (addr handle cell) <- address tmp-h
+298   copy-object a-ah, tmp-ah
+299   copy-object b-ah, a-ah
+300   copy-object tmp-ah, b-ah
+301 }
+302 
+303 fn tokenize-infix _sym-ah: (addr handle cell), trace: (addr trace) {
+304   var sym-ah/eax: (addr handle cell) <- copy _sym-ah
+305   var sym/eax: (addr cell) <- lookup *sym-ah
+306   var sym-data-ah/eax: (addr handle stream byte) <- get sym, text-data
+307   var _sym-data/eax: (addr stream byte) <- lookup *sym-data-ah
+308   var sym-data/esi: (addr stream byte) <- copy _sym-data
+309   rewind-stream sym-data
+310   # read sym into a gap buffer and insert spaces in a few places
+311   var buffer-storage: gap-buffer
+312   var buffer/edi: (addr gap-buffer) <- address buffer-storage
+313   initialize-gap-buffer buffer, 0x40/max-symbol-size
+314   # scan for first non-$
+315   var g/eax: grapheme <- read-grapheme sym-data
+316   add-grapheme-at-gap buffer, g
+317   {
+318     compare g, 0x24/dollar
+319     break-if-!=
+320     {
+321       var done?/eax: boolean <- stream-empty? sym-data
+322       compare done?, 0/false
+323       break-if-=
+324       return  # symbol is all '$'s; do nothing
+325     }
+326     g <- read-grapheme sym-data
+327     add-grapheme-at-gap buffer, g
+328     loop
+329   }
+330   var tokenization-needed?: boolean
+331   var _operator-so-far?/eax: boolean <- operator-grapheme? g
+332   var operator-so-far?/ecx: boolean <- copy _operator-so-far?
+333   {
+334     var done?/eax: boolean <- stream-empty? sym-data
+335     compare done?, 0/false
+336     break-if-!=
+337     var g/eax: grapheme <- read-grapheme sym-data
+338     {
+339       var curr-operator?/eax: boolean <- operator-grapheme? g
+340       compare curr-operator?, operator-so-far?
+341       break-if-=
+342       # state change; insert a space
+343       add-grapheme-at-gap buffer, 0x20/space
+344       operator-so-far? <- copy curr-operator?
+345       copy-to tokenization-needed?, 1/true
+346     }
+347     add-grapheme-at-gap buffer, g
+348     loop
+349   }
+350   compare tokenization-needed?, 0/false
+351   break-if-=
+352 #?   {
+353 #?     var dummy1/eax: int <- copy 0
+354 #?     var dummy2/ecx: int <- copy 0
+355 #?     dummy1, dummy2 <- render-gap-buffer-wrapping-right-then-down 0/screen, buffer, 0x20/xmin 5/ymin, 0x80/xmax 0x30/ymax, 0/no-cursor, 3/fg 0/bg
+356 #?     {
+357 #?       loop
+358 #?     }
+359 #?   }
+360   # recursively process buffer
+361   # this time we're guaranteed we won't enter tokenize-infix
+362   read-cell buffer, _sym-ah, trace
+363 }
+364 
+365 fn test-infix {
+366   check-infix "abc", "abc", "F - test-infix/regular-symbol"
+367   check-infix "-3", "-3", "F - test-infix/negative-integer-literal"
+368   check-infix "[a b+c]", "[a b+c]", "F - test-infix/string-literal"
+369   check-infix "$", "$", "F - test-infix/dollar-sym"
+370   check-infix "$$", "$$", "F - test-infix/dollar-sym-2"
+371   check-infix "$a", "$a", "F - test-infix/dollar-var"
+372   check-infix "$+", "$+", "F - test-infix/dollar-operator"
+373   check-infix "(+)", "+", "F - test-infix/operator-without-args"
+374   check-infix "(= (+) 3)", "(= + 3)", "F - test-infix/operator-without-args-2"
+375   check-infix "($+)", "$+", "F - test-infix/dollar-operator-without-args"
+376   check-infix "',(a + b)", "',(+ a b)", "F - test-infix/nested-quotes"
+377   check-infix "',(+)", "',+", "F - test-infix/nested-quotes-2"
+378   check-infix "(a + b)", "(+ a b)", "F - test-infix/simple-list"
+379   check-infix "(a (+) b)", "(a + b)", "F - test-infix/wrapped-operator"
+380   check-infix "(+ a b)", "(+ a b)", "F - test-infix/prefix-operator"
+381   check-infix "(a . b)", "(a . b)", "F - test-infix/dot-operator"
+382   check-infix "(a b . c)", "(a b . c)", "F - test-infix/dotted-list"
+383   check-infix "(+ . b)", "(+ . b)", "F - test-infix/dotted-list-with-operator"
+384   check-infix "(+ a)", "(+ a)", "F - test-infix/unary-operator"
+385   check-infix "((a + b))", "((+ a b))", "F - test-infix/nested-list"
+386   check-infix "(do (a + b))", "(do (+ a b))", "F - test-infix/nested-list-2"
+387   check-infix "(a = (a + 1))", "(= a (+ a 1))", "F - test-infix/nested-list-3"
+388   check-infix "(a + b + c)", "(+ (+ a b) c)", "F - test-infix/left-associative"
+389   check-infix "(f a + b)", "(f (+ a b))", "F - test-infix/higher-precedence-than-call"
+390   check-infix "(f a + b c + d)", "(f (+ a b) (+ c d))", "F - test-infix/multiple"
+391   check-infix "+a", "(+ a)", "F - test-infix/unary-operator-2"
+392   check-infix "(+a)", "((+ a))", "F - test-infix/unary-operator-3"
+393   check-infix "-a", "(- a)", "F - test-infix/unary-operator-4"
+394   check-infix "a+b", "(+ a b)", "F - test-infix/no-spaces"
+395   check-infix "3+1", "(+ 3 1)", "F - test-infix/no-spaces-starting-with-digit"
+396   check-infix "',a+b", "',(+ a b)", "F - test-infix/no-spaces-with-nested-quotes"
+397   check-infix "$a+b", "(+ $a b)", "F - test-infix/no-spaces-2"
+398   check-infix "-a+b", "(+ (- a) b)", "F - test-infix/unary-over-binary"
+399   check-infix "~a+b", "(+ (~ a) b)", "F - test-infix/unary-complement"
+400   check-infix "(n * n-1)", "(* n (- n 1))", "F - test-infix/no-spaces-over-spaces"
+401   check-infix "`(a + b)", "`(+ a b)", "F - test-infix/backquote"
+402   check-infix "`(+ a b)", "`(+ a b)", "F - test-infix/backquote-2"
+403   check-infix ",@a+b", ",@(+ a b)", "F - test-infix/unquote-splice"
+404   check-infix ",@(a + b)", ",@(+ a b)", "F - test-infix/unquote-splice-2"
+405 }
+406 
+407 # helpers
+408 
+409 fn operator-symbol? _x: (addr cell) -> _/eax: boolean {
+410   var x/esi: (addr cell) <- copy _x
+411   {
+412     var x-type/eax: (addr int) <- get x, type
+413     compare *x-type, 2/symbol
+414     break-if-=
+415     return 0/false
+416   }
+417   var x-data-ah/eax: (addr handle stream byte) <- get x, text-data
+418   var _x-data/eax: (addr stream byte) <- lookup *x-data-ah
+419   var x-data/esi: (addr stream byte) <- copy _x-data
+420   rewind-stream x-data
+421   var g/eax: grapheme <- read-grapheme x-data
+422   # special case: '$' is reserved for gensyms, and can work with either
+423   # operator or non-operator symbols.
+424   {
+425     compare g, 0x24/dollar
+426     break-if-!=
+427     {
+428       var all-dollars?/eax: boolean <- stream-empty? x-data
+429       compare all-dollars?, 0/false
+430       break-if-=
+431       # '$', '$$', '$$$', etc. are regular symbols
+432       return 0/false
+433     }
+434     g <- read-grapheme x-data
+435     loop
+436   }
+437   {
+438     {
+439       var result/eax: boolean <- operator-grapheme? g
+440       compare result, 0/false
+441       break-if-!=
+442       return 0/false
+443     }
+444     {
+445       var done?/eax: boolean <- stream-empty? x-data
+446       compare done?, 0/false
+447     }
+448     break-if-!=
+449     g <- read-grapheme x-data
+450     loop
+451   }
+452   return 1/true
+453 }
+454 
+455 # just a short list of operator graphemes for now
+456 fn operator-grapheme? g: grapheme -> _/eax: boolean {
+457   # '$' is special and can be in either a symbol or operator; here we treat it as a symbol
+458   compare g, 0x25/percent
+459   {
+460     break-if-!=
+461     return 1/true
+462   }
+463   compare g, 0x26/ampersand
+464   {
+465     break-if-!=
+466     return 1/true
+467   }
+468   compare g, 0x2a/asterisk
+469   {
+470     break-if-!=
+471     return 1/true
+472   }
+473   compare g, 0x2b/plus
+474   {
+475     break-if-!=
+476     return 1/true
+477   }
+478   compare g, 0x2d/dash  # '-' not allowed in symbols
+479   {
+480     break-if-!=
+481     return 1/true
+482   }
+483   compare g, 0x2e/period
+484   {
+485     break-if-!=
+486     return 1/true
+487   }
+488   compare g, 0x2f/slash
+489   {
+490     break-if-!=
+491     return 1/true
+492   }
+493   compare g, 0x3a/colon
+494   {
+495     break-if-!=
+496     return 1/true
+497   }
+498   compare g, 0x3b/semi-colon
+499   {
+500     break-if-!=
+501     return 1/true
+502   }
+503   compare g, 0x3c/less-than
+504   {
+505     break-if-!=
+506     return 1/true
+507   }
+508   compare g, 0x3d/equal
+509   {
+510     break-if-!=
+511     return 1/true
+512   }
+513   compare g, 0x3e/greater-than
+514   {
+515     break-if-!=
+516     return 1/true
+517   }
+518   # '?' is a symbol char
+519   compare g, 0x5c/backslash
+520   {
+521     break-if-!=
+522     return 1/true
+523   }
+524   compare g, 0x5e/caret
+525   {
+526     break-if-!=
+527     return 1/true
+528   }
+529   # '_' is a symbol char
+530   compare g, 0x7c/vertical-line
+531   {
+532     break-if-!=
+533     return 1/true
+534   }
+535   compare g, 0x7e/tilde
+536   {
+537     break-if-!=
+538     return 1/true
+539   }
+540   return 0/false
+541 }
+542 
+543 fn quote-or-unquote? _x-ah: (addr handle cell) -> _/eax: boolean {
+544   var x-ah/eax: (addr handle cell) <- copy _x-ah
+545   var x/eax: (addr cell) <- lookup *x-ah
+546   {
+547     var quote?/eax: boolean <- symbol-equal? x, "'"
+548     compare quote?, 0/false
+549     break-if-=
+550     return 1/true
+551   }
+552   {
+553     var backquote?/eax: boolean <- symbol-equal? x, "`"
+554     compare backquote?, 0/false
+555     break-if-=
+556     return 1/true
+557   }
+558   {
+559     var unquote?/eax: boolean <- symbol-equal? x, ","
+560     compare unquote?, 0/false
+561     break-if-=
+562     return 1/true
+563   }
+564   {
+565     var unquote-splice?/eax: boolean <- symbol-equal? x, ",@"
+566     compare unquote-splice?, 0/false
+567     break-if-=
+568     return 1/true
+569   }
+570   return 0/false
+571 }
+572 
+573 # helpers for tests
+574 
+575 fn check-infix actual: (addr array byte), expected: (addr array byte), message: (addr array byte) {
+576   var trace-storage: trace
+577   var trace/edx: (addr trace) <- address trace-storage
+578 #?   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+579   initialize-trace trace, 0x10/levels, 0x1000/capacity, 0/visible
+580   #
+581   var actual-buffer-storage: gap-buffer
+582   var actual-buffer/eax: (addr gap-buffer) <- address actual-buffer-storage
+583   initialize-gap-buffer-with actual-buffer, actual
+584   var actual-tree-h: (handle cell)
+585   var actual-tree-ah/esi: (addr handle cell) <- address actual-tree-h
+586   read-cell actual-buffer, actual-tree-ah, trace
+587 #?   dump-trace-with-label trace, "infix"
+588   dump-cell-from-cursor-over-full-screen actual-tree-ah, 7/fg 0/bg
+589   var _actual-tree/eax: (addr cell) <- lookup *actual-tree-ah
+590   var actual-tree/esi: (addr cell) <- copy _actual-tree
+591   #
+592   var expected-buffer-storage: gap-buffer
+593   var expected-buffer/eax: (addr gap-buffer) <- address expected-buffer-storage
+594   initialize-gap-buffer-with expected-buffer, expected
+595   var expected-tree-h: (handle cell)
+596   var expected-tree-ah/edi: (addr handle cell) <- address expected-tree-h
+597   read-without-infix expected-buffer, expected-tree-ah, trace
+598   var expected-tree/eax: (addr cell) <- lookup *expected-tree-ah
+599   #
+600   var match?/eax: boolean <- cell-isomorphic? actual-tree, expected-tree, trace
+601   check match?, message
+602 }
+603 
+604 fn read-without-infix in: (addr gap-buffer), out: (addr handle cell), trace: (addr trace) {
+605   # eagerly tokenize everything so that the phases are easier to see in the trace
+606   var tokens-storage: (stream token 0x400)
+607   var tokens/edx: (addr stream token) <- address tokens-storage
+608   tokenize in, tokens, trace
+609   var error?/eax: boolean <- has-errors? trace
+610   compare error?, 0/false
+611   {
+612     break-if-=
+613     dump-trace trace
+614     return
+615   }
+616   # insert more parens based on indentation
+617   var parenthesized-tokens-storage: (stream token 0x400)
+618   var parenthesized-tokens/ecx: (addr stream token) <- address parenthesized-tokens-storage
+619   parenthesize tokens, parenthesized-tokens, trace
+620   var error?/eax: boolean <- has-errors? trace
+621   compare error?, 0/false
+622   {
+623     break-if-=
+624     dump-trace trace
+625     return
+626   }
+627   parse-input parenthesized-tokens, out, trace
+628 }
+

+ + + diff --git a/html/shell/int-stack.mu.html b/html/shell/int-stack.mu.html new file mode 100644 index 00000000..0333dc5d --- /dev/null +++ b/html/shell/int-stack.mu.html @@ -0,0 +1,135 @@ + + + + +Mu - shell/int-stack.mu + + + + + + + + + + +https://github.com/akkartik/mu/blob/main/shell/int-stack.mu +

+ 1 type int-stack {
+ 2   data: (handle array int)
+ 3   top: int
+ 4 }
+ 5 
+ 6 fn initialize-int-stack _self: (addr int-stack), n: int {
+ 7   var self/esi: (addr int-stack) <- copy _self
+ 8   var d/edi: (addr handle array int) <- get self, data
+ 9   populate d, n
+10   var top/eax: (addr int) <- get self, top
+11   copy-to *top, 0
+12 }
+13 
+14 fn push-int-stack _self: (addr int-stack), _val: int {
+15   var self/esi: (addr int-stack) <- copy _self
+16   var top-addr/ecx: (addr int) <- get self, top
+17   var data-ah/edx: (addr handle array int) <- get self, data
+18   var data/eax: (addr array int) <- lookup *data-ah
+19   var top/edx: int <- copy *top-addr
+20   var dest-addr/edx: (addr int) <- index data, top
+21   var val/eax: int <- copy _val
+22   copy-to *dest-addr, val
+23   add-to *top-addr, 1
+24 }
+25 
+26 fn pop-int-stack _self: (addr int-stack) -> _/eax: int {
+27   var self/esi: (addr int-stack) <- copy _self
+28   var top-addr/ecx: (addr int) <- get self, top
+29   {
+30     compare *top-addr, 0
+31     break-if->
+32     return 0
+33   }
+34   subtract-from *top-addr, 1
+35   var data-ah/edx: (addr handle array int) <- get self, data
+36   var data/eax: (addr array int) <- lookup *data-ah
+37   var top/edx: int <- copy *top-addr
+38   var result-addr/eax: (addr int) <- index data, top
+39   var val/eax: int <- copy *result-addr
+40   return val
+41 }
+42 
+43 fn int-stack-empty? _self: (addr int-stack) -> _/eax: boolean {
+44   var self/esi: (addr int-stack) <- copy _self
+45   var top-addr/ecx: (addr int) <- get self, top
+46   compare *top-addr, 0
+47   {
+48     break-if-=
+49     return 0/false
+50   }
+51   return 1/true
+52 }
+53 
+54 fn int-stack-top _self: (addr int-stack) -> _/eax: int {
+55   var self/esi: (addr int-stack) <- copy _self
+56   var top-addr/ecx: (addr int) <- get self, top
+57   var top/ecx: int <- copy *top-addr
+58   {
+59     compare top, 0
+60     break-if->
+61     return 0
+62   }
+63   top <- decrement
+64   var data-ah/edx: (addr handle array int) <- get self, data
+65   var data/eax: (addr array int) <- lookup *data-ah
+66   var result-addr/eax: (addr int) <- index data, top
+67   var val/eax: int <- copy *result-addr
+68   return val
+69 }
+

+ + + diff --git a/html/shell/macroexpand.mu.html b/html/shell/macroexpand.mu.html index 6abe8101..4ba567b1 100644 --- a/html/shell/macroexpand.mu.html +++ b/html/shell/macroexpand.mu.html @@ -66,7 +66,7 @@ if ('onhashchange' in window) { https://github.com/akkartik/mu/blob/main/shell/macroexpand.mu

   1 fn macroexpand expr-ah: (addr handle cell), globals: (addr global-table), trace: (addr trace) {
-  2 +-- 15 lines: # trace "macroexpand " expr-ah --------------------------------------------------------------------------------------------------------------------------------------------
+  2 +-- 15 lines: # trace "macroexpand " expr-ah -----------------------------------------------------------------------------------------------------------------------------------------------------------------------
  17   trace-lower trace
  18   # loop until convergence
  19   {
@@ -78,13 +78,13 @@ if ('onhashchange' in window) {
  25     loop-if-!=
  26   }
  27   trace-higher trace
- 28 +-- 15 lines: # trace "=> " expr-ah -----------------------------------------------------------------------------------------------------------------------------------------------------
+ 28 +-- 15 lines: # trace "=> " expr-ah --------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
  43 }
  44 
  45 # return true if we found any macros
  46 fn macroexpand-iter _expr-ah: (addr handle cell), globals: (addr global-table), trace: (addr trace) -> _/eax: boolean {
  47   var expr-ah/esi: (addr handle cell) <- copy _expr-ah
- 48 +-- 15 lines: # trace "macroexpand-iter " expr ------------------------------------------------------------------------------------------------------------------------------------------
+ 48 +-- 15 lines: # trace "macroexpand-iter " expr ---------------------------------------------------------------------------------------------------------------------------------------------------------------------
  63   trace-lower trace
  64   # if expr is a non-pair, return
  65   var expr/eax: (addr cell) <- lookup *expr-ah
@@ -111,8 +111,8 @@ if ('onhashchange' in window) {
  86   var rest-ah/ecx: (addr handle cell) <- get expr, right
  87   var first/eax: (addr cell) <- lookup *first-ah
  88   {
- 89     var litfn?/eax: boolean <- litfn? first
- 90     compare litfn?, 0/false
+ 89     var litfn?/eax: boolean <- litfn? first
+ 90     compare litfn?, 0/false
  91     break-if-=
  92     # litfn is a literal
  93     trace-text trace, "mac", "literal function"
@@ -120,8 +120,8 @@ if ('onhashchange' in window) {
  95     return 0/false
  96   }
  97   {
- 98     var litmac?/eax: boolean <- litmac? first
- 99     compare litmac?, 0/false
+ 98     var litmac?/eax: boolean <- litmac? first
+ 99     compare litmac?, 0/false
 100     break-if-=
 101     # litmac is a literal
 102     trace-text trace, "mac", "literal macro"
@@ -131,8 +131,8 @@ if ('onhashchange' in window) {
 106   var result/edi: boolean <- copy 0/false
 107   # for each builtin, expand only what will later be evaluated
 108   $macroexpand-iter:anonymous-function: {
-109     var fn?/eax: boolean <- fn? first
-110     compare fn?, 0/false
+109     var fn?/eax: boolean <- fn? first
+110     compare fn?, 0/false
 111     break-if-=
 112     # fn: expand every expression in the body
 113     trace-text trace, "mac", "anonymous function"
@@ -159,7 +159,7 @@ if ('onhashchange' in window) {
 134       loop
 135     }
 136     trace-higher trace
-137 +-- 15 lines: # trace "fn=> " _expr-ah --------------------------------------------------------------------------------------------------------------------------------------------------
+137 +-- 15 lines: # trace "fn=> " _expr-ah -----------------------------------------------------------------------------------------------------------------------------------------------------------------------------
 152     return result
 153   }
 154   # builtins with "special" evaluation rules
@@ -203,7 +203,7 @@ if ('onhashchange' in window) {
 192     var val-ah/edx: (addr handle cell) <- get rest, left
 193     var macro-found?/eax: boolean <- macroexpand-iter val-ah, globals, trace
 194     trace-higher trace
-195 +-- 15 lines: # trace "define=> " _expr-ah ----------------------------------------------------------------------------------------------------------------------------------------------
+195 +-- 15 lines: # trace "define=> " _expr-ah -------------------------------------------------------------------------------------------------------------------------------------------------------------------------
 210     return macro-found?
 211   }
 212   $macroexpand-iter:set: {
@@ -219,7 +219,7 @@ if ('onhashchange' in window) {
 222     var val-ah/edx: (addr handle cell) <- get rest, left
 223     var macro-found?/eax: boolean <- macroexpand-iter val-ah, globals, trace
 224     trace-higher trace
-225 +-- 15 lines: # trace "set=> " _expr-ah -------------------------------------------------------------------------------------------------------------------------------------------------
+225 +-- 15 lines: # trace "set=> " _expr-ah ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------
 240     return macro-found?
 241   }
 242   # 'and' is like a function for macroexpansion purposes
@@ -244,7 +244,7 @@ if ('onhashchange' in window) {
 261     {
 262       var definition-car-ah/eax: (addr handle cell) <- get definition, left
 263       var definition-car/eax: (addr cell) <- lookup *definition-car-ah
-264       var macro?/eax: boolean <- litmac? definition-car
+264       var macro?/eax: boolean <- litmac? definition-car
 265       compare macro?, 0/false
 266     }
 267     break-if-=
@@ -252,9 +252,9 @@ if ('onhashchange' in window) {
 269     var macro-definition-ah/eax: (addr handle cell) <- get definition, right
 270     # TODO: check car(macro-definition) is litfn
 271 #?     turn-on-debug-print
-272     apply macro-definition-ah, rest-ah, expr-ah, globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number
+272     apply macro-definition-ah, rest-ah, expr-ah, globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number
 273     trace-higher trace
-274 +-- 15 lines: # trace "1=> " _expr-ah ---------------------------------------------------------------------------------------------------------------------------------------------------
+274 +-- 15 lines: # trace "1=> " _expr-ah ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
 289     return 1/true
 290   }
 291   # no macro found; process any macros within args
@@ -279,7 +279,7 @@ if ('onhashchange' in window) {
 310     loop
 311   }
 312   trace-higher trace
-313 +-- 15 lines: # trace "=> " _expr-ah ----------------------------------------------------------------------------------------------------------------------------------------------------
+313 +-- 15 lines: # trace "=> " _expr-ah -------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
 328   return result
 329 }
 330 
@@ -301,29 +301,29 @@ if ('onhashchange' in window) {
 346   }
 347   var cdr-ah/ecx: (addr handle cell) <- get expr, right
 348   var car-ah/ebx: (addr handle cell) <- get expr, left
-349   var car/eax: (addr cell) <- lookup *car-ah
+349   var car/eax: (addr cell) <- lookup *car-ah
 350   # if car is unquote or unquote-splice, check if cadr is unquote or
 351   # unquote-splice.
 352   $look-for-double-unquote:check: {
 353     # if car is not an unquote, break
 354     {
 355       {
-356         var unquote?/eax: boolean <- symbol-equal? car, ","
+356         var unquote?/eax: boolean <- symbol-equal? car, ","
 357         compare unquote?, 0/false
 358       }
 359       break-if-!=
-360       var unquote-splice?/eax: boolean <- symbol-equal? car, ",@"
+360       var unquote-splice?/eax: boolean <- symbol-equal? car, ",@"
 361       compare unquote-splice?, 0/false
 362       break-if-!=
 363       break $look-for-double-unquote:check
 364     }
 365     # if cdr is not a pair, break
-366     var cdr/eax: (addr cell) <- lookup *cdr-ah
-367     var cdr-type/ecx: (addr int) <- get cdr, type
+366     var cdr/eax: (addr cell) <- lookup *cdr-ah
+367     var cdr-type/ecx: (addr int) <- get cdr, type
 368     compare *cdr-type, 0/pair
 369     break-if-!=
 370     # if cadr is not an unquote, break
-371     var cadr-ah/eax: (addr handle cell) <- get cdr, left
+371     var cadr-ah/eax: (addr handle cell) <- get cdr, left
 372     var cadr/eax: (addr cell) <- lookup *cadr-ah
 373     {
 374       {
@@ -371,7 +371,7 @@ if ('onhashchange' in window) {
 416   var dummy/eax: boolean <- macroexpand-iter result-ah, globals, trace
 417   var error?/eax: boolean <- has-errors? trace
 418   check-not error?, "F - test-macroexpand/error"
-419 #?   dump-cell-from-cursor-over-full-screen result-ah
+419 #?   dump-cell-from-cursor-over-full-screen result-ah, 4/fg 0/bg
 420   var _result/eax: (addr cell) <- lookup *result-ah
 421   var result/edi: (addr cell) <- copy _result
 422   # expected
@@ -384,7 +384,7 @@ if ('onhashchange' in window) {
 429 #?   dump-cell-from-cursor-over-full-screen expected-ah
 430   var expected/eax: (addr cell) <- lookup *expected-ah
 431   #
-432   var assertion/eax: boolean <- cell-isomorphic? result, expected, trace
+432   var assertion/eax: boolean <- cell-isomorphic? result, expected, trace
 433   check assertion, "F - test-macroexpand"
 434 }
 435 
@@ -422,7 +422,7 @@ if ('onhashchange' in window) {
 467   read-cell expected-gap, expected-ah, trace
 468   var expected/eax: (addr cell) <- lookup *expected-ah
 469   #
-470   var assertion/eax: boolean <- cell-isomorphic? result, expected, trace
+470   var assertion/eax: boolean <- cell-isomorphic? result, expected, trace
 471   check assertion, "F - test-macroexpand-inside-anonymous-fn"
 472 }
 473 
@@ -461,7 +461,7 @@ if ('onhashchange' in window) {
 506 #?   dump-cell-from-cursor-over-full-screen expected-ah
 507   var expected/eax: (addr cell) <- lookup *expected-ah
 508   #
-509   var assertion/eax: boolean <- cell-isomorphic? result, expected, trace
+509   var assertion/eax: boolean <- cell-isomorphic? result, expected, trace
 510   check assertion, "F - test-macroexpand-inside-fn-call"
 511 }
 512 
@@ -529,7 +529,7 @@ if ('onhashchange' in window) {
 574   read-cell expected-gap, expected-ah, trace
 575   var expected/eax: (addr cell) <- lookup *expected-ah
 576   #
-577   var assertion/eax: boolean <- cell-isomorphic? result, expected, trace
+577   var assertion/eax: boolean <- cell-isomorphic? result, expected, trace
 578   check assertion, "F - test-macroexpand-inside-backquote-unquote"
 579 }
 580 
@@ -555,7 +555,7 @@ if ('onhashchange' in window) {
 600   var dummy/eax: boolean <- macroexpand-iter result-ah, globals, trace
 601   var error?/eax: boolean <- has-errors? trace
 602   check-not error?, "F - test-macroexpand-inside-nested-backquote-unquote/error"
-603   dump-cell-from-cursor-over-full-screen result-ah
+603 #?   dump-cell-from-cursor-over-full-screen result-ah
 604   var _result/eax: (addr cell) <- lookup *result-ah
 605   var result/edi: (addr cell) <- copy _result
 606   # expected
@@ -565,10 +565,10 @@ if ('onhashchange' in window) {
 610   var expected-h: (handle cell)
 611   var expected-ah/edx: (addr handle cell) <- address expected-h
 612   read-cell expected-gap, expected-ah, trace
-613   dump-cell-from-cursor-over-full-screen expected-ah
+613 #?   dump-cell-from-cursor-over-full-screen expected-ah
 614   var expected/eax: (addr cell) <- lookup *expected-ah
 615   #
-616   var assertion/eax: boolean <- cell-isomorphic? result, expected, trace
+616   var assertion/eax: boolean <- cell-isomorphic? result, expected, trace
 617   check assertion, "F - test-macroexpand-inside-nested-backquote-unquote"
 618 }
 619 
diff --git a/html/shell/parenthesize.mu.html b/html/shell/parenthesize.mu.html
new file mode 100644
index 00000000..724e0343
--- /dev/null
+++ b/html/shell/parenthesize.mu.html
@@ -0,0 +1,478 @@
+
+
+
+
+Mu - shell/parenthesize.mu
+
+
+
+
+
+
+
+
+
+
+https://github.com/akkartik/mu/blob/main/shell/parenthesize.mu
++  1 ## insert explicit parens based on indentation
+  2 
+  3 # Design goals:
+  4 #  keywords in other languages should look different from functions: def, if, while, etc.
+  5 #  fully-parenthesized expressions should not be messed with
+  6 #    ignore indent when lines start with parens
+  7 #    ignore indent inside parens
+  8 #    no modes to disable this pass
+  9 #  introduce no new operators
+ 10 #    the language doesn't use nested lists like Scheme's `cond`
+ 11 #    lines with one word are never wrapped in parens
+ 12 #  encourage macros to explicitly insert all parens
+ 13 #    ignore indent inside backquote
+ 14 
+ 15 fn parenthesize in: (addr stream token), out: (addr stream token), trace: (addr trace) {
+ 16   trace-text trace, "parenthesize", "insert parens"
+ 17   trace-lower trace
+ 18   var buffer-storage: (stream token 0x40)
+ 19   var buffer/edi: (addr stream token) <- address buffer-storage
+ 20   var curr-line-indent: int
+ 21   var num-words-in-line: int
+ 22   var paren-at-start-of-line?: boolean
+ 23   var explicit-open-parens-storage: int
+ 24   var explicit-open-parens/ebx: (addr int) <- address explicit-open-parens-storage
+ 25   var implicit-open-parens-storage: int-stack
+ 26   var implicit-open-parens/esi: (addr int-stack) <- address implicit-open-parens-storage
+ 27   initialize-int-stack implicit-open-parens, 0x10  # potentially a major memory leak
+ 28   rewind-stream in
+ 29   {
+ 30     var done?/eax: boolean <- stream-empty? in
+ 31     compare done?, 0/false
+ 32     break-if-!=
+ 33     #
+ 34     var curr-token-storage: token
+ 35     var curr-token/ecx: (addr token) <- address curr-token-storage
+ 36     read-from-stream in, curr-token
+ 37 #?     dump-token-from-cursor curr-token
+ 38     # update state
+ 39     {
+ 40       var is-indent?/eax: boolean <- indent-token? curr-token
+ 41       compare is-indent?, 0/false
+ 42       break-if-=
+ 43       copy-to num-words-in-line, 0
+ 44       copy-to paren-at-start-of-line?, 0/false
+ 45       var tmp/eax: int <- indent-level curr-token
+ 46       copy-to curr-line-indent, tmp
+ 47     }
+ 48     {
+ 49       var is-word?/eax: boolean <- word-token? curr-token
+ 50       compare is-word?, 0/false
+ 51       break-if-=
+ 52       increment num-words-in-line
+ 53     }
+ 54     {
+ 55       compare num-words-in-line, 0
+ 56       break-if-!=
+ 57       var is-open?/eax: boolean <- open-paren-token? curr-token
+ 58       compare is-open?, 0/false
+ 59       break-if-=
+ 60       copy-to paren-at-start-of-line?, 1/true
+ 61     }
+ 62     #
+ 63     $parenthesize:emit: {
+ 64       {
+ 65         compare paren-at-start-of-line?, 0/false
+ 66         break-if-=
+ 67 #?         draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen "A", 7/fg 0/bg
+ 68         emit-all buffer, curr-token, out, explicit-open-parens
+ 69         break $parenthesize:emit
+ 70       }
+ 71       {
+ 72         var is-indent?/eax: boolean <- indent-token? curr-token
+ 73         compare is-indent?, 0/false
+ 74         break-if-=
+ 75 #?         draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen "B", 7/fg 0/bg
+ 76         emit-all buffer, curr-token, out, explicit-open-parens
+ 77         break $parenthesize:emit
+ 78       }
+ 79       {
+ 80         compare num-words-in-line, 2
+ 81         break-if->=
+ 82 #?         draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen "C", 7/fg 0/bg
+ 83         write-to-stream buffer, curr-token
+ 84         break $parenthesize:emit
+ 85       }
+ 86       {
+ 87         compare num-words-in-line, 2
+ 88         break-if-!=
+ 89         var is-word?/eax: boolean <- word-token? curr-token
+ 90         compare is-word?, 0/false
+ 91         break-if-=
+ 92         compare *explicit-open-parens, 0
+ 93         break-if-!=
+ 94 #?         draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen "(\n", 7/fg 0/bg
+ 95         var paren-storage: token
+ 96         var paren-token/eax: (addr token) <- address paren-storage
+ 97         initialize-token paren-token, "("
+ 98         write-to-stream out, paren-token
+ 99         push-int-stack implicit-open-parens, curr-line-indent
+100       }
+101       emit-all buffer, curr-token, out, explicit-open-parens
+102     }
+103     {
+104       var is-indent?/eax: boolean <- indent-token? curr-token
+105       compare is-indent?, 0/false
+106       break-if-=
+107       {
+108         # . loop check
+109         var done?/eax: boolean <- int-stack-empty? implicit-open-parens
+110         compare done?, 0/false
+111         break-if-!=
+112         var top-indent/eax: int <- int-stack-top implicit-open-parens
+113         compare top-indent, curr-line-indent
+114         break-if-<
+115         # . loop body
+116         var paren-storage: token
+117         var paren-token/eax: (addr token) <- address paren-storage
+118         initialize-token paren-token, ")"
+119         write-to-stream out, paren-token
+120         # . update
+121         var dummy/eax: int <- pop-int-stack implicit-open-parens
+122         loop
+123       }
+124     }
+125     loop
+126   }
+127   emit-all buffer, 0/no-curr-token, out, explicit-open-parens
+128   {
+129     # . loop check
+130     var done?/eax: boolean <- int-stack-empty? implicit-open-parens
+131     compare done?, 0/false
+132     break-if-!=
+133     # . loop body
+134     var paren-storage: token
+135     var paren-token/eax: (addr token) <- address paren-storage
+136     initialize-token paren-token, ")"
+137     write-to-stream out, paren-token
+138     # . update
+139     var dummy/eax: int <- pop-int-stack implicit-open-parens
+140     loop
+141   }
+142   trace-higher trace
+143 }
+144 
+145 fn indent-level _in: (addr token) -> _/eax: int {
+146   var in/eax: (addr token) <- copy _in
+147   var result/eax: (addr int) <- get in, number-data
+148   return *result
+149 }
+150 
+151 fn word-token? in: (addr token) -> _/eax: boolean {
+152   {
+153     var is-indent?/eax: boolean <- indent-token? in
+154     compare is-indent?, 0/false
+155     break-if-!=
+156     var is-bracket?/eax: boolean <- bracket-token? in  # overzealously checks for [], but shouldn't ever encounter it
+157     compare is-bracket?, 0/false
+158     break-if-!=
+159     var is-quote?/eax: boolean <- quote-token? in
+160     compare is-quote?, 0/false
+161     break-if-!=
+162     var is-backquote?/eax: boolean <- backquote-token? in
+163     compare is-backquote?, 0/false
+164     break-if-!=
+165     var is-unquote?/eax: boolean <- unquote-token? in
+166     compare is-unquote?, 0/false
+167     break-if-!=
+168     var is-unquote-splice?/eax: boolean <- unquote-splice-token? in
+169     compare is-unquote-splice?, 0/false
+170     break-if-!=
+171     return 1/true
+172   }
+173   return 0/false
+174 }
+175 
+176 fn emit-all first: (addr stream token), second: (addr token), out: (addr stream token), explicit-open-parens: (addr int) {
+177   rewind-stream first
+178   {
+179     var done?/eax: boolean <- stream-empty? first
+180     compare done?, 0/false
+181     break-if-!=
+182     var curr-token-storage: token
+183     var curr-token/eax: (addr token) <- address curr-token-storage
+184     read-from-stream first, curr-token
+185     emit curr-token, out, explicit-open-parens
+186     loop
+187   }
+188   clear-stream first
+189   {
+190     compare second, 0
+191     break-if-=
+192     emit second, out, explicit-open-parens
+193   }
+194 }
+195 
+196 fn emit t: (addr token), out: (addr stream token), explicit-open-parens: (addr int) {
+197   {
+198     var is-indent?/eax: boolean <- indent-token? t
+199     compare is-indent?, 0/false
+200     break-if-=
+201     return
+202   }
+203   write-to-stream out, t
+204   var explicit-open-parens/edi: (addr int) <- copy explicit-open-parens
+205   {
+206     var is-open?/eax: boolean <- open-paren-token? t
+207     compare is-open?, 0/false
+208     break-if-=
+209     increment *explicit-open-parens
+210   }
+211   {
+212     var is-close?/eax: boolean <- close-paren-token? t
+213     compare is-close?, 0/false
+214     break-if-=
+215     decrement *explicit-open-parens
+216     compare *explicit-open-parens, 0
+217     break-if->=
+218     abort "emit: extra ')'"
+219   }
+220 }
+221 
+222 # helper for checking parenthesize
+223 fn emit-salient-tokens in: (addr stream token), out: (addr stream token) {
+224   rewind-stream in
+225   {
+226     var done?/eax: boolean <- stream-empty? in
+227     compare done?, 0/false
+228     break-if-!=
+229     var token-storage: token
+230     var token/edx: (addr token) <- address token-storage
+231     read-from-stream in, token
+232     # skip tokens should be skipped
+233     var is-skip?/eax: boolean <- skip-token? token
+234     compare is-skip?, 0/false
+235     loop-if-!=
+236     # indent tokens should be skipped
+237     var is-indent?/eax: boolean <- indent-token? token
+238     compare is-indent?, 0/false
+239     loop-if-!=
+240     #
+241     write-to-stream out, token  # shallow copy
+242     loop
+243   }
+244 }
+245 
+246 fn test-parenthesize {
+247   check-parenthesize "a b c  ", "(a b c)", "F - test-parenthesize/1"
+248   check-parenthesize "a (b)", "(a (b))", "F - test-parenthesize/2"
+249   check-parenthesize "a (b c)", "(a (b c))", "F - test-parenthesize/3"
+250   check-parenthesize "a (b c) d", "(a (b c) d)", "F - test-parenthesize/4"
+251   check-parenthesize "a b c\nd ef", "(a b c) (d ef)", "F - test-parenthesize/5-multiple-lines"
+252   check-parenthesize "a b c\n  d ef", "(a b c (d ef))", "F - test-parenthesize/6-indented"
+253   check-parenthesize "a b c\n  (d ef)", "(a b c (d ef))", "F - test-parenthesize/7-indented"
+254   check-parenthesize "a b c\n  (d ef)\n  g", "(a b c (d ef) g)", "F - test-parenthesize/8-indented"
+255   check-parenthesize "a b c\n  d e\n    f\ny", "(a b c (d e f)) y", "F - test-parenthesize/9-indented"
+256   check-parenthesize "#a\na b", "(a b)", "F - test-parenthesize/10-initial-comment"
+257 #? a b c
+258 #?     d ef
+259 #? 
+260 #?   g
+261 #?   check-parenthesize "a b c\n    d ef\n\n  g", "(a b c (d ef) g)", "F - test-parenthesize/11-comments"
+262 #?   check-parenthesize "a b c\n    d ef\n\n  g #abc", "(a b c (d ef)) g", "F - test-parenthesize/11-comments"
+263   check-parenthesize "a b c\n    d ef\n\n  g #abc", "(a b c (d ef) g)", "F - test-parenthesize/11-comments"
+264 #? a b c
+265 #?   '(d ef)
+266 #? 
+267 #?   g #abc
+268 #?   check-parenthesize "a b c\n  '(d ef)\n  g #abc", "(a b c '(d ef) g)", "F - test-parenthesize/12-quotes-and-comments"
+269   check-parenthesize "a b c\n  '(d ef)\n\n  g #abc", "(a b c '(d ef) g)", "F - test-parenthesize/12-quotes-and-comments"
+270   check-parenthesize "  a b c", "(a b c)", "F - test-parenthesize/13-initial-indent"
+271   check-parenthesize "    a b c\n  34", "(a b c) 34", "F - test-parenthesize/14-initial-indent"
+272   check-parenthesize "def foo\n    a b c\n  d e\nnewdef", "(def foo (a b c) (d e)) newdef", "F - test-parenthesize/14"
+273   check-parenthesize "  a a\n    a\ny", "(a a a) y", "F - test-parenthesize/15-group-before-too-much-outdent"
+274   check-parenthesize "a `(b c)", "(a `(b c))", "F - test-parenthesize/16-backquote"
+275   check-parenthesize "'a b c", "('a b c)", "F - test-parenthesize/17-quote"
+276   check-parenthesize ",a b c", "(,a b c)", "F - test-parenthesize/18-unquote"
+277   check-parenthesize ",@a b c", "(,@a b c)", "F - test-parenthesize/19-unquote-splice"
+278   check-parenthesize "a b\n  'c\n  ,d\n  e", "(a b 'c ,d e)", "F - test-parenthesize/20-quotes-are-not-words"
+279   check-parenthesize "def foo\n#a b c\n  d e\nnew", "(def foo (d e)) new", "F - test-parenthesize/21-group-across-comments"
+280 }
+281 
+282 fn test-parenthesize-skips-lines-with-initial-parens {
+283   check-parenthesize "(a b c)", "(a b c)", "F - test-parenthesize-skips-lines-with-initial-parens/1"
+284   check-parenthesize "(a (b c))", "(a (b c))", "F - test-parenthesize-skips-lines-with-initial-parens/2"
+285   check-parenthesize "(a () b)", "(a () b)", "F - test-parenthesize-skips-lines-with-initial-parens/3"
+286   check-parenthesize "  (a b c)", "(a b c)", "F - test-parenthesize-skips-lines-with-initial-parens/initial-indent"
+287   check-parenthesize "(a b c\n  bc\n    def\n  gh)", "(a b c bc def gh)", "F - test-parenthesize-skips-lines-with-initial-parens/outdent"
+288   check-parenthesize "(a b c\n  (def gh)\n    (i j k)\n  lm\n\n\n    (no p))", "(a b c (def gh) (i j k) lm (no p))", "F - test-parenthesize-skips-lines-with-initial-parens/fully-parenthesized"
+289   check-parenthesize ",(a b c)", ",(a b c)", "F - test-parenthesize-skips-lines-with-initial-parens/after-unquote"
+290   check-parenthesize ",@(a b c)", ",@(a b c)", "F - test-parenthesize-skips-lines-with-initial-parens/after-unquote-splice"
+291   check-parenthesize ",,(a b c)", ",,(a b c)", "F - test-parenthesize-skips-lines-with-initial-parens/after-nested-unquote"
+292   check-parenthesize "(def foo\n    #a b c\n  d e)\nnew", "(def foo d e) new", "F - test-parenthesize-skips-lines-with-initial-parens/across-comment"
+293   check-parenthesize "`(def foo\n    #a b c\n  d e)\nnew", "`(def foo d e) new", "F - test-parenthesize-skips-lines-with-initial-parens/across-comment-after-backquote"
+294   check-parenthesize "  (a b c\n    d e)", "(a b c d e)", "F - test-parenthesize-skips-lines-with-initial-parens/with-indent"
+295   check-parenthesize "def foo(a (b)\n    c d)\n  d e\nnew", "(def foo (a (b) c d) (d e)) new", "F - test-parenthesize-skips-lines-with-initial-parens/inside-arg-lists"
+296 }
+297 
+298 fn test-parenthesize-skips-single-word-lines {
+299   # lines usually get grouped with later indented lines
+300   check-parenthesize "a b\n  c", "(a b c)", "F - test-parenthesize-skips-single-word-lines/0"
+301   # but single-word lines don't
+302   check-parenthesize "a\n  c", "a c", "F - test-parenthesize-skips-single-word-lines/1"
+303   check-parenthesize "a", "a", "F - test-parenthesize-skips-single-word-lines/2"
+304   check-parenthesize "a  \nb\nc", "a b c", "F - test-parenthesize-skips-single-word-lines/3"
+305 }
+306 
+307 fn check-parenthesize actual: (addr array byte), expected: (addr array byte), message: (addr array byte) {
+308   var trace-storage: trace
+309   var trace/edx: (addr trace) <- address trace-storage
+310   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+311   #
+312   var actual-buffer-storage: gap-buffer
+313   var actual-buffer/eax: (addr gap-buffer) <- address actual-buffer-storage
+314   initialize-gap-buffer-with actual-buffer, actual
+315   var actual-tokens-storage: (stream token 0x40)
+316   var actual-tokens/esi: (addr stream token) <- address actual-tokens-storage
+317   tokenize-and-parenthesize actual-buffer, actual-tokens, trace
+318   #
+319   var expected-buffer-storage: gap-buffer
+320   var expected-buffer/eax: (addr gap-buffer) <- address expected-buffer-storage
+321   initialize-gap-buffer-with expected-buffer, expected
+322   var expected-tokens-storage: (stream token 0x40)
+323   var expected-tokens/edi: (addr stream token) <- address expected-tokens-storage
+324   tokenize-salient expected-buffer, expected-tokens, trace
+325   #
+326   rewind-stream actual-tokens
+327   check-token-streams-data-equal actual-tokens, expected-tokens, message
+328 }
+329 
+330 fn check-token-streams-data-equal actual: (addr stream token), expected: (addr stream token), message: (addr array byte) {
+331   rewind-stream actual
+332   rewind-stream expected
+333   {
+334     # loop termination checks
+335     var actual-done?/eax: boolean <- stream-empty? actual
+336     {
+337       compare actual-done?, 0/false
+338       break-if-=
+339       var expected-done?/eax: boolean <- stream-empty? expected
+340       compare expected-done?, 0/false
+341       {
+342         break-if-!=
+343         # actual empty, but expected not empty
+344         draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, message, 3/fg=cyan 0/bg
+345         draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ": too short\n", 3/fg=cyan 0/bg
+346         count-test-failure
+347         return
+348       }
+349       draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ".", 3/fg/cyan, 0/bg
+350       return
+351     }
+352     var expected-done?/eax: boolean <- stream-empty? expected
+353     compare expected-done?, 0/false
+354     {
+355       break-if-=
+356       # actual not empty, but expected empty
+357       draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, message, 3/fg=cyan 0/bg
+358       draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ": too long\n", 3/fg=cyan 0/bg
+359       count-test-failure
+360       return
+361     }
+362     # loop body
+363     var curr-token-storage: token
+364     var curr-token/ecx: (addr token) <- address curr-token-storage
+365     read-from-stream actual, curr-token
+366 #?     dump-token-from-cursor curr-token
+367     var expected-token-storage: token
+368     var expected-token/edx: (addr token) <- address expected-token-storage
+369     read-from-stream expected, expected-token
+370 #?     dump-token-from-cursor expected-token
+371     var match?/eax: boolean <- tokens-equal? curr-token, expected-token
+372     compare match?, 0/false
+373     {
+374       break-if-!=
+375       draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, message, 3/fg=cyan 0/bg
+376       count-test-failure
+377       return
+378     }
+379     loop
+380   }
+381 }
+382 
+383 fn tokenize-and-parenthesize in: (addr gap-buffer), out: (addr stream token), trace: (addr trace) {
+384   var tokens-storage: (stream token 0x400)
+385   var tokens/edx: (addr stream token) <- address tokens-storage
+386   tokenize in, tokens, trace
+387   var error?/eax: boolean <- has-errors? trace
+388   compare error?, 0/false
+389   {
+390     break-if-=
+391     return
+392   }
+393   parenthesize tokens, out, trace
+394 }
+395 
+396 fn tokenize-salient in: (addr gap-buffer), out: (addr stream token), trace: (addr trace) {
+397   var tokens-storage: (stream token 0x400)
+398   var tokens/edx: (addr stream token) <- address tokens-storage
+399   tokenize in, tokens, trace
+400   var error?/eax: boolean <- has-errors? trace
+401   compare error?, 0/false
+402   {
+403     break-if-=
+404     return
+405   }
+406   emit-salient-tokens tokens, out
+407 }
+
+
+
+
diff --git a/html/shell/parse.mu.html b/html/shell/parse.mu.html
index e61f4c23..2ff8aa2d 100644
--- a/html/shell/parse.mu.html
+++ b/html/shell/parse.mu.html
@@ -61,7 +61,7 @@ if ('onhashchange' in window) {
 
 https://github.com/akkartik/mu/blob/main/shell/parse.mu
 -  1 fn parse-input tokens: (addr stream cell), out: (addr handle cell), trace: (addr trace) {
+  1 fn parse-input tokens: (addr stream token), out: (addr handle cell), trace: (addr trace) {
   2   rewind-stream tokens
   3   var empty?/eax: boolean <- stream-empty? tokens
   4   compare empty?, 0/false
@@ -71,8 +71,8 @@ if ('onhashchange' in window) {
   8     return
   9   }
  10   var close-paren?/eax: boolean <- copy 0/false
- 11   var dummy?/ecx: boolean <- copy 0/false
- 12   close-paren?, dummy? <- parse-sexpression tokens, out, trace
+ 11   var dot?/ecx: boolean <- copy 0/false
+ 12   close-paren?, dot? <- parse-sexpression tokens, out, trace
  13   {
  14     compare close-paren?, 0/false
  15     break-if-=
@@ -80,295 +80,301 @@ if ('onhashchange' in window) {
  17     return
  18   }
  19   {
- 20     var empty?/eax: boolean <- stream-empty? tokens
- 21     compare empty?, 0/false
- 22     break-if-!=
- 23     error trace, "unexpected tokens at end; only type in a single expression at a time"
+ 20     compare dot?, 0/false
+ 21     break-if-=
+ 22     error trace, "'.' is not a valid expression"
+ 23     return
  24   }
- 25 }
- 26 
- 27 # return values:
- 28 #   unmatched close-paren encountered?
- 29 #   dot encountered? (only used internally by recursive calls)
- 30 fn parse-sexpression tokens: (addr stream cell), _out: (addr handle cell), trace: (addr trace) -> _/eax: boolean, _/ecx: boolean {
- 31   trace-text trace, "parse", "parse"
- 32   trace-lower trace
- 33   var curr-token-storage: cell
- 34   var curr-token/ecx: (addr cell) <- address curr-token-storage
- 35   var empty?/eax: boolean <- stream-empty? tokens
- 36   compare empty?, 0/false
- 37   {
- 38     break-if-=
- 39     error trace, "end of stream; never found a balancing ')'"
- 40     trace-higher trace
- 41     return 1/true, 0/false
- 42   }
- 43   read-from-stream tokens, curr-token
- 44   $parse-sexpression:type-check: {
- 45     # single quote -> parse as list with a special car
- 46     var quote-token?/eax: boolean <- quote-token? curr-token
- 47     compare quote-token?, 0/false
- 48     {
- 49       break-if-=
- 50       var out/edi: (addr handle cell) <- copy _out
- 51       allocate-pair out
- 52       var out-addr/eax: (addr cell) <- lookup *out
- 53       var left-ah/edx: (addr handle cell) <- get out-addr, left
- 54       new-symbol left-ah, "'"
- 55       var right-ah/edx: (addr handle cell) <- get out-addr, right
- 56       var close-paren?/eax: boolean <- copy 0/false
- 57       var dot?/ecx: boolean <- copy 0/false
- 58       close-paren?, dot? <- parse-sexpression tokens, right-ah, trace
- 59       trace-higher trace
- 60       return close-paren?, dot?
- 61     }
- 62     # backquote quote -> parse as list with a special car
- 63     var backquote-token?/eax: boolean <- backquote-token? curr-token
- 64     compare backquote-token?, 0/false
- 65     {
- 66       break-if-=
- 67       var out/edi: (addr handle cell) <- copy _out
- 68       allocate-pair out
- 69       var out-addr/eax: (addr cell) <- lookup *out
- 70       var left-ah/edx: (addr handle cell) <- get out-addr, left
- 71       new-symbol left-ah, "`"
- 72       var right-ah/edx: (addr handle cell) <- get out-addr, right
- 73       var close-paren?/eax: boolean <- copy 0/false
- 74       var dot?/ecx: boolean <- copy 0/false
- 75       close-paren?, dot? <- parse-sexpression tokens, right-ah, trace
- 76       trace-higher trace
- 77       return close-paren?, dot?
- 78     }
- 79     # unquote -> parse as list with a special car
- 80     var unquote-token?/eax: boolean <- unquote-token? curr-token
- 81     compare unquote-token?, 0/false
- 82     {
- 83       break-if-=
- 84       var out/edi: (addr handle cell) <- copy _out
- 85       allocate-pair out
- 86       var out-addr/eax: (addr cell) <- lookup *out
- 87       var left-ah/edx: (addr handle cell) <- get out-addr, left
- 88       new-symbol left-ah, ","
- 89       var right-ah/edx: (addr handle cell) <- get out-addr, right
- 90       var close-paren?/eax: boolean <- copy 0/false
- 91       var dot?/ecx: boolean <- copy 0/false
- 92       close-paren?, dot? <- parse-sexpression tokens, right-ah, trace
- 93       trace-higher trace
- 94       return close-paren?, dot?
- 95     }
- 96     # unquote-splice -> parse as list with a special car
- 97     var unquote-splice-token?/eax: boolean <- unquote-splice-token? curr-token
- 98     compare unquote-splice-token?, 0/false
- 99     {
-100       break-if-=
-101       var out/edi: (addr handle cell) <- copy _out
-102       allocate-pair out
-103       var out-addr/eax: (addr cell) <- lookup *out
-104       var left-ah/edx: (addr handle cell) <- get out-addr, left
-105       new-symbol left-ah, ",@"
-106       var right-ah/edx: (addr handle cell) <- get out-addr, right
-107       var close-paren?/eax: boolean <- copy 0/false
-108       var dot?/ecx: boolean <- copy 0/false
-109       close-paren?, dot? <- parse-sexpression tokens, right-ah, trace
-110       trace-higher trace
-111       return close-paren?, dot?
-112     }
-113     # dot -> return
-114     var dot?/eax: boolean <- dot-token? curr-token
-115     compare dot?, 0/false
-116     {
-117       break-if-=
-118       trace-higher trace
-119       return 0/false, 1/true
-120     }
-121     # not bracket -> parse atom
-122     var bracket-token?/eax: boolean <- bracket-token? curr-token
-123     compare bracket-token?, 0/false
-124     {
-125       break-if-!=
-126       parse-atom curr-token, _out, trace
-127       break $parse-sexpression:type-check
-128     }
-129     # open paren -> parse list
-130     var open-paren?/eax: boolean <- open-paren-token? curr-token
-131     compare open-paren?, 0/false
-132     {
-133       break-if-=
-134       var curr/esi: (addr handle cell) <- copy _out
-135       allocate-pair curr
-136       var curr-addr/eax: (addr cell) <- lookup *curr
-137       var left/edx: (addr handle cell) <- get curr-addr, left
-138       {
-139         var close-paren?/eax: boolean <- copy 0/false
-140         var dot?/ecx: boolean <- copy 0/false
-141         close-paren?, dot? <- parse-sexpression tokens, left, trace
-142         {
-143           compare dot?, 0/false
-144           break-if-=
-145           error trace, "'.' cannot be at the start of a list"
-146           return 1/true, dot?
-147         }
-148         compare close-paren?, 0/false
-149         break-if-!=
-150         var curr-addr/eax: (addr cell) <- lookup *curr
-151         curr <- get curr-addr, right
-152         var tmp-storage: (handle cell)
-153         var tmp/edx: (addr handle cell) <- address tmp-storage
-154         $parse-sexpression:list-loop: {
-155           var close-paren?/eax: boolean <- copy 0/false
-156           var dot?/ecx: boolean <- copy 0/false
-157           close-paren?, dot? <- parse-sexpression tokens, tmp, trace
-158           # '.' -> clean up right here and return
-159           compare dot?, 0/false
-160           {
-161             break-if-=
-162             parse-dot-tail tokens, curr, trace
-163             return 0/false, 0/false
-164           }
-165           allocate-pair curr
-166           # ')' -> return
-167           compare close-paren?, 0/false
-168           break-if-!=
-169           var curr-addr/eax: (addr cell) <- lookup *curr
-170           var left/ecx: (addr handle cell) <- get curr-addr, left
-171           copy-object tmp, left
-172           #
-173           curr <- get curr-addr, right
-174           loop
-175         }
-176       }
-177       break $parse-sexpression:type-check
-178     }
-179     # close paren -> return
-180     var close-paren?/eax: boolean <- close-paren-token? curr-token
-181     compare close-paren?, 0/false
-182     {
-183       break-if-=
-184       trace-higher trace
-185       return 1/true, 0/false
-186     }
-187     # otherwise abort
-188     var stream-storage: (stream byte 0x400)
-189     var stream/edx: (addr stream byte) <- address stream-storage
-190     write stream, "unexpected token "
-191     var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data
-192     var curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah
-193     rewind-stream curr-token-data
-194     write-stream stream, curr-token-data
-195     error-stream trace, stream
-196   }
-197   trace-higher trace
-198   return 0/false, 0/false
-199 }
-200 
-201 fn parse-atom _curr-token: (addr cell), _out: (addr handle cell), trace: (addr trace) {
-202   trace-text trace, "parse", "parse atom"
-203   var curr-token/ecx: (addr cell) <- copy _curr-token
-204   var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data
-205   var _curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah
-206   var curr-token-data/esi: (addr stream byte) <- copy _curr-token-data
-207   trace trace, "parse", curr-token-data
-208   # number
-209   var number-token?/eax: boolean <- number-token? curr-token
-210   compare number-token?, 0/false
-211   {
-212     break-if-=
-213     rewind-stream curr-token-data
-214     var _val/eax: int <- parse-decimal-int-from-stream curr-token-data
-215     var val/ecx: int <- copy _val
-216     var val-float/xmm0: float <- convert val
-217     allocate-number _out
-218     var out/eax: (addr handle cell) <- copy _out
-219     var out-addr/eax: (addr cell) <- lookup *out
-220     var dest/edi: (addr float) <- get out-addr, number-data
-221     copy-to *dest, val-float
-222     {
-223       {
-224         var should-trace?/eax: boolean <- should-trace? trace
-225         compare should-trace?, 0/false
-226       }
-227       break-if-=
-228       var stream-storage: (stream byte 0x400)
-229       var stream/ecx: (addr stream byte) <- address stream-storage
-230       write stream, "=> number "
-231       var nested-trace-storage: trace
-232       var nested-trace/edi: (addr trace) <- address nested-trace-storage
-233       initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible
-234       print-number out-addr, stream, nested-trace
-235       trace trace, "parse", stream
-236     }
-237     return
-238   }
-239   # default: copy either to a symbol or a stream
-240   # stream token -> literal
-241   var stream-token?/eax: boolean <- stream-token? curr-token
-242   compare stream-token?, 0/false
-243   {
-244     break-if-=
-245     allocate-stream _out
-246   }
-247   compare stream-token?, 0/false
-248   {
-249     break-if-!=
-250     allocate-symbol _out
-251   }
-252   # copy token data
-253   var out/eax: (addr handle cell) <- copy _out
-254   var out-addr/eax: (addr cell) <- lookup *out
-255   var curr-token-data-ah/ecx: (addr handle stream byte) <- get curr-token, text-data
-256   var dest-ah/edx: (addr handle stream byte) <- get out-addr, text-data
-257   copy-object curr-token-data-ah, dest-ah
-258   {
-259     {
-260       var should-trace?/eax: boolean <- should-trace? trace
-261       compare should-trace?, 0/false
-262     }
-263     break-if-=
-264     var stream-storage: (stream byte 0x400)
-265     var stream/ecx: (addr stream byte) <- address stream-storage
-266     write stream, "=> symbol "
-267     var nested-trace-storage: trace
-268     var nested-trace/edi: (addr trace) <- address nested-trace-storage
-269     initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible
-270     print-symbol out-addr, stream, nested-trace
-271     trace trace, "parse", stream
-272   }
-273 }
-274 
-275 fn parse-dot-tail tokens: (addr stream cell), _out: (addr handle cell), trace: (addr trace) {
-276   var out/edi: (addr handle cell) <- copy _out
-277   var close-paren?/eax: boolean <- copy 0/false
-278   var dot?/ecx: boolean <- copy 0/false
-279   close-paren?, dot? <- parse-sexpression tokens, out, trace
-280   compare close-paren?, 0/false
-281   {
-282     break-if-=
-283     error trace, "'. )' makes no sense"
-284     return
-285   }
-286   compare dot?, 0/false
+ 25   {
+ 26     var empty?/eax: boolean <- stream-empty? tokens
+ 27     compare empty?, 0/false
+ 28     break-if-!=
+ 29     error trace, "unexpected tokens at end; only type in a single expression at a time"
+ 30   }
+ 31 }
+ 32 
+ 33 # return values:
+ 34 #   unmatched close-paren encountered?
+ 35 #   dot encountered? (only used internally by recursive calls)
+ 36 fn parse-sexpression tokens: (addr stream token), _out: (addr handle cell), trace: (addr trace) -> _/eax: boolean, _/ecx: boolean {
+ 37   trace-text trace, "parse", "parse"
+ 38   trace-lower trace
+ 39   var curr-token-storage: token
+ 40   var curr-token/ecx: (addr token) <- address curr-token-storage
+ 41   var empty?/eax: boolean <- stream-empty? tokens
+ 42   compare empty?, 0/false
+ 43   {
+ 44     break-if-=
+ 45     error trace, "end of stream; never found a balancing ')'"
+ 46     trace-higher trace
+ 47     return 1/true, 0/false
+ 48   }
+ 49   read-from-stream tokens, curr-token
+ 50   $parse-sexpression:type-check: {
+ 51     # single quote -> parse as list with a special car
+ 52     var quote-token?/eax: boolean <- quote-token? curr-token
+ 53     compare quote-token?, 0/false
+ 54     {
+ 55       break-if-=
+ 56       var out/edi: (addr handle cell) <- copy _out
+ 57       allocate-pair out
+ 58       var out-addr/eax: (addr cell) <- lookup *out
+ 59       var left-ah/edx: (addr handle cell) <- get out-addr, left
+ 60       new-symbol left-ah, "'"
+ 61       var right-ah/edx: (addr handle cell) <- get out-addr, right
+ 62       var close-paren?/eax: boolean <- copy 0/false
+ 63       var dot?/ecx: boolean <- copy 0/false
+ 64       close-paren?, dot? <- parse-sexpression tokens, right-ah, trace
+ 65       trace-higher trace
+ 66       return close-paren?, dot?
+ 67     }
+ 68     # backquote quote -> parse as list with a special car
+ 69     var backquote-token?/eax: boolean <- backquote-token? curr-token
+ 70     compare backquote-token?, 0/false
+ 71     {
+ 72       break-if-=
+ 73       var out/edi: (addr handle cell) <- copy _out
+ 74       allocate-pair out
+ 75       var out-addr/eax: (addr cell) <- lookup *out
+ 76       var left-ah/edx: (addr handle cell) <- get out-addr, left
+ 77       new-symbol left-ah, "`"
+ 78       var right-ah/edx: (addr handle cell) <- get out-addr, right
+ 79       var close-paren?/eax: boolean <- copy 0/false
+ 80       var dot?/ecx: boolean <- copy 0/false
+ 81       close-paren?, dot? <- parse-sexpression tokens, right-ah, trace
+ 82       trace-higher trace
+ 83       return close-paren?, dot?
+ 84     }
+ 85     # unquote -> parse as list with a special car
+ 86     var unquote-token?/eax: boolean <- unquote-token? curr-token
+ 87     compare unquote-token?, 0/false
+ 88     {
+ 89       break-if-=
+ 90       var out/edi: (addr handle cell) <- copy _out
+ 91       allocate-pair out
+ 92       var out-addr/eax: (addr cell) <- lookup *out
+ 93       var left-ah/edx: (addr handle cell) <- get out-addr, left
+ 94       new-symbol left-ah, ","
+ 95       var right-ah/edx: (addr handle cell) <- get out-addr, right
+ 96       var close-paren?/eax: boolean <- copy 0/false
+ 97       var dot?/ecx: boolean <- copy 0/false
+ 98       close-paren?, dot? <- parse-sexpression tokens, right-ah, trace
+ 99       trace-higher trace
+100       return close-paren?, dot?
+101     }
+102     # unquote-splice -> parse as list with a special car
+103     var unquote-splice-token?/eax: boolean <- unquote-splice-token? curr-token
+104     compare unquote-splice-token?, 0/false
+105     {
+106       break-if-=
+107       var out/edi: (addr handle cell) <- copy _out
+108       allocate-pair out
+109       var out-addr/eax: (addr cell) <- lookup *out
+110       var left-ah/edx: (addr handle cell) <- get out-addr, left
+111       new-symbol left-ah, ",@"
+112       var right-ah/edx: (addr handle cell) <- get out-addr, right
+113       var close-paren?/eax: boolean <- copy 0/false
+114       var dot?/ecx: boolean <- copy 0/false
+115       close-paren?, dot? <- parse-sexpression tokens, right-ah, trace
+116       trace-higher trace
+117       return close-paren?, dot?
+118     }
+119     # dot -> return
+120     var dot?/eax: boolean <- dot-token? curr-token
+121     compare dot?, 0/false
+122     {
+123       break-if-=
+124       trace-higher trace
+125       return 0/false, 1/true
+126     }
+127     # not bracket -> parse atom
+128     var bracket-token?/eax: boolean <- bracket-token? curr-token
+129     compare bracket-token?, 0/false
+130     {
+131       break-if-!=
+132       parse-atom curr-token, _out, trace
+133       break $parse-sexpression:type-check
+134     }
+135     # open paren -> parse list
+136     var open-paren?/eax: boolean <- open-paren-token? curr-token
+137     compare open-paren?, 0/false
+138     {
+139       break-if-=
+140       var curr/esi: (addr handle cell) <- copy _out
+141       allocate-pair curr
+142       var curr-addr/eax: (addr cell) <- lookup *curr
+143       var left/edx: (addr handle cell) <- get curr-addr, left
+144       {
+145         var close-paren?/eax: boolean <- copy 0/false
+146         var dot?/ecx: boolean <- copy 0/false
+147         close-paren?, dot? <- parse-sexpression tokens, left, trace
+148         {
+149           compare dot?, 0/false
+150           break-if-=
+151           error trace, "'.' cannot be at the start of a list"
+152           return 1/true, dot?
+153         }
+154         compare close-paren?, 0/false
+155         break-if-!=
+156         var curr-addr/eax: (addr cell) <- lookup *curr
+157         curr <- get curr-addr, right
+158         var tmp-storage: (handle cell)
+159         var tmp/edx: (addr handle cell) <- address tmp-storage
+160         $parse-sexpression:list-loop: {
+161           var close-paren?/eax: boolean <- copy 0/false
+162           var dot?/ecx: boolean <- copy 0/false
+163           close-paren?, dot? <- parse-sexpression tokens, tmp, trace
+164           # '.' -> clean up right here and return
+165           compare dot?, 0/false
+166           {
+167             break-if-=
+168             parse-dot-tail tokens, curr, trace
+169             return 0/false, 0/false
+170           }
+171           allocate-pair curr
+172           # ')' -> return
+173           compare close-paren?, 0/false
+174           break-if-!=
+175           var curr-addr/eax: (addr cell) <- lookup *curr
+176           var left/ecx: (addr handle cell) <- get curr-addr, left
+177           copy-object tmp, left
+178           #
+179           curr <- get curr-addr, right
+180           loop
+181         }
+182       }
+183       break $parse-sexpression:type-check
+184     }
+185     # close paren -> return
+186     var close-paren?/eax: boolean <- close-paren-token? curr-token
+187     compare close-paren?, 0/false
+188     {
+189       break-if-=
+190       trace-higher trace
+191       return 1/true, 0/false
+192     }
+193     # otherwise abort
+194     var stream-storage: (stream byte 0x400)
+195     var stream/edx: (addr stream byte) <- address stream-storage
+196     write stream, "unexpected token "
+197     var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data
+198     var curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah
+199     rewind-stream curr-token-data
+200     write-stream stream, curr-token-data
+201     error-stream trace, stream
+202   }
+203   trace-higher trace
+204   return 0/false, 0/false
+205 }
+206 
+207 fn parse-atom _curr-token: (addr token), _out: (addr handle cell), trace: (addr trace) {
+208   trace-text trace, "parse", "parse atom"
+209   var curr-token/ecx: (addr token) <- copy _curr-token
+210   var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data
+211   var _curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah
+212   var curr-token-data/esi: (addr stream byte) <- copy _curr-token-data
+213   trace trace, "parse", curr-token-data
+214   # number
+215   var number-token?/eax: boolean <- number-token? curr-token
+216   compare number-token?, 0/false
+217   {
+218     break-if-=
+219     rewind-stream curr-token-data
+220     var _val/eax: int <- parse-decimal-int-from-stream curr-token-data
+221     var val/ecx: int <- copy _val
+222     var val-float/xmm0: float <- convert val
+223     allocate-number _out
+224     var out/eax: (addr handle cell) <- copy _out
+225     var out-addr/eax: (addr cell) <- lookup *out
+226     var dest/edi: (addr float) <- get out-addr, number-data
+227     copy-to *dest, val-float
+228     {
+229       {
+230         var should-trace?/eax: boolean <- should-trace? trace
+231         compare should-trace?, 0/false
+232       }
+233       break-if-=
+234       var stream-storage: (stream byte 0x400)
+235       var stream/ecx: (addr stream byte) <- address stream-storage
+236       write stream, "=> number "
+237       var nested-trace-storage: trace
+238       var nested-trace/edi: (addr trace) <- address nested-trace-storage
+239       initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible
+240       print-number out-addr, stream, nested-trace
+241       trace trace, "parse", stream
+242     }
+243     return
+244   }
+245   # default: copy either to a symbol or a stream
+246   # stream token -> literal
+247   var stream-token?/eax: boolean <- stream-token? curr-token
+248   compare stream-token?, 0/false
+249   {
+250     break-if-=
+251     allocate-stream _out
+252   }
+253   compare stream-token?, 0/false
+254   {
+255     break-if-!=
+256     allocate-symbol _out
+257   }
+258   # copy token data
+259   var out/eax: (addr handle cell) <- copy _out
+260   var out-addr/eax: (addr cell) <- lookup *out
+261   var curr-token-data-ah/ecx: (addr handle stream byte) <- get curr-token, text-data
+262   var dest-ah/edx: (addr handle stream byte) <- get out-addr, text-data
+263   copy-object curr-token-data-ah, dest-ah
+264   {
+265     {
+266       var should-trace?/eax: boolean <- should-trace? trace
+267       compare should-trace?, 0/false
+268     }
+269     break-if-=
+270     var stream-storage: (stream byte 0x400)
+271     var stream/ecx: (addr stream byte) <- address stream-storage
+272     write stream, "=> symbol "
+273     var nested-trace-storage: trace
+274     var nested-trace/edi: (addr trace) <- address nested-trace-storage
+275     initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible
+276     print-symbol out-addr, stream, nested-trace
+277     trace trace, "parse", stream
+278   }
+279 }
+280 
+281 fn parse-dot-tail tokens: (addr stream token), _out: (addr handle cell), trace: (addr trace) {
+282   var out/edi: (addr handle cell) <- copy _out
+283   var close-paren?/eax: boolean <- copy 0/false
+284   var dot?/ecx: boolean <- copy 0/false
+285   close-paren?, dot? <- parse-sexpression tokens, out, trace
+286   compare close-paren?, 0/false
 287   {
 288     break-if-=
-289     error trace, "'. .' makes no sense"
+289     error trace, "'. )' makes no sense"
 290     return
 291   }
-292   #
-293   var dummy: (handle cell)
-294   var dummy-ah/edi: (addr handle cell) <- address dummy
-295   close-paren?, dot? <- parse-sexpression tokens, dummy-ah, trace
-296   compare close-paren?, 0/false
-297   {
-298     break-if-!=
-299     error trace, "cannot have multiple expressions between '.' and ')'"
-300     return
-301   }
-302   compare dot?, 0/false
+292   compare dot?, 0/false
+293   {
+294     break-if-=
+295     error trace, "'. .' makes no sense"
+296     return
+297   }
+298   #
+299   var dummy: (handle cell)
+300   var dummy-ah/edi: (addr handle cell) <- address dummy
+301   close-paren?, dot? <- parse-sexpression tokens, dummy-ah, trace
+302   compare close-paren?, 0/false
 303   {
-304     break-if-=
-305     error trace, "cannot have two dots in a single list"
+304     break-if-!=
+305     error trace, "cannot have multiple expressions between '.' and ')'"
 306     return
 307   }
-308 }
+308   compare dot?, 0/false
+309   {
+310     break-if-=
+311     error trace, "cannot have two dots in a single list"
+312     return
+313   }
+314 }
 
 
 
diff --git a/html/shell/primitives.mu.html b/html/shell/primitives.mu.html
index 851a30c5..bf6bf65a 100644
--- a/html/shell/primitives.mu.html
+++ b/html/shell/primitives.mu.html
@@ -67,2110 +67,2111 @@ if ('onhashchange' in window) {
    1 fn initialize-primitives _self: (addr global-table) {
    2   var self/esi: (addr global-table) <- copy _self
    3   # for numbers
-   4   append-primitive self, "+"
-   5   append-primitive self, "-"
-   6   append-primitive self, "*"
-   7   append-primitive self, "/"
-   8   append-primitive self, "%"
-   9   append-primitive self, "sqrt"
-  10   append-primitive self, "abs"
-  11   append-primitive self, "sgn"
-  12   append-primitive self, "<"
-  13   append-primitive self, ">"
-  14   append-primitive self, "<="
-  15   append-primitive self, ">="
+   4   append-primitive self, "+"
+   5   append-primitive self, "-"
+   6   append-primitive self, "*"
+   7   append-primitive self, "/"
+   8   append-primitive self, "%"
+   9   append-primitive self, "sqrt"
+  10   append-primitive self, "abs"
+  11   append-primitive self, "sgn"
+  12   append-primitive self, "<"
+  13   append-primitive self, ">"
+  14   append-primitive self, "<="
+  15   append-primitive self, ">="
   16   # generic
-  17   append-primitive self, "="
-  18   append-primitive self, "no"
-  19   append-primitive self, "not"
-  20   append-primitive self, "dbg"
-  21   # for pairs
-  22   append-primitive self, "car"
-  23   append-primitive self, "cdr"
-  24   append-primitive self, "cons"
-  25   # for screens
-  26   append-primitive self, "print"
-  27   append-primitive self, "clear"
-  28   append-primitive self, "lines"
-  29   append-primitive self, "columns"
-  30   append-primitive self, "up"
-  31   append-primitive self, "down"
-  32   append-primitive self, "left"
-  33   append-primitive self, "right"
-  34   append-primitive self, "cr"
-  35   append-primitive self, "pixel"
-  36   append-primitive self, "width"
-  37   append-primitive self, "height"
-  38   # for keyboards
-  39   append-primitive self, "key"
-  40   # for streams
-  41   append-primitive self, "stream"
-  42   append-primitive self, "write"
-  43   # misc
-  44   append-primitive self, "abort"
-  45   # keep sync'd with render-primitives
-  46 }
-  47 
-  48 fn render-primitives screen: (addr screen), xmin: int, xmax: int, ymax: int {
-  49   var y/ecx: int <- copy ymax
-  50   y <- subtract 0x10
-  51   clear-rect screen, xmin, y, xmax, ymax, 0xdc/bg=green-bg
-  52   y <- increment
-  53   var tmpx/eax: int <- copy xmin
-  54   tmpx <- draw-text-rightward screen, "cursor graphics", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
-  55   y <- increment
-  56   var tmpx/eax: int <- copy xmin
-  57   tmpx <- draw-text-rightward screen, "  print", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
-  58   tmpx <- draw-text-rightward screen, ": screen a -> a", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
-  59   y <- increment
-  60   var tmpx/eax: int <- copy xmin
-  61   tmpx <- draw-text-rightward screen, "  lines columns", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
-  62   tmpx <- draw-text-rightward screen, ": screen -> number", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
-  63   y <- increment
-  64   var tmpx/eax: int <- copy xmin
-  65   tmpx <- draw-text-rightward screen, "  up down left right", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
-  66   tmpx <- draw-text-rightward screen, ": screen", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
-  67   y <- increment
-  68   var tmpx/eax: int <- copy xmin
-  69   tmpx <- draw-text-rightward screen, "  cr", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
-  70   tmpx <- draw-text-rightward screen, ": screen   ", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
-  71   tmpx <- draw-text-rightward screen, "# move cursor down and to left margin", tmpx, xmax, y, 0x38/fg=trace, 0xdc/bg=green-bg
-  72   y <- increment
-  73   var tmpx/eax: int <- copy xmin
-  74   tmpx <- draw-text-rightward screen, "pixel graphics", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
-  75   y <- increment
-  76   var tmpx/eax: int <- copy xmin
-  77   tmpx <- draw-text-rightward screen, "  width height", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
-  78   tmpx <- draw-text-rightward screen, ": screen -> number", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
-  79   y <- increment
-  80   var tmpx/eax: int <- copy xmin
-  81   tmpx <- draw-text-rightward screen, "  pixel", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
-  82   tmpx <- draw-text-rightward screen, ": screen x y color", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
-  83   y <- increment
-  84   var tmpx/eax: int <- copy xmin
-  85   tmpx <- draw-text-rightward screen, "screen/keyboard", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
-  86   y <- increment
-  87   var tmpx/eax: int <- copy xmin
-  88   tmpx <- draw-text-rightward screen, "  clear", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
-  89   tmpx <- draw-text-rightward screen, ": screen", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
-  90   y <- increment
-  91   var tmpx/eax: int <- copy xmin
-  92   tmpx <- draw-text-rightward screen, "  key", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
-  93   tmpx <- draw-text-rightward screen, ": () -> grapheme?", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
-  94   y <- increment
-  95   var tmpx/eax: int <- copy xmin
-  96   tmpx <- draw-text-rightward screen, "streams", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
-  97   y <- increment
-  98   var tmpx/eax: int <- copy xmin
-  99   tmpx <- draw-text-rightward screen, "  stream", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
- 100   tmpx <- draw-text-rightward screen, ": () -> stream ", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
- 101   y <- increment
- 102   var tmpx/eax: int <- copy xmin
- 103   tmpx <- draw-text-rightward screen, "  write", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
- 104   tmpx <- draw-text-rightward screen, ": stream grapheme -> stream", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
- 105   y <- increment
- 106   var tmpx/eax: int <- copy xmin
- 107   tmpx <- draw-text-rightward screen, "fn set if while cons car cdr no not and or = ", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
- 108   # numbers
- 109   tmpx <- draw-text-rightward screen, "< > <= >= + - * / % sqrt abs sgn", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
- 110 }
- 111 
- 112 fn primitive-global? _x: (addr global) -> _/eax: boolean {
- 113   var x/eax: (addr global) <- copy _x
- 114   var value-ah/eax: (addr handle cell) <- get x, value
- 115   var value/eax: (addr cell) <- lookup *value-ah
- 116   compare value, 0/null
- 117   {
- 118     break-if-!=
- 119     return 0/false
- 120   }
- 121   var value-type/eax: (addr int) <- get value, type
- 122   compare *value-type, 4/primitive
- 123   {
- 124     break-if-=
- 125     return 0/false
- 126   }
- 127   return 1/true
- 128 }
- 129 
- 130 fn append-primitive _self: (addr global-table), name: (addr array byte) {
- 131   var self/esi: (addr global-table) <- copy _self
- 132   compare self, 0
- 133   {
- 134     break-if-!=
- 135     abort "append primitive"
- 136     return
- 137   }
- 138   var final-index-addr/ecx: (addr int) <- get self, final-index
- 139   increment *final-index-addr
- 140   var curr-index/ecx: int <- copy *final-index-addr
- 141   var data-ah/eax: (addr handle array global) <- get self, data
- 142   var data/eax: (addr array global) <- lookup *data-ah
- 143   var curr-offset/esi: (offset global) <- compute-offset data, curr-index
- 144   var curr/esi: (addr global) <- index data, curr-offset
- 145   var curr-name-ah/eax: (addr handle array byte) <- get curr, name
- 146   copy-array-object name, curr-name-ah
- 147   var curr-value-ah/eax: (addr handle cell) <- get curr, value
- 148   new-primitive-function curr-value-ah, curr-index
- 149 }
- 150 
- 151 # a little strange; goes from value to name and selects primitive based on name
- 152 fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr handle cell), _globals: (addr global-table), trace: (addr trace) {
- 153   var f/esi: (addr cell) <- copy _f
- 154   var f-index-a/ecx: (addr int) <- get f, index-data
- 155   var f-index/ecx: int <- copy *f-index-a
- 156   var globals/eax: (addr global-table) <- copy _globals
- 157   compare globals, 0
- 158   {
- 159     break-if-!=
- 160     abort "apply primitive"
- 161     return
- 162   }
- 163   var global-data-ah/eax: (addr handle array global) <- get globals, data
- 164   var global-data/eax: (addr array global) <- lookup *global-data-ah
- 165   var f-offset/ecx: (offset global) <- compute-offset global-data, f-index
- 166   var f-value/ecx: (addr global) <- index global-data, f-offset
- 167   var f-name-ah/ecx: (addr handle array byte) <- get f-value, name
- 168   var f-name/eax: (addr array byte) <- lookup *f-name-ah
- 169   {
- 170     var add?/eax: boolean <- string-equal? f-name, "+"
- 171     compare add?, 0/false
- 172     break-if-=
- 173     apply-add args-ah, out, trace
- 174     return
- 175   }
- 176   {
- 177     var subtract?/eax: boolean <- string-equal? f-name, "-"
- 178     compare subtract?, 0/false
- 179     break-if-=
- 180     apply-subtract args-ah, out, trace
- 181     return
- 182   }
- 183   {
- 184     var multiply?/eax: boolean <- string-equal? f-name, "*"
- 185     compare multiply?, 0/false
- 186     break-if-=
- 187     apply-multiply args-ah, out, trace
- 188     return
- 189   }
- 190   {
- 191     var divide?/eax: boolean <- string-equal? f-name, "/"
- 192     compare divide?, 0/false
- 193     break-if-=
- 194     apply-divide args-ah, out, trace
- 195     return
- 196   }
- 197   # '%' is the remainder operator, because modulo isn't really meaningful for
- 198   # non-integers
- 199   #
- 200   # I considered calling this operator 'rem', but I want to follow Arc in
- 201   # using 'rem' for filtering out elements from lists.
- 202   #   https://arclanguage.github.io/ref/list.html#rem
- 203   {
- 204     var remainder?/eax: boolean <- string-equal? f-name, "%"
- 205     compare remainder?, 0/false
- 206     break-if-=
- 207     apply-remainder args-ah, out, trace
- 208     return
- 209   }
- 210   {
- 211     var square-root?/eax: boolean <- string-equal? f-name, "sqrt"
- 212     compare square-root?, 0/false
- 213     break-if-=
- 214     apply-square-root args-ah, out, trace
- 215     return
- 216   }
- 217   {
- 218     var abs?/eax: boolean <- string-equal? f-name, "abs"
- 219     compare abs?, 0/false
- 220     break-if-=
- 221     apply-abs args-ah, out, trace
- 222     return
- 223   }
- 224   {
- 225     var sgn?/eax: boolean <- string-equal? f-name, "sgn"
- 226     compare sgn?, 0/false
- 227     break-if-=
- 228     apply-sgn args-ah, out, trace
- 229     return
- 230   }
- 231   {
- 232     var car?/eax: boolean <- string-equal? f-name, "car"
- 233     compare car?, 0/false
- 234     break-if-=
- 235     apply-car args-ah, out, trace
- 236     return
- 237   }
- 238   {
- 239     var cdr?/eax: boolean <- string-equal? f-name, "cdr"
- 240     compare cdr?, 0/false
- 241     break-if-=
- 242     apply-cdr args-ah, out, trace
- 243     return
- 244   }
- 245   {
- 246     var cons?/eax: boolean <- string-equal? f-name, "cons"
- 247     compare cons?, 0/false
- 248     break-if-=
- 249     apply-cons args-ah, out, trace
- 250     return
- 251   }
- 252   {
- 253     var structurally-equal?/eax: boolean <- string-equal? f-name, "="
- 254     compare structurally-equal?, 0/false
- 255     break-if-=
- 256     apply-structurally-equal args-ah, out, trace
- 257     return
- 258   }
- 259   {
- 260     var not?/eax: boolean <- string-equal? f-name, "no"
- 261     compare not?, 0/false
- 262     break-if-=
- 263     apply-not args-ah, out, trace
- 264     return
- 265   }
- 266   {
- 267     var not?/eax: boolean <- string-equal? f-name, "not"
- 268     compare not?, 0/false
- 269     break-if-=
- 270     apply-not args-ah, out, trace
- 271     return
- 272   }
- 273   {
- 274     var debug?/eax: boolean <- string-equal? f-name, "dbg"
- 275     compare debug?, 0/false
- 276     break-if-=
- 277     apply-debug args-ah, out, trace
- 278     return
- 279   }
- 280   {
- 281     var lesser?/eax: boolean <- string-equal? f-name, "<"
- 282     compare lesser?, 0/false
- 283     break-if-=
- 284     apply-< args-ah, out, trace
- 285     return
- 286   }
- 287   {
- 288     var greater?/eax: boolean <- string-equal? f-name, ">"
- 289     compare greater?, 0/false
- 290     break-if-=
- 291     apply-> args-ah, out, trace
- 292     return
- 293   }
- 294   {
- 295     var lesser-or-equal?/eax: boolean <- string-equal? f-name, "<="
- 296     compare lesser-or-equal?, 0/false
- 297     break-if-=
- 298     apply-<= args-ah, out, trace
- 299     return
- 300   }
- 301   {
- 302     var greater-or-equal?/eax: boolean <- string-equal? f-name, ">="
- 303     compare greater-or-equal?, 0/false
- 304     break-if-=
- 305     apply->= args-ah, out, trace
- 306     return
- 307   }
- 308   {
- 309     var print?/eax: boolean <- string-equal? f-name, "print"
- 310     compare print?, 0/false
- 311     break-if-=
- 312     apply-print args-ah, out, trace
- 313     return
- 314   }
- 315   {
- 316     var clear?/eax: boolean <- string-equal? f-name, "clear"
- 317     compare clear?, 0/false
- 318     break-if-=
- 319     apply-clear args-ah, out, trace
- 320     return
- 321   }
- 322   {
- 323     var lines?/eax: boolean <- string-equal? f-name, "lines"
- 324     compare lines?, 0/false
- 325     break-if-=
- 326     apply-lines args-ah, out, trace
- 327     return
- 328   }
- 329   {
- 330     var columns?/eax: boolean <- string-equal? f-name, "columns"
- 331     compare columns?, 0/false
- 332     break-if-=
- 333     apply-columns args-ah, out, trace
- 334     return
- 335   }
- 336   {
- 337     var up?/eax: boolean <- string-equal? f-name, "up"
- 338     compare up?, 0/false
- 339     break-if-=
- 340     apply-up args-ah, out, trace
- 341     return
- 342   }
- 343   {
- 344     var down?/eax: boolean <- string-equal? f-name, "down"
- 345     compare down?, 0/false
- 346     break-if-=
- 347     apply-down args-ah, out, trace
- 348     return
- 349   }
- 350   {
- 351     var left?/eax: boolean <- string-equal? f-name, "left"
- 352     compare left?, 0/false
- 353     break-if-=
- 354     apply-left args-ah, out, trace
- 355     return
- 356   }
- 357   {
- 358     var right?/eax: boolean <- string-equal? f-name, "right"
- 359     compare right?, 0/false
- 360     break-if-=
- 361     apply-right args-ah, out, trace
- 362     return
- 363   }
- 364   {
- 365     var cr?/eax: boolean <- string-equal? f-name, "cr"
- 366     compare cr?, 0/false
- 367     break-if-=
- 368     apply-cr args-ah, out, trace
- 369     return
- 370   }
- 371   {
- 372     var pixel?/eax: boolean <- string-equal? f-name, "pixel"
- 373     compare pixel?, 0/false
- 374     break-if-=
- 375     apply-pixel args-ah, out, trace
- 376     return
- 377   }
- 378   {
- 379     var width?/eax: boolean <- string-equal? f-name, "width"
- 380     compare width?, 0/false
- 381     break-if-=
- 382     apply-width args-ah, out, trace
- 383     return
- 384   }
- 385   {
- 386     var height?/eax: boolean <- string-equal? f-name, "height"
- 387     compare height?, 0/false
- 388     break-if-=
- 389     apply-height args-ah, out, trace
- 390     return
- 391   }
- 392   {
- 393     var wait-for-key?/eax: boolean <- string-equal? f-name, "key"
- 394     compare wait-for-key?, 0/false
- 395     break-if-=
- 396     apply-wait-for-key args-ah, out, trace
- 397     return
- 398   }
- 399   {
- 400     var stream?/eax: boolean <- string-equal? f-name, "stream"
- 401     compare stream?, 0/false
- 402     break-if-=
- 403     apply-stream args-ah, out, trace
- 404     return
- 405   }
- 406   {
- 407     var write?/eax: boolean <- string-equal? f-name, "write"
- 408     compare write?, 0/false
- 409     break-if-=
- 410     apply-write args-ah, out, trace
- 411     return
- 412   }
- 413   {
- 414     var abort?/eax: boolean <- string-equal? f-name, "abort"
- 415     compare abort?, 0/false
- 416     break-if-=
- 417     apply-abort args-ah, out, trace
- 418     return
- 419   }
- 420   abort "unknown primitive function"
- 421 }
- 422 
- 423 fn apply-add _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 424   trace-text trace, "eval", "apply +"
- 425   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 426   var _args/eax: (addr cell) <- lookup *args-ah
- 427   var args/esi: (addr cell) <- copy _args
- 428   {
- 429     var args-type/ecx: (addr int) <- get args, type
- 430     compare *args-type, 0/pair
- 431     break-if-=
- 432     error trace, "args to + are not a list"
- 433     return
- 434   }
- 435   var empty-args?/eax: boolean <- nil? args
- 436   compare empty-args?, 0/false
- 437   {
- 438     break-if-=
- 439     error trace, "+ needs 2 args but got 0"
- 440     return
- 441   }
- 442   # args->left->value
- 443   var first-ah/eax: (addr handle cell) <- get args, left
- 444   var first/eax: (addr cell) <- lookup *first-ah
- 445   var first-type/ecx: (addr int) <- get first, type
- 446   compare *first-type, 1/number
- 447   {
- 448     break-if-=
- 449     error trace, "first arg for + is not a number"
- 450     return
- 451   }
- 452   var first-value/ecx: (addr float) <- get first, number-data
- 453   # args->right->left->value
- 454   var right-ah/eax: (addr handle cell) <- get args, right
- 455   var right/eax: (addr cell) <- lookup *right-ah
- 456   {
- 457     var right-type/ecx: (addr int) <- get right, type
- 458     compare *right-type, 0/pair
- 459     break-if-=
- 460     error trace, "+ encountered non-pair"
- 461     return
- 462   }
- 463   {
- 464     var nil?/eax: boolean <- nil? right
- 465     compare nil?, 0/false
- 466     break-if-=
- 467     error trace, "+ needs 2 args but got 1"
- 468     return
- 469   }
- 470   var second-ah/eax: (addr handle cell) <- get right, left
- 471   var second/eax: (addr cell) <- lookup *second-ah
- 472   var second-type/edx: (addr int) <- get second, type
- 473   compare *second-type, 1/number
- 474   {
- 475     break-if-=
- 476     error trace, "second arg for + is not a number"
- 477     return
- 478   }
- 479   var second-value/edx: (addr float) <- get second, number-data
- 480   # add
- 481   var result/xmm0: float <- copy *first-value
- 482   result <- add *second-value
- 483   new-float out, result
- 484 }
- 485 
- 486 fn test-evaluate-missing-arg-in-add {
- 487   var t-storage: trace
- 488   var t/edi: (addr trace) <- address t-storage
- 489   initialize-trace t, 0x100/max-depth, 0x100/capacity, 0/visible  # we don't use trace UI
- 490   #
- 491   var nil-storage: (handle cell)
- 492   var nil-ah/ecx: (addr handle cell) <- address nil-storage
- 493   allocate-pair nil-ah
- 494   var one-storage: (handle cell)
- 495   var one-ah/edx: (addr handle cell) <- address one-storage
- 496   new-integer one-ah, 1
- 497   var add-storage: (handle cell)
- 498   var add-ah/ebx: (addr handle cell) <- address add-storage
- 499   new-symbol add-ah, "+"
- 500   # input is (+ 1)
- 501   var tmp-storage: (handle cell)
- 502   var tmp-ah/esi: (addr handle cell) <- address tmp-storage
- 503   new-pair tmp-ah, *one-ah, *nil-ah
- 504   new-pair tmp-ah, *add-ah, *tmp-ah
- 505 #?   dump-cell tmp-ah
- 506   #
- 507   var globals-storage: global-table
- 508   var globals/edx: (addr global-table) <- address globals-storage
- 509   initialize-globals globals
- 510   #
- 511   evaluate tmp-ah, tmp-ah, *nil-ah, globals, t, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number
- 512   # no crash
- 513 }
- 514 
- 515 fn apply-subtract _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 516   trace-text trace, "eval", "apply -"
- 517   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 518   var _args/eax: (addr cell) <- lookup *args-ah
- 519   var args/esi: (addr cell) <- copy _args
- 520   {
- 521     var args-type/ecx: (addr int) <- get args, type
- 522     compare *args-type, 0/pair
- 523     break-if-=
- 524     error trace, "args to - are not a list"
- 525     return
- 526   }
- 527   var empty-args?/eax: boolean <- nil? args
- 528   compare empty-args?, 0/false
- 529   {
- 530     break-if-=
- 531     error trace, "- needs 2 args but got 0"
- 532     return
- 533   }
- 534   # args->left->value
- 535   var first-ah/eax: (addr handle cell) <- get args, left
- 536   var first/eax: (addr cell) <- lookup *first-ah
- 537   var first-type/ecx: (addr int) <- get first, type
- 538   compare *first-type, 1/number
- 539   {
- 540     break-if-=
- 541     error trace, "first arg for - is not a number"
- 542     return
- 543   }
- 544   var first-value/ecx: (addr float) <- get first, number-data
- 545   # args->right->left->value
- 546   var right-ah/eax: (addr handle cell) <- get args, right
- 547   var right/eax: (addr cell) <- lookup *right-ah
- 548   {
- 549     var right-type/ecx: (addr int) <- get right, type
- 550     compare *right-type, 0/pair
- 551     break-if-=
- 552     error trace, "- encountered non-pair"
- 553     return
- 554   }
- 555   {
- 556     var nil?/eax: boolean <- nil? right
- 557     compare nil?, 0/false
- 558     break-if-=
- 559     error trace, "- needs 2 args but got 1"
- 560     return
- 561   }
- 562   var second-ah/eax: (addr handle cell) <- get right, left
- 563   var second/eax: (addr cell) <- lookup *second-ah
- 564   var second-type/edx: (addr int) <- get second, type
- 565   compare *second-type, 1/number
- 566   {
- 567     break-if-=
- 568     error trace, "second arg for - is not a number"
- 569     return
- 570   }
- 571   var second-value/edx: (addr float) <- get second, number-data
- 572   # subtract
- 573   var result/xmm0: float <- copy *first-value
- 574   result <- subtract *second-value
- 575   new-float out, result
- 576 }
- 577 
- 578 fn apply-multiply _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 579   trace-text trace, "eval", "apply *"
- 580   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 581   var _args/eax: (addr cell) <- lookup *args-ah
- 582   var args/esi: (addr cell) <- copy _args
- 583   {
- 584     var args-type/ecx: (addr int) <- get args, type
- 585     compare *args-type, 0/pair
- 586     break-if-=
- 587     error trace, "args to * are not a list"
- 588     return
- 589   }
- 590   var empty-args?/eax: boolean <- nil? args
- 591   compare empty-args?, 0/false
- 592   {
- 593     break-if-=
- 594     error trace, "* needs 2 args but got 0"
- 595     return
- 596   }
- 597   # args->left->value
- 598   var first-ah/eax: (addr handle cell) <- get args, left
- 599   var first/eax: (addr cell) <- lookup *first-ah
- 600   var first-type/ecx: (addr int) <- get first, type
- 601   compare *first-type, 1/number
- 602   {
- 603     break-if-=
- 604     error trace, "first arg for * is not a number"
- 605     return
- 606   }
- 607   var first-value/ecx: (addr float) <- get first, number-data
- 608   # args->right->left->value
- 609   var right-ah/eax: (addr handle cell) <- get args, right
- 610   var right/eax: (addr cell) <- lookup *right-ah
- 611   {
- 612     var right-type/ecx: (addr int) <- get right, type
- 613     compare *right-type, 0/pair
- 614     break-if-=
- 615     error trace, "* encountered non-pair"
- 616     return
- 617   }
- 618   {
- 619     var nil?/eax: boolean <- nil? right
- 620     compare nil?, 0/false
- 621     break-if-=
- 622     error trace, "* needs 2 args but got 1"
- 623     return
- 624   }
- 625   var second-ah/eax: (addr handle cell) <- get right, left
- 626   var second/eax: (addr cell) <- lookup *second-ah
- 627   var second-type/edx: (addr int) <- get second, type
- 628   compare *second-type, 1/number
- 629   {
- 630     break-if-=
- 631     error trace, "second arg for * is not a number"
- 632     return
- 633   }
- 634   var second-value/edx: (addr float) <- get second, number-data
- 635   # multiply
- 636   var result/xmm0: float <- copy *first-value
- 637   result <- multiply *second-value
- 638   new-float out, result
- 639 }
- 640 
- 641 fn apply-divide _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 642   trace-text trace, "eval", "apply /"
- 643   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 644   var _args/eax: (addr cell) <- lookup *args-ah
- 645   var args/esi: (addr cell) <- copy _args
- 646   {
- 647     var args-type/ecx: (addr int) <- get args, type
- 648     compare *args-type, 0/pair
- 649     break-if-=
- 650     error trace, "args to / are not a list"
- 651     return
- 652   }
- 653   var empty-args?/eax: boolean <- nil? args
- 654   compare empty-args?, 0/false
- 655   {
- 656     break-if-=
- 657     error trace, "/ needs 2 args but got 0"
- 658     return
- 659   }
- 660   # args->left->value
- 661   var first-ah/eax: (addr handle cell) <- get args, left
- 662   var first/eax: (addr cell) <- lookup *first-ah
- 663   var first-type/ecx: (addr int) <- get first, type
- 664   compare *first-type, 1/number
- 665   {
- 666     break-if-=
- 667     error trace, "first arg for / is not a number"
- 668     return
- 669   }
- 670   var first-value/ecx: (addr float) <- get first, number-data
- 671   # args->right->left->value
- 672   var right-ah/eax: (addr handle cell) <- get args, right
- 673   var right/eax: (addr cell) <- lookup *right-ah
- 674   {
- 675     var right-type/ecx: (addr int) <- get right, type
- 676     compare *right-type, 0/pair
- 677     break-if-=
- 678     error trace, "/ encountered non-pair"
- 679     return
- 680   }
- 681   {
- 682     var nil?/eax: boolean <- nil? right
- 683     compare nil?, 0/false
- 684     break-if-=
- 685     error trace, "/ needs 2 args but got 1"
- 686     return
- 687   }
- 688   var second-ah/eax: (addr handle cell) <- get right, left
- 689   var second/eax: (addr cell) <- lookup *second-ah
- 690   var second-type/edx: (addr int) <- get second, type
- 691   compare *second-type, 1/number
- 692   {
- 693     break-if-=
- 694     error trace, "second arg for / is not a number"
- 695     return
- 696   }
- 697   var second-value/edx: (addr float) <- get second, number-data
- 698   # divide
- 699   var result/xmm0: float <- copy *first-value
- 700   result <- divide *second-value
- 701   new-float out, result
- 702 }
- 703 
- 704 fn apply-remainder _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 705   trace-text trace, "eval", "apply %"
- 706   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 707   var _args/eax: (addr cell) <- lookup *args-ah
- 708   var args/esi: (addr cell) <- copy _args
- 709   {
- 710     var args-type/ecx: (addr int) <- get args, type
- 711     compare *args-type, 0/pair
- 712     break-if-=
- 713     error trace, "args to % are not a list"
- 714     return
- 715   }
- 716   var empty-args?/eax: boolean <- nil? args
- 717   compare empty-args?, 0/false
- 718   {
- 719     break-if-=
- 720     error trace, "% needs 2 args but got 0"
- 721     return
- 722   }
- 723   # args->left->value
- 724   var first-ah/eax: (addr handle cell) <- get args, left
- 725   var first/eax: (addr cell) <- lookup *first-ah
- 726   var first-type/ecx: (addr int) <- get first, type
- 727   compare *first-type, 1/number
- 728   {
- 729     break-if-=
- 730     error trace, "first arg for % is not a number"
- 731     return
- 732   }
- 733   var first-value/ecx: (addr float) <- get first, number-data
- 734   # args->right->left->value
- 735   var right-ah/eax: (addr handle cell) <- get args, right
- 736   var right/eax: (addr cell) <- lookup *right-ah
- 737   {
- 738     var right-type/ecx: (addr int) <- get right, type
- 739     compare *right-type, 0/pair
- 740     break-if-=
- 741     error trace, "% encountered non-pair"
- 742     return
- 743   }
- 744   {
- 745     var nil?/eax: boolean <- nil? right
- 746     compare nil?, 0/false
- 747     break-if-=
- 748     error trace, "% needs 2 args but got 1"
- 749     return
- 750   }
- 751   var second-ah/eax: (addr handle cell) <- get right, left
- 752   var second/eax: (addr cell) <- lookup *second-ah
- 753   var second-type/edx: (addr int) <- get second, type
- 754   compare *second-type, 1/number
- 755   {
- 756     break-if-=
- 757     error trace, "second arg for % is not a number"
- 758     return
- 759   }
- 760   var second-value/edx: (addr float) <- get second, number-data
- 761   # divide
- 762   var quotient/xmm0: float <- copy *first-value
- 763   quotient <- divide *second-value
- 764   var quotient-int/eax: int <- truncate quotient
- 765   quotient <- convert quotient-int
- 766   var sub-result/xmm1: float <- copy quotient
- 767   sub-result <- multiply *second-value
- 768   var result/xmm0: float <- copy *first-value
- 769   result <- subtract sub-result
- 770   new-float out, result
- 771 }
- 772 
- 773 fn apply-square-root _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 774   trace-text trace, "eval", "apply sqrt"
- 775   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 776   var _args/eax: (addr cell) <- lookup *args-ah
- 777   var args/esi: (addr cell) <- copy _args
- 778   {
- 779     var args-type/ecx: (addr int) <- get args, type
- 780     compare *args-type, 0/pair
- 781     break-if-=
- 782     error trace, "args to sqrt are not a list"
- 783     return
- 784   }
- 785   var empty-args?/eax: boolean <- nil? args
- 786   compare empty-args?, 0/false
- 787   {
- 788     break-if-=
- 789     error trace, "sqrt needs 1 arg but got 0"
- 790     return
- 791   }
- 792   # args->left->value
- 793   var first-ah/eax: (addr handle cell) <- get args, left
- 794   var first/eax: (addr cell) <- lookup *first-ah
- 795   var first-type/ecx: (addr int) <- get first, type
- 796   compare *first-type, 1/number
- 797   {
- 798     break-if-=
- 799     error trace, "arg for sqrt is not a number"
- 800     return
- 801   }
- 802   var first-value/ecx: (addr float) <- get first, number-data
- 803   # square-root
- 804   var result/xmm0: float <- square-root *first-value
- 805   new-float out, result
- 806 }
- 807 
- 808 fn apply-abs _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 809   trace-text trace, "eval", "apply abs"
- 810   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 811   var _args/eax: (addr cell) <- lookup *args-ah
- 812   var args/esi: (addr cell) <- copy _args
- 813   {
- 814     var args-type/ecx: (addr int) <- get args, type
- 815     compare *args-type, 0/pair
- 816     break-if-=
- 817     error trace, "args to abs are not a list"
- 818     return
- 819   }
- 820   var empty-args?/eax: boolean <- nil? args
- 821   compare empty-args?, 0/false
- 822   {
- 823     break-if-=
- 824     error trace, "abs needs 1 arg but got 0"
- 825     return
- 826   }
- 827   # args->left->value
- 828   var first-ah/eax: (addr handle cell) <- get args, left
- 829   var first/eax: (addr cell) <- lookup *first-ah
- 830   var first-type/ecx: (addr int) <- get first, type
- 831   compare *first-type, 1/number
- 832   {
- 833     break-if-=
- 834     error trace, "arg for abs is not a number"
- 835     return
- 836   }
- 837   var first-value/ecx: (addr float) <- get first, number-data
- 838   #
- 839   var result/xmm0: float <- copy *first-value
- 840   var zero: float
- 841   compare result, zero
- 842   {
- 843     break-if-float>=
- 844     var neg1/eax: int <- copy -1
- 845     var neg1-f/xmm1: float <- convert neg1
- 846     result <- multiply neg1-f
- 847   }
- 848   new-float out, result
- 849 }
- 850 
- 851 fn apply-sgn _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 852   trace-text trace, "eval", "apply sgn"
- 853   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 854   var _args/eax: (addr cell) <- lookup *args-ah
- 855   var args/esi: (addr cell) <- copy _args
- 856   {
- 857     var args-type/ecx: (addr int) <- get args, type
- 858     compare *args-type, 0/pair
- 859     break-if-=
- 860     error trace, "args to sgn are not a list"
- 861     return
- 862   }
- 863   var empty-args?/eax: boolean <- nil? args
- 864   compare empty-args?, 0/false
- 865   {
- 866     break-if-=
- 867     error trace, "sgn needs 1 arg but got 0"
- 868     return
- 869   }
- 870   # args->left->value
- 871   var first-ah/eax: (addr handle cell) <- get args, left
- 872   var first/eax: (addr cell) <- lookup *first-ah
- 873   var first-type/ecx: (addr int) <- get first, type
- 874   compare *first-type, 1/number
- 875   {
- 876     break-if-=
- 877     error trace, "arg for sgn is not a number"
- 878     return
- 879   }
- 880   var first-value/ecx: (addr float) <- get first, number-data
- 881   #
- 882   var result/xmm0: float <- copy *first-value
- 883   var zero: float
- 884   $apply-sgn:core: {
- 885     compare result, zero
- 886     break-if-=
- 887     {
- 888       break-if-float>
- 889       var neg1/eax: int <- copy -1
- 890       result <- convert neg1
- 891       break $apply-sgn:core
- 892     }
- 893     {
- 894       break-if-float<
- 895       var one/eax: int <- copy 1
- 896       result <- convert one
- 897       break $apply-sgn:core
- 898     }
- 899   }
- 900   new-float out, result
- 901 }
- 902 
- 903 fn apply-car _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 904   trace-text trace, "eval", "apply car"
- 905   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 906   var _args/eax: (addr cell) <- lookup *args-ah
- 907   var args/esi: (addr cell) <- copy _args
- 908   {
- 909     var args-type/ecx: (addr int) <- get args, type
- 910     compare *args-type, 0/pair
- 911     break-if-=
- 912     error trace, "args to car are not a list"
- 913     return
- 914   }
- 915   var empty-args?/eax: boolean <- nil? args
- 916   compare empty-args?, 0/false
- 917   {
- 918     break-if-=
- 919     error trace, "car needs 1 arg but got 0"
- 920     return
- 921   }
- 922   # args->left
- 923   var first-ah/edx: (addr handle cell) <- get args, left
- 924   var first/eax: (addr cell) <- lookup *first-ah
- 925   var first-type/ecx: (addr int) <- get first, type
- 926   compare *first-type, 0/pair
- 927   {
- 928     break-if-=
- 929     error trace, "arg for car is not a pair"
- 930     return
- 931   }
- 932   # nil? return nil
- 933   {
- 934     var nil?/eax: boolean <- nil? first
- 935     compare nil?, 0/false
- 936     break-if-=
- 937     copy-object first-ah, out
- 938     return
- 939   }
- 940   # car
- 941   var result/eax: (addr handle cell) <- get first, left
- 942   copy-object result, out
- 943 }
- 944 
- 945 fn apply-cdr _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 946   trace-text trace, "eval", "apply cdr"
- 947   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 948   var _args/eax: (addr cell) <- lookup *args-ah
- 949   var args/esi: (addr cell) <- copy _args
- 950   {
- 951     var args-type/ecx: (addr int) <- get args, type
- 952     compare *args-type, 0/pair
- 953     break-if-=
- 954     error trace, "args to cdr are not a list"
- 955     return
- 956   }
- 957   var empty-args?/eax: boolean <- nil? args
- 958   compare empty-args?, 0/false
- 959   {
- 960     break-if-=
- 961     error trace, "cdr needs 1 arg but got 0"
- 962     return
- 963   }
- 964   # args->left
- 965   var first-ah/edx: (addr handle cell) <- get args, left
- 966   var first/eax: (addr cell) <- lookup *first-ah
- 967   var first-type/ecx: (addr int) <- get first, type
- 968   compare *first-type, 0/pair
- 969   {
- 970     break-if-=
- 971     error trace, "arg for cdr is not a pair"
- 972     return
- 973   }
- 974   # nil? return nil
- 975   {
- 976     var nil?/eax: boolean <- nil? first
- 977     compare nil?, 0/false
- 978     break-if-=
- 979     copy-object first-ah, out
- 980     return
- 981   }
- 982   # cdr
- 983   var result/eax: (addr handle cell) <- get first, right
- 984   copy-object result, out
- 985 }
- 986 
- 987 fn apply-cons _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 988   trace-text trace, "eval", "apply cons"
- 989   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 990   var _args/eax: (addr cell) <- lookup *args-ah
- 991   var args/esi: (addr cell) <- copy _args
- 992   {
- 993     var args-type/ecx: (addr int) <- get args, type
- 994     compare *args-type, 0/pair
- 995     break-if-=
- 996     error trace, "args to 'cons' are not a list"
- 997     return
- 998   }
- 999   var empty-args?/eax: boolean <- nil? args
-1000   compare empty-args?, 0/false
-1001   {
-1002     break-if-=
-1003     error trace, "cons needs 2 args but got 0"
-1004     return
-1005   }
-1006   # args->left
-1007   var first-ah/ecx: (addr handle cell) <- get args, left
-1008   # args->right->left
-1009   var right-ah/eax: (addr handle cell) <- get args, right
-1010   var right/eax: (addr cell) <- lookup *right-ah
-1011   {
-1012     var right-type/ecx: (addr int) <- get right, type
-1013     compare *right-type, 0/pair
-1014     break-if-=
-1015     error trace, "'cons' encountered non-pair"
-1016     return
-1017   }
-1018   {
-1019     var nil?/eax: boolean <- nil? right
-1020     compare nil?, 0/false
-1021     break-if-=
-1022     error trace, "'cons' needs 2 args but got 1"
-1023     return
-1024   }
-1025   var second-ah/eax: (addr handle cell) <- get right, left
-1026   # cons
-1027   new-pair out, *first-ah, *second-ah
-1028 }
-1029 
-1030 fn apply-structurally-equal _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1031   trace-text trace, "eval", "apply '='"
-1032   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1033   var _args/eax: (addr cell) <- lookup *args-ah
-1034   var args/esi: (addr cell) <- copy _args
-1035   {
-1036     var args-type/ecx: (addr int) <- get args, type
-1037     compare *args-type, 0/pair
-1038     break-if-=
-1039     error trace, "args to '=' are not a list"
-1040     return
-1041   }
-1042   var empty-args?/eax: boolean <- nil? args
-1043   compare empty-args?, 0/false
-1044   {
-1045     break-if-=
-1046     error trace, "'=' needs 2 args but got 0"
-1047     return
-1048   }
-1049   # args->left
-1050   var first-ah/ecx: (addr handle cell) <- get args, left
-1051   # args->right->left
-1052   var right-ah/eax: (addr handle cell) <- get args, right
-1053   var right/eax: (addr cell) <- lookup *right-ah
-1054   {
-1055     var right-type/ecx: (addr int) <- get right, type
-1056     compare *right-type, 0/pair
-1057     break-if-=
-1058     error trace, "'=' encountered non-pair"
-1059     return
-1060   }
-1061   {
-1062     var nil?/eax: boolean <- nil? right
-1063     compare nil?, 0/false
-1064     break-if-=
-1065     error trace, "'=' needs 2 args but got 1"
-1066     return
-1067   }
-1068   var second-ah/edx: (addr handle cell) <- get right, left
-1069   # compare
-1070   var _first/eax: (addr cell) <- lookup *first-ah
-1071   var first/ecx: (addr cell) <- copy _first
-1072   var second/eax: (addr cell) <- lookup *second-ah
-1073   var match?/eax: boolean <- cell-isomorphic? first, second, trace
-1074   compare match?, 0/false
-1075   {
-1076     break-if-!=
-1077     nil out
-1078     return
-1079   }
-1080   new-integer out, 1/true
-1081 }
-1082 
-1083 fn apply-not _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1084   trace-text trace, "eval", "apply 'not'"
-1085   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1086   var _args/eax: (addr cell) <- lookup *args-ah
-1087   var args/esi: (addr cell) <- copy _args
-1088   {
-1089     var args-type/ecx: (addr int) <- get args, type
-1090     compare *args-type, 0/pair
-1091     break-if-=
-1092     error trace, "args to 'not' are not a list"
-1093     return
-1094   }
-1095   var empty-args?/eax: boolean <- nil? args
-1096   compare empty-args?, 0/false
-1097   {
-1098     break-if-=
-1099     error trace, "'not' needs 1 arg but got 0"
-1100     return
-1101   }
-1102   # args->left
-1103   var first-ah/eax: (addr handle cell) <- get args, left
-1104   var first/eax: (addr cell) <- lookup *first-ah
-1105   # not
-1106   var nil?/eax: boolean <- nil? first
-1107   compare nil?, 0/false
-1108   {
-1109     break-if-!=
-1110     nil out
-1111     return
-1112   }
-1113   new-integer out, 1
-1114 }
-1115 
-1116 fn apply-debug _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1117   trace-text trace, "eval", "apply 'debug'"
-1118   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1119   var _args/eax: (addr cell) <- lookup *args-ah
-1120   var args/esi: (addr cell) <- copy _args
-1121   {
-1122     var args-type/ecx: (addr int) <- get args, type
-1123     compare *args-type, 0/pair
-1124     break-if-=
-1125     error trace, "args to 'debug' are not a list"
-1126     return
-1127   }
-1128   var empty-args?/eax: boolean <- nil? args
-1129   compare empty-args?, 0/false
-1130   {
-1131     break-if-=
-1132     error trace, "'debug' needs 1 arg but got 0"
-1133     return
-1134   }
-1135   # dump args->left uglily to screen and wait for a keypress
-1136   var first-ah/eax: (addr handle cell) <- get args, left
-1137   dump-cell-from-cursor-over-full-screen first-ah
-1138   {
-1139     var foo/eax: byte <- read-key 0/keyboard
-1140     compare foo, 0
-1141     loop-if-=
-1142   }
-1143   # return nothing
-1144 }
-1145 
-1146 fn apply-< _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1147   trace-text trace, "eval", "apply '<'"
-1148   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1149   var _args/eax: (addr cell) <- lookup *args-ah
-1150   var args/esi: (addr cell) <- copy _args
-1151   {
-1152     var args-type/ecx: (addr int) <- get args, type
-1153     compare *args-type, 0/pair
-1154     break-if-=
-1155     error trace, "args to '<' are not a list"
-1156     return
-1157   }
-1158   var empty-args?/eax: boolean <- nil? args
-1159   compare empty-args?, 0/false
-1160   {
-1161     break-if-=
-1162     error trace, "'<' needs 2 args but got 0"
-1163     return
-1164   }
-1165   # args->left
-1166   var first-ah/ecx: (addr handle cell) <- get args, left
-1167   # args->right->left
-1168   var right-ah/eax: (addr handle cell) <- get args, right
-1169   var right/eax: (addr cell) <- lookup *right-ah
-1170   {
-1171     var right-type/ecx: (addr int) <- get right, type
-1172     compare *right-type, 0/pair
-1173     break-if-=
-1174     error trace, "'<' encountered non-pair"
-1175     return
-1176   }
-1177   {
-1178     var nil?/eax: boolean <- nil? right
-1179     compare nil?, 0/false
-1180     break-if-=
-1181     error trace, "'<' needs 2 args but got 1"
-1182     return
-1183   }
-1184   var second-ah/edx: (addr handle cell) <- get right, left
-1185   # compare
-1186   var _first/eax: (addr cell) <- lookup *first-ah
-1187   var first/ecx: (addr cell) <- copy _first
-1188   var first-type/eax: (addr int) <- get first, type
-1189   compare *first-type, 1/number
-1190   {
-1191     break-if-=
-1192     error trace, "first arg for '<' is not a number"
-1193     return
-1194   }
-1195   var first-value/ecx: (addr float) <- get first, number-data
-1196   var first-float/xmm0: float <- copy *first-value
-1197   var second/eax: (addr cell) <- lookup *second-ah
-1198   var second-type/edx: (addr int) <- get second, type
-1199   compare *second-type, 1/number
-1200   {
-1201     break-if-=
-1202     error trace, "second arg for '<' is not a number"
-1203     return
-1204   }
-1205   var second-value/eax: (addr float) <- get second, number-data
-1206   compare first-float, *second-value
-1207   {
-1208     break-if-float<
-1209     nil out
-1210     return
-1211   }
-1212   new-integer out, 1/true
-1213 }
-1214 
-1215 fn apply-> _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1216   trace-text trace, "eval", "apply '>'"
-1217   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1218   var _args/eax: (addr cell) <- lookup *args-ah
-1219   var args/esi: (addr cell) <- copy _args
-1220   {
-1221     var args-type/ecx: (addr int) <- get args, type
-1222     compare *args-type, 0/pair
-1223     break-if-=
-1224     error trace, "args to '>' are not a list"
-1225     return
-1226   }
-1227   var empty-args?/eax: boolean <- nil? args
-1228   compare empty-args?, 0/false
-1229   {
-1230     break-if-=
-1231     error trace, "'>' needs 2 args but got 0"
-1232     return
-1233   }
-1234   # args->left
-1235   var first-ah/ecx: (addr handle cell) <- get args, left
-1236   # args->right->left
-1237   var right-ah/eax: (addr handle cell) <- get args, right
-1238   var right/eax: (addr cell) <- lookup *right-ah
-1239   {
-1240     var right-type/ecx: (addr int) <- get right, type
-1241     compare *right-type, 0/pair
-1242     break-if-=
-1243     error trace, "'>' encountered non-pair"
-1244     return
-1245   }
-1246   {
-1247     var nil?/eax: boolean <- nil? right
-1248     compare nil?, 0/false
-1249     break-if-=
-1250     error trace, "'>' needs 2 args but got 1"
-1251     return
-1252   }
-1253   var second-ah/edx: (addr handle cell) <- get right, left
-1254   # compare
-1255   var _first/eax: (addr cell) <- lookup *first-ah
-1256   var first/ecx: (addr cell) <- copy _first
-1257   var first-type/eax: (addr int) <- get first, type
-1258   compare *first-type, 1/number
-1259   {
-1260     break-if-=
-1261     error trace, "first arg for '>' is not a number"
-1262     return
-1263   }
-1264   var first-value/ecx: (addr float) <- get first, number-data
-1265   var first-float/xmm0: float <- copy *first-value
-1266   var second/eax: (addr cell) <- lookup *second-ah
-1267   var second-type/edx: (addr int) <- get second, type
-1268   compare *second-type, 1/number
-1269   {
-1270     break-if-=
-1271     error trace, "second arg for '>' is not a number"
-1272     return
-1273   }
-1274   var second-value/eax: (addr float) <- get second, number-data
-1275   compare first-float, *second-value
-1276   {
-1277     break-if-float>
-1278     nil out
-1279     return
-1280   }
-1281   new-integer out, 1/true
-1282 }
-1283 
-1284 fn apply-<= _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1285   trace-text trace, "eval", "apply '<='"
-1286   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1287   var _args/eax: (addr cell) <- lookup *args-ah
-1288   var args/esi: (addr cell) <- copy _args
-1289   {
-1290     var args-type/ecx: (addr int) <- get args, type
-1291     compare *args-type, 0/pair
-1292     break-if-=
-1293     error trace, "args to '<=' are not a list"
-1294     return
-1295   }
-1296   var empty-args?/eax: boolean <- nil? args
-1297   compare empty-args?, 0/false
-1298   {
-1299     break-if-=
-1300     error trace, "'<=' needs 2 args but got 0"
-1301     return
-1302   }
-1303   # args->left
-1304   var first-ah/ecx: (addr handle cell) <- get args, left
-1305   # args->right->left
-1306   var right-ah/eax: (addr handle cell) <- get args, right
-1307   var right/eax: (addr cell) <- lookup *right-ah
-1308   {
-1309     var right-type/ecx: (addr int) <- get right, type
-1310     compare *right-type, 0/pair
-1311     break-if-=
-1312     error trace, "'<=' encountered non-pair"
-1313     return
-1314   }
-1315   {
-1316     var nil?/eax: boolean <- nil? right
-1317     compare nil?, 0/false
-1318     break-if-=
-1319     error trace, "'<=' needs 2 args but got 1"
-1320     return
-1321   }
-1322   var second-ah/edx: (addr handle cell) <- get right, left
-1323   # compare
-1324   var _first/eax: (addr cell) <- lookup *first-ah
-1325   var first/ecx: (addr cell) <- copy _first
-1326   var first-type/eax: (addr int) <- get first, type
-1327   compare *first-type, 1/number
-1328   {
-1329     break-if-=
-1330     error trace, "first arg for '<=' is not a number"
-1331     return
-1332   }
-1333   var first-value/ecx: (addr float) <- get first, number-data
-1334   var first-float/xmm0: float <- copy *first-value
-1335   var second/eax: (addr cell) <- lookup *second-ah
-1336   var second-type/edx: (addr int) <- get second, type
-1337   compare *second-type, 1/number
-1338   {
-1339     break-if-=
-1340     error trace, "second arg for '<=' is not a number"
-1341     return
-1342   }
-1343   var second-value/eax: (addr float) <- get second, number-data
-1344   compare first-float, *second-value
-1345   {
-1346     break-if-float<=
-1347     nil out
-1348     return
-1349   }
-1350   new-integer out, 1/true
-1351 }
-1352 
-1353 fn apply->= _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1354   trace-text trace, "eval", "apply '>='"
-1355   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1356   var _args/eax: (addr cell) <- lookup *args-ah
-1357   var args/esi: (addr cell) <- copy _args
-1358   {
-1359     var args-type/ecx: (addr int) <- get args, type
-1360     compare *args-type, 0/pair
-1361     break-if-=
-1362     error trace, "args to '>=' are not a list"
-1363     return
-1364   }
-1365   var empty-args?/eax: boolean <- nil? args
-1366   compare empty-args?, 0/false
-1367   {
-1368     break-if-=
-1369     error trace, "'>=' needs 2 args but got 0"
-1370     return
-1371   }
-1372   # args->left
-1373   var first-ah/ecx: (addr handle cell) <- get args, left
-1374   # args->right->left
-1375   var right-ah/eax: (addr handle cell) <- get args, right
-1376   var right/eax: (addr cell) <- lookup *right-ah
-1377   {
-1378     var right-type/ecx: (addr int) <- get right, type
-1379     compare *right-type, 0/pair
-1380     break-if-=
-1381     error trace, "'>=' encountered non-pair"
-1382     return
-1383   }
-1384   {
-1385     var nil?/eax: boolean <- nil? right
-1386     compare nil?, 0/false
-1387     break-if-=
-1388     error trace, "'>=' needs 2 args but got 1"
-1389     return
-1390   }
-1391   var second-ah/edx: (addr handle cell) <- get right, left
-1392   # compare
-1393   var _first/eax: (addr cell) <- lookup *first-ah
-1394   var first/ecx: (addr cell) <- copy _first
-1395   var first-type/eax: (addr int) <- get first, type
-1396   compare *first-type, 1/number
-1397   {
-1398     break-if-=
-1399     error trace, "first arg for '>=' is not a number"
-1400     return
-1401   }
-1402   var first-value/ecx: (addr float) <- get first, number-data
-1403   var first-float/xmm0: float <- copy *first-value
-1404   var second/eax: (addr cell) <- lookup *second-ah
-1405   var second-type/edx: (addr int) <- get second, type
-1406   compare *second-type, 1/number
-1407   {
-1408     break-if-=
-1409     error trace, "second arg for '>=' is not a number"
-1410     return
-1411   }
-1412   var second-value/eax: (addr float) <- get second, number-data
-1413   compare first-float, *second-value
-1414   {
-1415     break-if-float>=
-1416     nil out
-1417     return
-1418   }
-1419   new-integer out, 1/true
-1420 }
-1421 
-1422 fn apply-print _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1423   trace-text trace, "eval", "apply 'print'"
-1424   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1425   var _args/eax: (addr cell) <- lookup *args-ah
-1426   var args/esi: (addr cell) <- copy _args
-1427   {
-1428     var args-type/ecx: (addr int) <- get args, type
-1429     compare *args-type, 0/pair
-1430     break-if-=
-1431     error trace, "args to 'print' are not a list"
-1432     return
-1433   }
-1434   var empty-args?/eax: boolean <- nil? args
-1435   compare empty-args?, 0/false
-1436   {
-1437     break-if-=
-1438     error trace, "'print' needs 2 args but got 0"
-1439     return
-1440   }
-1441   # screen = args->left
-1442   var first-ah/eax: (addr handle cell) <- get args, left
-1443   var first/eax: (addr cell) <- lookup *first-ah
-1444   var first-type/ecx: (addr int) <- get first, type
-1445   compare *first-type, 5/screen
-1446   {
-1447     break-if-=
-1448     error trace, "first arg for 'print' is not a screen"
-1449     return
-1450   }
-1451   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1452   var _screen/eax: (addr screen) <- lookup *screen-ah
-1453   var screen/ecx: (addr screen) <- copy _screen
-1454   # args->right->left
-1455   var right-ah/eax: (addr handle cell) <- get args, right
-1456   var right/eax: (addr cell) <- lookup *right-ah
-1457   {
-1458     var right-type/ecx: (addr int) <- get right, type
-1459     compare *right-type, 0/pair
-1460     break-if-=
-1461     error trace, "'print' encountered non-pair"
-1462     return
-1463   }
-1464   {
-1465     var nil?/eax: boolean <- nil? right
-1466     compare nil?, 0/false
-1467     break-if-=
-1468     error trace, "'print' needs 2 args but got 1"
-1469     return
-1470   }
-1471   var second-ah/eax: (addr handle cell) <- get right, left
-1472   var stream-storage: (stream byte 0x100)
-1473   var stream/edi: (addr stream byte) <- address stream-storage
-1474   print-cell second-ah, stream, trace
-1475   draw-stream-wrapping-right-then-down-from-cursor-over-full-screen screen, stream, 7/fg, 0/bg
-1476   # return what was printed
-1477   copy-object second-ah, out
-1478 }
-1479 
-1480 fn apply-clear _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1481   trace-text trace, "eval", "apply 'clear'"
-1482   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1483   var _args/eax: (addr cell) <- lookup *args-ah
-1484   var args/esi: (addr cell) <- copy _args
-1485   {
-1486     var args-type/ecx: (addr int) <- get args, type
-1487     compare *args-type, 0/pair
-1488     break-if-=
-1489     error trace, "args to 'clear' are not a list"
-1490     return
-1491   }
-1492   var empty-args?/eax: boolean <- nil? args
-1493   compare empty-args?, 0/false
-1494   {
-1495     break-if-=
-1496     error trace, "'clear' needs 1 arg but got 0"
-1497     return
-1498   }
-1499   # screen = args->left
-1500   var first-ah/eax: (addr handle cell) <- get args, left
-1501   var first/eax: (addr cell) <- lookup *first-ah
-1502   var first-type/ecx: (addr int) <- get first, type
-1503   compare *first-type, 5/screen
-1504   {
-1505     break-if-=
-1506     error trace, "first arg for 'clear' is not a screen"
-1507     return
-1508   }
-1509   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1510   var _screen/eax: (addr screen) <- lookup *screen-ah
-1511   var screen/ecx: (addr screen) <- copy _screen
-1512   #
-1513   clear-screen screen
-1514 }
-1515 
-1516 fn apply-up _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1517   trace-text trace, "eval", "apply 'up'"
-1518   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1519   var _args/eax: (addr cell) <- lookup *args-ah
-1520   var args/esi: (addr cell) <- copy _args
-1521   {
-1522     var args-type/ecx: (addr int) <- get args, type
-1523     compare *args-type, 0/pair
-1524     break-if-=
-1525     error trace, "args to 'up' are not a list"
-1526     return
-1527   }
-1528   var empty-args?/eax: boolean <- nil? args
-1529   compare empty-args?, 0/false
-1530   {
-1531     break-if-=
-1532     error trace, "'up' needs 1 arg but got 0"
-1533     return
-1534   }
-1535   # screen = args->left
-1536   var first-ah/eax: (addr handle cell) <- get args, left
-1537   var first/eax: (addr cell) <- lookup *first-ah
-1538   var first-type/ecx: (addr int) <- get first, type
-1539   compare *first-type, 5/screen
-1540   {
-1541     break-if-=
-1542     error trace, "first arg for 'up' is not a screen"
-1543     return
-1544   }
-1545   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1546   var _screen/eax: (addr screen) <- lookup *screen-ah
-1547   var screen/ecx: (addr screen) <- copy _screen
-1548   #
-1549   move-cursor-up screen
-1550 }
-1551 
-1552 fn apply-down _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1553   trace-text trace, "eval", "apply 'down'"
-1554   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1555   var _args/eax: (addr cell) <- lookup *args-ah
-1556   var args/esi: (addr cell) <- copy _args
-1557   {
-1558     var args-type/ecx: (addr int) <- get args, type
-1559     compare *args-type, 0/pair
-1560     break-if-=
-1561     error trace, "args to 'down' are not a list"
-1562     return
-1563   }
-1564   var empty-args?/eax: boolean <- nil? args
-1565   compare empty-args?, 0/false
-1566   {
-1567     break-if-=
-1568     error trace, "'down' needs 1 arg but got 0"
-1569     return
-1570   }
-1571   # screen = args->left
-1572   var first-ah/eax: (addr handle cell) <- get args, left
-1573   var first/eax: (addr cell) <- lookup *first-ah
-1574   var first-type/ecx: (addr int) <- get first, type
-1575   compare *first-type, 5/screen
-1576   {
-1577     break-if-=
-1578     error trace, "first arg for 'down' is not a screen"
-1579     return
-1580   }
-1581   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1582   var _screen/eax: (addr screen) <- lookup *screen-ah
-1583   var screen/ecx: (addr screen) <- copy _screen
-1584   #
-1585   move-cursor-down screen
-1586 }
-1587 
-1588 fn apply-left _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1589   trace-text trace, "eval", "apply 'left'"
-1590   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1591   var _args/eax: (addr cell) <- lookup *args-ah
-1592   var args/esi: (addr cell) <- copy _args
-1593   {
-1594     var args-type/ecx: (addr int) <- get args, type
-1595     compare *args-type, 0/pair
-1596     break-if-=
-1597     error trace, "args to 'left' are not a list"
-1598     return
-1599   }
-1600   var empty-args?/eax: boolean <- nil? args
-1601   compare empty-args?, 0/false
-1602   {
-1603     break-if-=
-1604     error trace, "'left' needs 1 arg but got 0"
-1605     return
-1606   }
-1607   # screen = args->left
-1608   var first-ah/eax: (addr handle cell) <- get args, left
-1609   var first/eax: (addr cell) <- lookup *first-ah
-1610   var first-type/ecx: (addr int) <- get first, type
-1611   compare *first-type, 5/screen
-1612   {
-1613     break-if-=
-1614     error trace, "first arg for 'left' is not a screen"
-1615     return
-1616   }
-1617   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1618   var _screen/eax: (addr screen) <- lookup *screen-ah
-1619   var screen/ecx: (addr screen) <- copy _screen
-1620   #
-1621   move-cursor-left screen
-1622 }
-1623 
-1624 fn apply-right _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1625   trace-text trace, "eval", "apply 'right'"
-1626   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1627   var _args/eax: (addr cell) <- lookup *args-ah
-1628   var args/esi: (addr cell) <- copy _args
-1629   {
-1630     var args-type/ecx: (addr int) <- get args, type
-1631     compare *args-type, 0/pair
-1632     break-if-=
-1633     error trace, "args to 'right' are not a list"
-1634     return
-1635   }
-1636   var empty-args?/eax: boolean <- nil? args
-1637   compare empty-args?, 0/false
-1638   {
-1639     break-if-=
-1640     error trace, "'right' needs 1 arg but got 0"
-1641     return
-1642   }
-1643   # screen = args->left
-1644   var first-ah/eax: (addr handle cell) <- get args, left
-1645   var first/eax: (addr cell) <- lookup *first-ah
-1646   var first-type/ecx: (addr int) <- get first, type
-1647   compare *first-type, 5/screen
-1648   {
-1649     break-if-=
-1650     error trace, "first arg for 'right' is not a screen"
-1651     return
-1652   }
-1653   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1654   var _screen/eax: (addr screen) <- lookup *screen-ah
-1655   var screen/ecx: (addr screen) <- copy _screen
-1656   #
-1657   move-cursor-right screen
-1658 }
-1659 
-1660 fn apply-cr _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1661   trace-text trace, "eval", "apply 'cr'"
-1662   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1663   var _args/eax: (addr cell) <- lookup *args-ah
-1664   var args/esi: (addr cell) <- copy _args
-1665   {
-1666     var args-type/ecx: (addr int) <- get args, type
-1667     compare *args-type, 0/pair
-1668     break-if-=
-1669     error trace, "args to 'cr' are not a list"
-1670     return
-1671   }
-1672   var empty-args?/eax: boolean <- nil? args
-1673   compare empty-args?, 0/false
-1674   {
-1675     break-if-=
-1676     error trace, "'cr' needs 1 arg but got 0"
-1677     return
-1678   }
-1679   # screen = args->left
-1680   var first-ah/eax: (addr handle cell) <- get args, left
-1681   var first/eax: (addr cell) <- lookup *first-ah
-1682   var first-type/ecx: (addr int) <- get first, type
-1683   compare *first-type, 5/screen
-1684   {
-1685     break-if-=
-1686     error trace, "first arg for 'cr' is not a screen"
-1687     return
-1688   }
-1689   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1690   var _screen/eax: (addr screen) <- lookup *screen-ah
-1691   var screen/ecx: (addr screen) <- copy _screen
-1692   #
-1693   move-cursor-to-left-margin-of-next-line screen
-1694 }
-1695 
-1696 fn apply-pixel _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1697   trace-text trace, "eval", "apply 'pixel'"
-1698   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1699   var _args/eax: (addr cell) <- lookup *args-ah
-1700   var args/esi: (addr cell) <- copy _args
-1701   {
-1702     var args-type/ecx: (addr int) <- get args, type
-1703     compare *args-type, 0/pair
-1704     break-if-=
-1705     error trace, "args to 'pixel' are not a list"
-1706     return
-1707   }
-1708   var empty-args?/eax: boolean <- nil? args
-1709   compare empty-args?, 0/false
-1710   {
-1711     break-if-=
-1712     error trace, "'pixel' needs 4 args but got 0"
-1713     return
-1714   }
-1715   # screen = args->left
-1716   var first-ah/eax: (addr handle cell) <- get args, left
-1717   var first/eax: (addr cell) <- lookup *first-ah
-1718   var first-type/ecx: (addr int) <- get first, type
-1719   compare *first-type, 5/screen
-1720   {
-1721     break-if-=
-1722     error trace, "first arg for 'pixel' is not a screen"
-1723     return
-1724   }
-1725   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1726   var _screen/eax: (addr screen) <- lookup *screen-ah
-1727   var screen/edi: (addr screen) <- copy _screen
-1728   # x = args->right->left->value
-1729   var rest-ah/eax: (addr handle cell) <- get args, right
-1730   var _rest/eax: (addr cell) <- lookup *rest-ah
-1731   var rest/esi: (addr cell) <- copy _rest
-1732   {
-1733     var rest-type/ecx: (addr int) <- get rest, type
-1734     compare *rest-type, 0/pair
-1735     break-if-=
-1736     error trace, "'pixel' encountered non-pair"
-1737     return
-1738   }
-1739   {
-1740     var rest-nil?/eax: boolean <- nil? rest
-1741     compare rest-nil?, 0/false
-1742     break-if-=
-1743     error trace, "'pixel' needs 4 args but got 1"
-1744     return
-1745   }
-1746   var second-ah/eax: (addr handle cell) <- get rest, left
-1747   var second/eax: (addr cell) <- lookup *second-ah
-1748   var second-type/ecx: (addr int) <- get second, type
-1749   compare *second-type, 1/number
-1750   {
-1751     break-if-=
-1752     error trace, "second arg for 'pixel' is not an int (x coordinate)"
-1753     return
-1754   }
-1755   var second-value/eax: (addr float) <- get second, number-data
-1756   var x/edx: int <- convert *second-value
-1757   # y = rest->right->left->value
-1758   var rest-ah/eax: (addr handle cell) <- get rest, right
-1759   var _rest/eax: (addr cell) <- lookup *rest-ah
-1760   rest <- copy _rest
-1761   {
-1762     var rest-type/ecx: (addr int) <- get rest, type
-1763     compare *rest-type, 0/pair
-1764     break-if-=
-1765     error trace, "'pixel' encountered non-pair"
-1766     return
-1767   }
-1768   {
-1769     var rest-nil?/eax: boolean <- nil? rest
-1770     compare rest-nil?, 0/false
-1771     break-if-=
-1772     error trace, "'pixel' needs 4 args but got 2"
-1773     return
-1774   }
-1775   var third-ah/eax: (addr handle cell) <- get rest, left
-1776   var third/eax: (addr cell) <- lookup *third-ah
-1777   var third-type/ecx: (addr int) <- get third, type
-1778   compare *third-type, 1/number
-1779   {
-1780     break-if-=
-1781     error trace, "third arg for 'pixel' is not an int (y coordinate)"
-1782     return
-1783   }
-1784   var third-value/eax: (addr float) <- get third, number-data
-1785   var y/ebx: int <- convert *third-value
-1786   # color = rest->right->left->value
-1787   var rest-ah/eax: (addr handle cell) <- get rest, right
-1788   var _rest/eax: (addr cell) <- lookup *rest-ah
-1789   rest <- copy _rest
-1790   {
-1791     var rest-type/ecx: (addr int) <- get rest, type
-1792     compare *rest-type, 0/pair
-1793     break-if-=
-1794     error trace, "'pixel' encountered non-pair"
-1795     return
-1796   }
-1797   {
-1798     var rest-nil?/eax: boolean <- nil? rest
-1799     compare rest-nil?, 0/false
-1800     break-if-=
-1801     error trace, "'pixel' needs 4 args but got 3"
-1802     return
-1803   }
-1804   var fourth-ah/eax: (addr handle cell) <- get rest, left
-1805   var fourth/eax: (addr cell) <- lookup *fourth-ah
-1806   var fourth-type/ecx: (addr int) <- get fourth, type
-1807   compare *fourth-type, 1/number
-1808   {
-1809     break-if-=
-1810     error trace, "fourth arg for 'pixel' is not an int (color; 0..0xff)"
-1811     return
-1812   }
-1813   var fourth-value/eax: (addr float) <- get fourth, number-data
-1814   var color/eax: int <- convert *fourth-value
-1815   pixel screen, x, y, color
-1816   # return nothing
-1817 }
-1818 
-1819 fn apply-wait-for-key _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1820   trace-text trace, "eval", "apply 'key'"
-1821   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1822   var _args/eax: (addr cell) <- lookup *args-ah
-1823   var args/esi: (addr cell) <- copy _args
-1824   {
-1825     var args-type/ecx: (addr int) <- get args, type
-1826     compare *args-type, 0/pair
-1827     break-if-=
-1828     error trace, "args to 'key' are not a list"
-1829     return
-1830   }
-1831   var empty-args?/eax: boolean <- nil? args
-1832   compare empty-args?, 0/false
-1833   {
-1834     break-if-=
-1835     error trace, "'key' needs 1 arg but got 0"
-1836     return
-1837   }
-1838   # keyboard = args->left
-1839   var first-ah/eax: (addr handle cell) <- get args, left
-1840   var first/eax: (addr cell) <- lookup *first-ah
-1841   var first-type/ecx: (addr int) <- get first, type
-1842   compare *first-type, 6/keyboard
-1843   {
-1844     break-if-=
-1845     error trace, "first arg for 'key' is not a keyboard"
-1846     return
-1847   }
-1848   var keyboard-ah/eax: (addr handle gap-buffer) <- get first, keyboard-data
-1849   var _keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
-1850   var keyboard/ecx: (addr gap-buffer) <- copy _keyboard
-1851   var result/eax: int <- wait-for-key keyboard
-1852   # return key typed
-1853   new-integer out, result
-1854 }
-1855 
-1856 fn wait-for-key keyboard: (addr gap-buffer) -> _/eax: int {
-1857   # if keyboard is 0, use real keyboard
-1858   {
-1859     compare keyboard, 0/real-keyboard
-1860     break-if-!=
-1861     var key/eax: byte <- read-key 0/real-keyboard
-1862     var result/eax: int <- copy key
-1863     return result
-1864   }
-1865   # otherwise read from fake keyboard
-1866   var g/eax: grapheme <- read-from-gap-buffer keyboard
-1867   var result/eax: int <- copy g
-1868   return result
-1869 }
-1870 
-1871 fn apply-stream _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1872   trace-text trace, "eval", "apply stream"
-1873   allocate-stream out
-1874 }
-1875 
-1876 fn apply-write _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1877   trace-text trace, "eval", "apply 'write'"
-1878   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1879   var _args/eax: (addr cell) <- lookup *args-ah
-1880   var args/esi: (addr cell) <- copy _args
-1881   {
-1882     var args-type/ecx: (addr int) <- get args, type
-1883     compare *args-type, 0/pair
-1884     break-if-=
-1885     error trace, "args to 'write' are not a list"
-1886     return
-1887   }
-1888   var empty-args?/eax: boolean <- nil? args
-1889   compare empty-args?, 0/false
-1890   {
-1891     break-if-=
-1892     error trace, "'write' needs 2 args but got 0"
-1893     return
-1894   }
-1895   # stream = args->left
-1896   var first-ah/edx: (addr handle cell) <- get args, left
-1897   var first/eax: (addr cell) <- lookup *first-ah
-1898   var first-type/ecx: (addr int) <- get first, type
-1899   compare *first-type, 3/stream
-1900   {
-1901     break-if-=
-1902     error trace, "first arg for 'write' is not a stream"
-1903     return
-1904   }
-1905   var stream-data-ah/eax: (addr handle stream byte) <- get first, text-data
-1906   var _stream-data/eax: (addr stream byte) <- lookup *stream-data-ah
-1907   var stream-data/ebx: (addr stream byte) <- copy _stream-data
-1908   # args->right->left
-1909   var right-ah/eax: (addr handle cell) <- get args, right
-1910   var right/eax: (addr cell) <- lookup *right-ah
-1911   {
-1912     var right-type/ecx: (addr int) <- get right, type
-1913     compare *right-type, 0/pair
-1914     break-if-=
-1915     error trace, "'write' encountered non-pair"
-1916     return
-1917   }
-1918   {
-1919     var nil?/eax: boolean <- nil? right
-1920     compare nil?, 0/false
-1921     break-if-=
-1922     error trace, "'write' needs 2 args but got 1"
-1923     return
-1924   }
-1925   var second-ah/eax: (addr handle cell) <- get right, left
-1926   var second/eax: (addr cell) <- lookup *second-ah
-1927   var second-type/ecx: (addr int) <- get second, type
-1928   compare *second-type, 1/number
-1929   {
-1930     break-if-=
-1931     error trace, "second arg for 'write' is not a number/grapheme"
-1932     return
-1933   }
-1934   var second-value/eax: (addr float) <- get second, number-data
-1935   var x-float/xmm0: float <- copy *second-value
-1936   var x/eax: int <- convert x-float
-1937   var x-grapheme/eax: grapheme <- copy x
-1938   write-grapheme stream-data, x-grapheme
-1939   # return the stream
-1940   copy-object first-ah, out
-1941 }
-1942 
-1943 fn apply-lines _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1944   trace-text trace, "eval", "apply 'lines'"
-1945   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1946   var _args/eax: (addr cell) <- lookup *args-ah
-1947   var args/esi: (addr cell) <- copy _args
-1948   {
-1949     var args-type/ecx: (addr int) <- get args, type
-1950     compare *args-type, 0/pair
-1951     break-if-=
-1952     error trace, "args to 'lines' are not a list"
-1953     return
-1954   }
-1955   var empty-args?/eax: boolean <- nil? args
-1956   compare empty-args?, 0/false
-1957   {
-1958     break-if-=
-1959     error trace, "'lines' needs 1 arg but got 0"
-1960     return
-1961   }
-1962   # screen = args->left
-1963   var first-ah/eax: (addr handle cell) <- get args, left
-1964   var first/eax: (addr cell) <- lookup *first-ah
-1965   var first-type/ecx: (addr int) <- get first, type
-1966   compare *first-type, 5/screen
-1967   {
-1968     break-if-=
-1969     error trace, "first arg for 'lines' is not a screen"
-1970     return
-1971   }
-1972   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1973   var _screen/eax: (addr screen) <- lookup *screen-ah
-1974   var screen/edx: (addr screen) <- copy _screen
-1975   # compute dimensions
-1976   var dummy/eax: int <- copy 0
-1977   var height/ecx: int <- copy 0
-1978   dummy, height <- screen-size screen
-1979   var result/xmm0: float <- convert height
-1980   new-float out, result
-1981 }
-1982 
-1983 fn apply-abort _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1984   abort "aa"
-1985 }
-1986 
-1987 fn apply-columns _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1988   trace-text trace, "eval", "apply 'columns'"
-1989   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1990   var _args/eax: (addr cell) <- lookup *args-ah
-1991   var args/esi: (addr cell) <- copy _args
-1992   {
-1993     var args-type/ecx: (addr int) <- get args, type
-1994     compare *args-type, 0/pair
-1995     break-if-=
-1996     error trace, "args to 'columns' are not a list"
-1997     return
-1998   }
-1999   var empty-args?/eax: boolean <- nil? args
-2000   compare empty-args?, 0/false
-2001   {
-2002     break-if-=
-2003     error trace, "'columns' needs 1 arg but got 0"
-2004     return
-2005   }
-2006   # screen = args->left
-2007   var first-ah/eax: (addr handle cell) <- get args, left
-2008   var first/eax: (addr cell) <- lookup *first-ah
-2009   var first-type/ecx: (addr int) <- get first, type
-2010   compare *first-type, 5/screen
-2011   {
-2012     break-if-=
-2013     error trace, "first arg for 'columns' is not a screen"
-2014     return
-2015   }
-2016   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-2017   var _screen/eax: (addr screen) <- lookup *screen-ah
-2018   var screen/edx: (addr screen) <- copy _screen
-2019   # compute dimensions
-2020   var width/eax: int <- copy 0
-2021   var dummy/ecx: int <- copy 0
-2022   width, dummy <- screen-size screen
-2023   var result/xmm0: float <- convert width
-2024   new-float out, result
-2025 }
-2026 
-2027 fn apply-width _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-2028   trace-text trace, "eval", "apply 'width'"
-2029   var args-ah/eax: (addr handle cell) <- copy _args-ah
-2030   var _args/eax: (addr cell) <- lookup *args-ah
-2031   var args/esi: (addr cell) <- copy _args
-2032   {
-2033     var args-type/ecx: (addr int) <- get args, type
-2034     compare *args-type, 0/pair
-2035     break-if-=
-2036     error trace, "args to 'width' are not a list"
-2037     return
-2038   }
-2039   var empty-args?/eax: boolean <- nil? args
-2040   compare empty-args?, 0/false
-2041   {
-2042     break-if-=
-2043     error trace, "'width' needs 1 arg but got 0"
-2044     return
-2045   }
-2046   # screen = args->left
-2047   var first-ah/eax: (addr handle cell) <- get args, left
-2048   var first/eax: (addr cell) <- lookup *first-ah
-2049   var first-type/ecx: (addr int) <- get first, type
-2050   compare *first-type, 5/screen
-2051   {
-2052     break-if-=
-2053     error trace, "first arg for 'width' is not a screen"
-2054     return
-2055   }
-2056   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-2057   var _screen/eax: (addr screen) <- lookup *screen-ah
-2058   var screen/edx: (addr screen) <- copy _screen
-2059   # compute dimensions
-2060   var width/eax: int <- copy 0
-2061   var dummy/ecx: int <- copy 0
-2062   width, dummy <- screen-size screen
-2063   width <- shift-left 3/log2-font-width
-2064   var result/xmm0: float <- convert width
-2065   new-float out, result
-2066 }
-2067 
-2068 fn apply-height _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-2069   trace-text trace, "eval", "apply 'height'"
-2070   var args-ah/eax: (addr handle cell) <- copy _args-ah
-2071   var _args/eax: (addr cell) <- lookup *args-ah
-2072   var args/esi: (addr cell) <- copy _args
-2073   {
-2074     var args-type/ecx: (addr int) <- get args, type
-2075     compare *args-type, 0/pair
-2076     break-if-=
-2077     error trace, "args to 'height' are not a list"
-2078     return
-2079   }
-2080   var empty-args?/eax: boolean <- nil? args
-2081   compare empty-args?, 0/false
-2082   {
-2083     break-if-=
-2084     error trace, "'height' needs 1 arg but got 0"
-2085     return
-2086   }
-2087   # screen = args->left
-2088   var first-ah/eax: (addr handle cell) <- get args, left
-2089   var first/eax: (addr cell) <- lookup *first-ah
-2090   var first-type/ecx: (addr int) <- get first, type
-2091   compare *first-type, 5/screen
-2092   {
-2093     break-if-=
-2094     error trace, "first arg for 'height' is not a screen"
-2095     return
-2096   }
-2097   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-2098   var _screen/eax: (addr screen) <- lookup *screen-ah
-2099   var screen/edx: (addr screen) <- copy _screen
-2100   # compute dimensions
-2101   var dummy/eax: int <- copy 0
-2102   var height/ecx: int <- copy 0
-2103   dummy, height <- screen-size screen
-2104   height <- shift-left 4/log2-font-height
-2105   var result/xmm0: float <- convert height
-2106   new-float out, result
-2107 }
+  17   append-primitive self, "apply"
+  18   append-primitive self, "="
+  19   append-primitive self, "no"
+  20   append-primitive self, "not"
+  21   append-primitive self, "dbg"
+  22   # for pairs
+  23   append-primitive self, "car"
+  24   append-primitive self, "cdr"
+  25   append-primitive self, "cons"
+  26   # for screens
+  27   append-primitive self, "print"
+  28   append-primitive self, "clear"
+  29   append-primitive self, "lines"
+  30   append-primitive self, "columns"
+  31   append-primitive self, "up"
+  32   append-primitive self, "down"
+  33   append-primitive self, "left"
+  34   append-primitive self, "right"
+  35   append-primitive self, "cr"
+  36   append-primitive self, "pixel"
+  37   append-primitive self, "width"
+  38   append-primitive self, "height"
+  39   # for keyboards
+  40   append-primitive self, "key"
+  41   # for streams
+  42   append-primitive self, "stream"
+  43   append-primitive self, "write"
+  44   # misc
+  45   append-primitive self, "abort"
+  46   # keep sync'd with render-primitives
+  47 }
+  48 
+  49 fn render-primitives screen: (addr screen), xmin: int, xmax: int, ymax: int {
+  50   var y/ecx: int <- copy ymax
+  51   y <- subtract 0x10
+  52   clear-rect screen, xmin, y, xmax, ymax, 0xdc/bg=green-bg
+  53   y <- increment
+  54   var tmpx/eax: int <- copy xmin
+  55   tmpx <- draw-text-rightward screen, "cursor graphics", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+  56   y <- increment
+  57   var tmpx/eax: int <- copy xmin
+  58   tmpx <- draw-text-rightward screen, "  print", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+  59   tmpx <- draw-text-rightward screen, ": screen a -> a", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+  60   y <- increment
+  61   var tmpx/eax: int <- copy xmin
+  62   tmpx <- draw-text-rightward screen, "  lines columns", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+  63   tmpx <- draw-text-rightward screen, ": screen -> number", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+  64   y <- increment
+  65   var tmpx/eax: int <- copy xmin
+  66   tmpx <- draw-text-rightward screen, "  up down left right", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+  67   tmpx <- draw-text-rightward screen, ": screen", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+  68   y <- increment
+  69   var tmpx/eax: int <- copy xmin
+  70   tmpx <- draw-text-rightward screen, "  cr", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+  71   tmpx <- draw-text-rightward screen, ": screen   ", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+  72   tmpx <- draw-text-rightward screen, "# move cursor down and to left margin", tmpx, xmax, y, 0x38/fg=trace, 0xdc/bg=green-bg
+  73   y <- increment
+  74   var tmpx/eax: int <- copy xmin
+  75   tmpx <- draw-text-rightward screen, "pixel graphics", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+  76   y <- increment
+  77   var tmpx/eax: int <- copy xmin
+  78   tmpx <- draw-text-rightward screen, "  width height", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+  79   tmpx <- draw-text-rightward screen, ": screen -> number", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+  80   y <- increment
+  81   var tmpx/eax: int <- copy xmin
+  82   tmpx <- draw-text-rightward screen, "  pixel", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+  83   tmpx <- draw-text-rightward screen, ": screen x y color", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+  84   y <- increment
+  85   var tmpx/eax: int <- copy xmin
+  86   tmpx <- draw-text-rightward screen, "screen/keyboard", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+  87   y <- increment
+  88   var tmpx/eax: int <- copy xmin
+  89   tmpx <- draw-text-rightward screen, "  clear", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+  90   tmpx <- draw-text-rightward screen, ": screen", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+  91   y <- increment
+  92   var tmpx/eax: int <- copy xmin
+  93   tmpx <- draw-text-rightward screen, "  key", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+  94   tmpx <- draw-text-rightward screen, ": () -> grapheme?", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+  95   y <- increment
+  96   var tmpx/eax: int <- copy xmin
+  97   tmpx <- draw-text-rightward screen, "streams", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+  98   y <- increment
+  99   var tmpx/eax: int <- copy xmin
+ 100   tmpx <- draw-text-rightward screen, "  stream", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+ 101   tmpx <- draw-text-rightward screen, ": () -> stream ", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+ 102   y <- increment
+ 103   var tmpx/eax: int <- copy xmin
+ 104   tmpx <- draw-text-rightward screen, "  write", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+ 105   tmpx <- draw-text-rightward screen, ": stream grapheme -> stream", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+ 106   y <- increment
+ 107   var tmpx/eax: int <- copy xmin
+ 108   tmpx <- draw-text-rightward screen, "fn apply set if while cons car cdr no not and or = ", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+ 109   # numbers
+ 110   tmpx <- draw-text-rightward screen, "< > <= >= + - * / % sqrt abs sgn", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+ 111 }
+ 112 
+ 113 fn primitive-global? _x: (addr global) -> _/eax: boolean {
+ 114   var x/eax: (addr global) <- copy _x
+ 115   var value-ah/eax: (addr handle cell) <- get x, value
+ 116   var value/eax: (addr cell) <- lookup *value-ah
+ 117   compare value, 0/null
+ 118   {
+ 119     break-if-!=
+ 120     return 0/false
+ 121   }
+ 122   var value-type/eax: (addr int) <- get value, type
+ 123   compare *value-type, 4/primitive
+ 124   {
+ 125     break-if-=
+ 126     return 0/false
+ 127   }
+ 128   return 1/true
+ 129 }
+ 130 
+ 131 fn append-primitive _self: (addr global-table), name: (addr array byte) {
+ 132   var self/esi: (addr global-table) <- copy _self
+ 133   compare self, 0
+ 134   {
+ 135     break-if-!=
+ 136     abort "append primitive"
+ 137     return
+ 138   }
+ 139   var final-index-addr/ecx: (addr int) <- get self, final-index
+ 140   increment *final-index-addr
+ 141   var curr-index/ecx: int <- copy *final-index-addr
+ 142   var data-ah/eax: (addr handle array global) <- get self, data
+ 143   var data/eax: (addr array global) <- lookup *data-ah
+ 144   var curr-offset/esi: (offset global) <- compute-offset data, curr-index
+ 145   var curr/esi: (addr global) <- index data, curr-offset
+ 146   var curr-name-ah/eax: (addr handle array byte) <- get curr, name
+ 147   copy-array-object name, curr-name-ah
+ 148   var curr-value-ah/eax: (addr handle cell) <- get curr, value
+ 149   new-primitive-function curr-value-ah, curr-index
+ 150 }
+ 151 
+ 152 # a little strange; goes from value to name and selects primitive based on name
+ 153 fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr handle cell), _globals: (addr global-table), trace: (addr trace) {
+ 154   var f/esi: (addr cell) <- copy _f
+ 155   var f-index-a/ecx: (addr int) <- get f, index-data
+ 156   var f-index/ecx: int <- copy *f-index-a
+ 157   var globals/eax: (addr global-table) <- copy _globals
+ 158   compare globals, 0
+ 159   {
+ 160     break-if-!=
+ 161     abort "apply primitive"
+ 162     return
+ 163   }
+ 164   var global-data-ah/eax: (addr handle array global) <- get globals, data
+ 165   var global-data/eax: (addr array global) <- lookup *global-data-ah
+ 166   var f-offset/ecx: (offset global) <- compute-offset global-data, f-index
+ 167   var f-value/ecx: (addr global) <- index global-data, f-offset
+ 168   var f-name-ah/ecx: (addr handle array byte) <- get f-value, name
+ 169   var f-name/eax: (addr array byte) <- lookup *f-name-ah
+ 170   {
+ 171     var add?/eax: boolean <- string-equal? f-name, "+"
+ 172     compare add?, 0/false
+ 173     break-if-=
+ 174     apply-add args-ah, out, trace
+ 175     return
+ 176   }
+ 177   {
+ 178     var subtract?/eax: boolean <- string-equal? f-name, "-"
+ 179     compare subtract?, 0/false
+ 180     break-if-=
+ 181     apply-subtract args-ah, out, trace
+ 182     return
+ 183   }
+ 184   {
+ 185     var multiply?/eax: boolean <- string-equal? f-name, "*"
+ 186     compare multiply?, 0/false
+ 187     break-if-=
+ 188     apply-multiply args-ah, out, trace
+ 189     return
+ 190   }
+ 191   {
+ 192     var divide?/eax: boolean <- string-equal? f-name, "/"
+ 193     compare divide?, 0/false
+ 194     break-if-=
+ 195     apply-divide args-ah, out, trace
+ 196     return
+ 197   }
+ 198   # '%' is the remainder operator, because modulo isn't really meaningful for
+ 199   # non-integers
+ 200   #
+ 201   # I considered calling this operator 'rem', but I want to follow Arc in
+ 202   # using 'rem' for filtering out elements from lists.
+ 203   #   https://arclanguage.github.io/ref/list.html#rem
+ 204   {
+ 205     var remainder?/eax: boolean <- string-equal? f-name, "%"
+ 206     compare remainder?, 0/false
+ 207     break-if-=
+ 208     apply-remainder args-ah, out, trace
+ 209     return
+ 210   }
+ 211   {
+ 212     var square-root?/eax: boolean <- string-equal? f-name, "sqrt"
+ 213     compare square-root?, 0/false
+ 214     break-if-=
+ 215     apply-square-root args-ah, out, trace
+ 216     return
+ 217   }
+ 218   {
+ 219     var abs?/eax: boolean <- string-equal? f-name, "abs"
+ 220     compare abs?, 0/false
+ 221     break-if-=
+ 222     apply-abs args-ah, out, trace
+ 223     return
+ 224   }
+ 225   {
+ 226     var sgn?/eax: boolean <- string-equal? f-name, "sgn"
+ 227     compare sgn?, 0/false
+ 228     break-if-=
+ 229     apply-sgn args-ah, out, trace
+ 230     return
+ 231   }
+ 232   {
+ 233     var car?/eax: boolean <- string-equal? f-name, "car"
+ 234     compare car?, 0/false
+ 235     break-if-=
+ 236     apply-car args-ah, out, trace
+ 237     return
+ 238   }
+ 239   {
+ 240     var cdr?/eax: boolean <- string-equal? f-name, "cdr"
+ 241     compare cdr?, 0/false
+ 242     break-if-=
+ 243     apply-cdr args-ah, out, trace
+ 244     return
+ 245   }
+ 246   {
+ 247     var cons?/eax: boolean <- string-equal? f-name, "cons"
+ 248     compare cons?, 0/false
+ 249     break-if-=
+ 250     apply-cons args-ah, out, trace
+ 251     return
+ 252   }
+ 253   {
+ 254     var structurally-equal?/eax: boolean <- string-equal? f-name, "="
+ 255     compare structurally-equal?, 0/false
+ 256     break-if-=
+ 257     apply-structurally-equal args-ah, out, trace
+ 258     return
+ 259   }
+ 260   {
+ 261     var not?/eax: boolean <- string-equal? f-name, "no"
+ 262     compare not?, 0/false
+ 263     break-if-=
+ 264     apply-not args-ah, out, trace
+ 265     return
+ 266   }
+ 267   {
+ 268     var not?/eax: boolean <- string-equal? f-name, "not"
+ 269     compare not?, 0/false
+ 270     break-if-=
+ 271     apply-not args-ah, out, trace
+ 272     return
+ 273   }
+ 274   {
+ 275     var debug?/eax: boolean <- string-equal? f-name, "dbg"
+ 276     compare debug?, 0/false
+ 277     break-if-=
+ 278     apply-debug args-ah, out, trace
+ 279     return
+ 280   }
+ 281   {
+ 282     var lesser?/eax: boolean <- string-equal? f-name, "<"
+ 283     compare lesser?, 0/false
+ 284     break-if-=
+ 285     apply-< args-ah, out, trace
+ 286     return
+ 287   }
+ 288   {
+ 289     var greater?/eax: boolean <- string-equal? f-name, ">"
+ 290     compare greater?, 0/false
+ 291     break-if-=
+ 292     apply-> args-ah, out, trace
+ 293     return
+ 294   }
+ 295   {
+ 296     var lesser-or-equal?/eax: boolean <- string-equal? f-name, "<="
+ 297     compare lesser-or-equal?, 0/false
+ 298     break-if-=
+ 299     apply-<= args-ah, out, trace
+ 300     return
+ 301   }
+ 302   {
+ 303     var greater-or-equal?/eax: boolean <- string-equal? f-name, ">="
+ 304     compare greater-or-equal?, 0/false
+ 305     break-if-=
+ 306     apply->= args-ah, out, trace
+ 307     return
+ 308   }
+ 309   {
+ 310     var print?/eax: boolean <- string-equal? f-name, "print"
+ 311     compare print?, 0/false
+ 312     break-if-=
+ 313     apply-print args-ah, out, trace
+ 314     return
+ 315   }
+ 316   {
+ 317     var clear?/eax: boolean <- string-equal? f-name, "clear"
+ 318     compare clear?, 0/false
+ 319     break-if-=
+ 320     apply-clear args-ah, out, trace
+ 321     return
+ 322   }
+ 323   {
+ 324     var lines?/eax: boolean <- string-equal? f-name, "lines"
+ 325     compare lines?, 0/false
+ 326     break-if-=
+ 327     apply-lines args-ah, out, trace
+ 328     return
+ 329   }
+ 330   {
+ 331     var columns?/eax: boolean <- string-equal? f-name, "columns"
+ 332     compare columns?, 0/false
+ 333     break-if-=
+ 334     apply-columns args-ah, out, trace
+ 335     return
+ 336   }
+ 337   {
+ 338     var up?/eax: boolean <- string-equal? f-name, "up"
+ 339     compare up?, 0/false
+ 340     break-if-=
+ 341     apply-up args-ah, out, trace
+ 342     return
+ 343   }
+ 344   {
+ 345     var down?/eax: boolean <- string-equal? f-name, "down"
+ 346     compare down?, 0/false
+ 347     break-if-=
+ 348     apply-down args-ah, out, trace
+ 349     return
+ 350   }
+ 351   {
+ 352     var left?/eax: boolean <- string-equal? f-name, "left"
+ 353     compare left?, 0/false
+ 354     break-if-=
+ 355     apply-left args-ah, out, trace
+ 356     return
+ 357   }
+ 358   {
+ 359     var right?/eax: boolean <- string-equal? f-name, "right"
+ 360     compare right?, 0/false
+ 361     break-if-=
+ 362     apply-right args-ah, out, trace
+ 363     return
+ 364   }
+ 365   {
+ 366     var cr?/eax: boolean <- string-equal? f-name, "cr"
+ 367     compare cr?, 0/false
+ 368     break-if-=
+ 369     apply-cr args-ah, out, trace
+ 370     return
+ 371   }
+ 372   {
+ 373     var pixel?/eax: boolean <- string-equal? f-name, "pixel"
+ 374     compare pixel?, 0/false
+ 375     break-if-=
+ 376     apply-pixel args-ah, out, trace
+ 377     return
+ 378   }
+ 379   {
+ 380     var width?/eax: boolean <- string-equal? f-name, "width"
+ 381     compare width?, 0/false
+ 382     break-if-=
+ 383     apply-width args-ah, out, trace
+ 384     return
+ 385   }
+ 386   {
+ 387     var height?/eax: boolean <- string-equal? f-name, "height"
+ 388     compare height?, 0/false
+ 389     break-if-=
+ 390     apply-height args-ah, out, trace
+ 391     return
+ 392   }
+ 393   {
+ 394     var wait-for-key?/eax: boolean <- string-equal? f-name, "key"
+ 395     compare wait-for-key?, 0/false
+ 396     break-if-=
+ 397     apply-wait-for-key args-ah, out, trace
+ 398     return
+ 399   }
+ 400   {
+ 401     var stream?/eax: boolean <- string-equal? f-name, "stream"
+ 402     compare stream?, 0/false
+ 403     break-if-=
+ 404     apply-stream args-ah, out, trace
+ 405     return
+ 406   }
+ 407   {
+ 408     var write?/eax: boolean <- string-equal? f-name, "write"
+ 409     compare write?, 0/false
+ 410     break-if-=
+ 411     apply-write args-ah, out, trace
+ 412     return
+ 413   }
+ 414   {
+ 415     var abort?/eax: boolean <- string-equal? f-name, "abort"
+ 416     compare abort?, 0/false
+ 417     break-if-=
+ 418     apply-abort args-ah, out, trace
+ 419     return
+ 420   }
+ 421   abort "unknown primitive function"
+ 422 }
+ 423 
+ 424 fn apply-add _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+ 425   trace-text trace, "eval", "apply +"
+ 426   var args-ah/eax: (addr handle cell) <- copy _args-ah
+ 427   var _args/eax: (addr cell) <- lookup *args-ah
+ 428   var args/esi: (addr cell) <- copy _args
+ 429   {
+ 430     var args-type/ecx: (addr int) <- get args, type
+ 431     compare *args-type, 0/pair
+ 432     break-if-=
+ 433     error trace, "args to + are not a list"
+ 434     return
+ 435   }
+ 436   var empty-args?/eax: boolean <- nil? args
+ 437   compare empty-args?, 0/false
+ 438   {
+ 439     break-if-=
+ 440     error trace, "+ needs 2 args but got 0"
+ 441     return
+ 442   }
+ 443   # args->left->value
+ 444   var first-ah/eax: (addr handle cell) <- get args, left
+ 445   var first/eax: (addr cell) <- lookup *first-ah
+ 446   var first-type/ecx: (addr int) <- get first, type
+ 447   compare *first-type, 1/number
+ 448   {
+ 449     break-if-=
+ 450     error trace, "first arg for + is not a number"
+ 451     return
+ 452   }
+ 453   var first-value/ecx: (addr float) <- get first, number-data
+ 454   # args->right->left->value
+ 455   var right-ah/eax: (addr handle cell) <- get args, right
+ 456   var right/eax: (addr cell) <- lookup *right-ah
+ 457   {
+ 458     var right-type/ecx: (addr int) <- get right, type
+ 459     compare *right-type, 0/pair
+ 460     break-if-=
+ 461     error trace, "+ encountered non-pair"
+ 462     return
+ 463   }
+ 464   {
+ 465     var nil?/eax: boolean <- nil? right
+ 466     compare nil?, 0/false
+ 467     break-if-=
+ 468     error trace, "+ needs 2 args but got 1"
+ 469     return
+ 470   }
+ 471   var second-ah/eax: (addr handle cell) <- get right, left
+ 472   var second/eax: (addr cell) <- lookup *second-ah
+ 473   var second-type/edx: (addr int) <- get second, type
+ 474   compare *second-type, 1/number
+ 475   {
+ 476     break-if-=
+ 477     error trace, "second arg for + is not a number"
+ 478     return
+ 479   }
+ 480   var second-value/edx: (addr float) <- get second, number-data
+ 481   # add
+ 482   var result/xmm0: float <- copy *first-value
+ 483   result <- add *second-value
+ 484   new-float out, result
+ 485 }
+ 486 
+ 487 fn test-evaluate-missing-arg-in-add {
+ 488   var t-storage: trace
+ 489   var t/edi: (addr trace) <- address t-storage
+ 490   initialize-trace t, 0x100/max-depth, 0x100/capacity, 0/visible  # we don't use trace UI
+ 491   #
+ 492   var nil-storage: (handle cell)
+ 493   var nil-ah/ecx: (addr handle cell) <- address nil-storage
+ 494   allocate-pair nil-ah
+ 495   var one-storage: (handle cell)
+ 496   var one-ah/edx: (addr handle cell) <- address one-storage
+ 497   new-integer one-ah, 1
+ 498   var add-storage: (handle cell)
+ 499   var add-ah/ebx: (addr handle cell) <- address add-storage
+ 500   new-symbol add-ah, "+"
+ 501   # input is (+ 1)
+ 502   var tmp-storage: (handle cell)
+ 503   var tmp-ah/esi: (addr handle cell) <- address tmp-storage
+ 504   new-pair tmp-ah, *one-ah, *nil-ah
+ 505   new-pair tmp-ah, *add-ah, *tmp-ah
+ 506 #?   dump-cell tmp-ah
+ 507   #
+ 508   var globals-storage: global-table
+ 509   var globals/edx: (addr global-table) <- address globals-storage
+ 510   initialize-globals globals
+ 511   #
+ 512   evaluate tmp-ah, tmp-ah, *nil-ah, globals, t, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number
+ 513   # no crash
+ 514 }
+ 515 
+ 516 fn apply-subtract _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+ 517   trace-text trace, "eval", "apply -"
+ 518   var args-ah/eax: (addr handle cell) <- copy _args-ah
+ 519   var _args/eax: (addr cell) <- lookup *args-ah
+ 520   var args/esi: (addr cell) <- copy _args
+ 521   {
+ 522     var args-type/ecx: (addr int) <- get args, type
+ 523     compare *args-type, 0/pair
+ 524     break-if-=
+ 525     error trace, "args to - are not a list"
+ 526     return
+ 527   }
+ 528   var empty-args?/eax: boolean <- nil? args
+ 529   compare empty-args?, 0/false
+ 530   {
+ 531     break-if-=
+ 532     error trace, "- needs 2 args but got 0"
+ 533     return
+ 534   }
+ 535   # args->left->value
+ 536   var first-ah/eax: (addr handle cell) <- get args, left
+ 537   var first/eax: (addr cell) <- lookup *first-ah
+ 538   var first-type/ecx: (addr int) <- get first, type
+ 539   compare *first-type, 1/number
+ 540   {
+ 541     break-if-=
+ 542     error trace, "first arg for - is not a number"
+ 543     return
+ 544   }
+ 545   var first-value/ecx: (addr float) <- get first, number-data
+ 546   # args->right->left->value
+ 547   var right-ah/eax: (addr handle cell) <- get args, right
+ 548   var right/eax: (addr cell) <- lookup *right-ah
+ 549   {
+ 550     var right-type/ecx: (addr int) <- get right, type
+ 551     compare *right-type, 0/pair
+ 552     break-if-=
+ 553     error trace, "- encountered non-pair"
+ 554     return
+ 555   }
+ 556   {
+ 557     var nil?/eax: boolean <- nil? right
+ 558     compare nil?, 0/false
+ 559     break-if-=
+ 560     error trace, "- needs 2 args but got 1"
+ 561     return
+ 562   }
+ 563   var second-ah/eax: (addr handle cell) <- get right, left
+ 564   var second/eax: (addr cell) <- lookup *second-ah
+ 565   var second-type/edx: (addr int) <- get second, type
+ 566   compare *second-type, 1/number
+ 567   {
+ 568     break-if-=
+ 569     error trace, "second arg for - is not a number"
+ 570     return
+ 571   }
+ 572   var second-value/edx: (addr float) <- get second, number-data
+ 573   # subtract
+ 574   var result/xmm0: float <- copy *first-value
+ 575   result <- subtract *second-value
+ 576   new-float out, result
+ 577 }
+ 578 
+ 579 fn apply-multiply _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+ 580   trace-text trace, "eval", "apply *"
+ 581   var args-ah/eax: (addr handle cell) <- copy _args-ah
+ 582   var _args/eax: (addr cell) <- lookup *args-ah
+ 583   var args/esi: (addr cell) <- copy _args
+ 584   {
+ 585     var args-type/ecx: (addr int) <- get args, type
+ 586     compare *args-type, 0/pair
+ 587     break-if-=
+ 588     error trace, "args to * are not a list"
+ 589     return
+ 590   }
+ 591   var empty-args?/eax: boolean <- nil? args
+ 592   compare empty-args?, 0/false
+ 593   {
+ 594     break-if-=
+ 595     error trace, "* needs 2 args but got 0"
+ 596     return
+ 597   }
+ 598   # args->left->value
+ 599   var first-ah/eax: (addr handle cell) <- get args, left
+ 600   var first/eax: (addr cell) <- lookup *first-ah
+ 601   var first-type/ecx: (addr int) <- get first, type
+ 602   compare *first-type, 1/number
+ 603   {
+ 604     break-if-=
+ 605     error trace, "first arg for * is not a number"
+ 606     return
+ 607   }
+ 608   var first-value/ecx: (addr float) <- get first, number-data
+ 609   # args->right->left->value
+ 610   var right-ah/eax: (addr handle cell) <- get args, right
+ 611   var right/eax: (addr cell) <- lookup *right-ah
+ 612   {
+ 613     var right-type/ecx: (addr int) <- get right, type
+ 614     compare *right-type, 0/pair
+ 615     break-if-=
+ 616     error trace, "* encountered non-pair"
+ 617     return
+ 618   }
+ 619   {
+ 620     var nil?/eax: boolean <- nil? right
+ 621     compare nil?, 0/false
+ 622     break-if-=
+ 623     error trace, "* needs 2 args but got 1"
+ 624     return
+ 625   }
+ 626   var second-ah/eax: (addr handle cell) <- get right, left
+ 627   var second/eax: (addr cell) <- lookup *second-ah
+ 628   var second-type/edx: (addr int) <- get second, type
+ 629   compare *second-type, 1/number
+ 630   {
+ 631     break-if-=
+ 632     error trace, "second arg for * is not a number"
+ 633     return
+ 634   }
+ 635   var second-value/edx: (addr float) <- get second, number-data
+ 636   # multiply
+ 637   var result/xmm0: float <- copy *first-value
+ 638   result <- multiply *second-value
+ 639   new-float out, result
+ 640 }
+ 641 
+ 642 fn apply-divide _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+ 643   trace-text trace, "eval", "apply /"
+ 644   var args-ah/eax: (addr handle cell) <- copy _args-ah
+ 645   var _args/eax: (addr cell) <- lookup *args-ah
+ 646   var args/esi: (addr cell) <- copy _args
+ 647   {
+ 648     var args-type/ecx: (addr int) <- get args, type
+ 649     compare *args-type, 0/pair
+ 650     break-if-=
+ 651     error trace, "args to / are not a list"
+ 652     return
+ 653   }
+ 654   var empty-args?/eax: boolean <- nil? args
+ 655   compare empty-args?, 0/false
+ 656   {
+ 657     break-if-=
+ 658     error trace, "/ needs 2 args but got 0"
+ 659     return
+ 660   }
+ 661   # args->left->value
+ 662   var first-ah/eax: (addr handle cell) <- get args, left
+ 663   var first/eax: (addr cell) <- lookup *first-ah
+ 664   var first-type/ecx: (addr int) <- get first, type
+ 665   compare *first-type, 1/number
+ 666   {
+ 667     break-if-=
+ 668     error trace, "first arg for / is not a number"
+ 669     return
+ 670   }
+ 671   var first-value/ecx: (addr float) <- get first, number-data
+ 672   # args->right->left->value
+ 673   var right-ah/eax: (addr handle cell) <- get args, right
+ 674   var right/eax: (addr cell) <- lookup *right-ah
+ 675   {
+ 676     var right-type/ecx: (addr int) <- get right, type
+ 677     compare *right-type, 0/pair
+ 678     break-if-=
+ 679     error trace, "/ encountered non-pair"
+ 680     return
+ 681   }
+ 682   {
+ 683     var nil?/eax: boolean <- nil? right
+ 684     compare nil?, 0/false
+ 685     break-if-=
+ 686     error trace, "/ needs 2 args but got 1"
+ 687     return
+ 688   }
+ 689   var second-ah/eax: (addr handle cell) <- get right, left
+ 690   var second/eax: (addr cell) <- lookup *second-ah
+ 691   var second-type/edx: (addr int) <- get second, type
+ 692   compare *second-type, 1/number
+ 693   {
+ 694     break-if-=
+ 695     error trace, "second arg for / is not a number"
+ 696     return
+ 697   }
+ 698   var second-value/edx: (addr float) <- get second, number-data
+ 699   # divide
+ 700   var result/xmm0: float <- copy *first-value
+ 701   result <- divide *second-value
+ 702   new-float out, result
+ 703 }
+ 704 
+ 705 fn apply-remainder _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+ 706   trace-text trace, "eval", "apply %"
+ 707   var args-ah/eax: (addr handle cell) <- copy _args-ah
+ 708   var _args/eax: (addr cell) <- lookup *args-ah
+ 709   var args/esi: (addr cell) <- copy _args
+ 710   {
+ 711     var args-type/ecx: (addr int) <- get args, type
+ 712     compare *args-type, 0/pair
+ 713     break-if-=
+ 714     error trace, "args to % are not a list"
+ 715     return
+ 716   }
+ 717   var empty-args?/eax: boolean <- nil? args
+ 718   compare empty-args?, 0/false
+ 719   {
+ 720     break-if-=
+ 721     error trace, "% needs 2 args but got 0"
+ 722     return
+ 723   }
+ 724   # args->left->value
+ 725   var first-ah/eax: (addr handle cell) <- get args, left
+ 726   var first/eax: (addr cell) <- lookup *first-ah
+ 727   var first-type/ecx: (addr int) <- get first, type
+ 728   compare *first-type, 1/number
+ 729   {
+ 730     break-if-=
+ 731     error trace, "first arg for % is not a number"
+ 732     return
+ 733   }
+ 734   var first-value/ecx: (addr float) <- get first, number-data
+ 735   # args->right->left->value
+ 736   var right-ah/eax: (addr handle cell) <- get args, right
+ 737   var right/eax: (addr cell) <- lookup *right-ah
+ 738   {
+ 739     var right-type/ecx: (addr int) <- get right, type
+ 740     compare *right-type, 0/pair
+ 741     break-if-=
+ 742     error trace, "% encountered non-pair"
+ 743     return
+ 744   }
+ 745   {
+ 746     var nil?/eax: boolean <- nil? right
+ 747     compare nil?, 0/false
+ 748     break-if-=
+ 749     error trace, "% needs 2 args but got 1"
+ 750     return
+ 751   }
+ 752   var second-ah/eax: (addr handle cell) <- get right, left
+ 753   var second/eax: (addr cell) <- lookup *second-ah
+ 754   var second-type/edx: (addr int) <- get second, type
+ 755   compare *second-type, 1/number
+ 756   {
+ 757     break-if-=
+ 758     error trace, "second arg for % is not a number"
+ 759     return
+ 760   }
+ 761   var second-value/edx: (addr float) <- get second, number-data
+ 762   # divide
+ 763   var quotient/xmm0: float <- copy *first-value
+ 764   quotient <- divide *second-value
+ 765   var quotient-int/eax: int <- truncate quotient
+ 766   quotient <- convert quotient-int
+ 767   var sub-result/xmm1: float <- copy quotient
+ 768   sub-result <- multiply *second-value
+ 769   var result/xmm0: float <- copy *first-value
+ 770   result <- subtract sub-result
+ 771   new-float out, result
+ 772 }
+ 773 
+ 774 fn apply-square-root _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+ 775   trace-text trace, "eval", "apply sqrt"
+ 776   var args-ah/eax: (addr handle cell) <- copy _args-ah
+ 777   var _args/eax: (addr cell) <- lookup *args-ah
+ 778   var args/esi: (addr cell) <- copy _args
+ 779   {
+ 780     var args-type/ecx: (addr int) <- get args, type
+ 781     compare *args-type, 0/pair
+ 782     break-if-=
+ 783     error trace, "args to sqrt are not a list"
+ 784     return
+ 785   }
+ 786   var empty-args?/eax: boolean <- nil? args
+ 787   compare empty-args?, 0/false
+ 788   {
+ 789     break-if-=
+ 790     error trace, "sqrt needs 1 arg but got 0"
+ 791     return
+ 792   }
+ 793   # args->left->value
+ 794   var first-ah/eax: (addr handle cell) <- get args, left
+ 795   var first/eax: (addr cell) <- lookup *first-ah
+ 796   var first-type/ecx: (addr int) <- get first, type
+ 797   compare *first-type, 1/number
+ 798   {
+ 799     break-if-=
+ 800     error trace, "arg for sqrt is not a number"
+ 801     return
+ 802   }
+ 803   var first-value/ecx: (addr float) <- get first, number-data
+ 804   # square-root
+ 805   var result/xmm0: float <- square-root *first-value
+ 806   new-float out, result
+ 807 }
+ 808 
+ 809 fn apply-abs _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+ 810   trace-text trace, "eval", "apply abs"
+ 811   var args-ah/eax: (addr handle cell) <- copy _args-ah
+ 812   var _args/eax: (addr cell) <- lookup *args-ah
+ 813   var args/esi: (addr cell) <- copy _args
+ 814   {
+ 815     var args-type/ecx: (addr int) <- get args, type
+ 816     compare *args-type, 0/pair
+ 817     break-if-=
+ 818     error trace, "args to abs are not a list"
+ 819     return
+ 820   }
+ 821   var empty-args?/eax: boolean <- nil? args
+ 822   compare empty-args?, 0/false
+ 823   {
+ 824     break-if-=
+ 825     error trace, "abs needs 1 arg but got 0"
+ 826     return
+ 827   }
+ 828   # args->left->value
+ 829   var first-ah/eax: (addr handle cell) <- get args, left
+ 830   var first/eax: (addr cell) <- lookup *first-ah
+ 831   var first-type/ecx: (addr int) <- get first, type
+ 832   compare *first-type, 1/number
+ 833   {
+ 834     break-if-=
+ 835     error trace, "arg for abs is not a number"
+ 836     return
+ 837   }
+ 838   var first-value/ecx: (addr float) <- get first, number-data
+ 839   #
+ 840   var result/xmm0: float <- copy *first-value
+ 841   var zero: float
+ 842   compare result, zero
+ 843   {
+ 844     break-if-float>=
+ 845     var neg1/eax: int <- copy -1
+ 846     var neg1-f/xmm1: float <- convert neg1
+ 847     result <- multiply neg1-f
+ 848   }
+ 849   new-float out, result
+ 850 }
+ 851 
+ 852 fn apply-sgn _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+ 853   trace-text trace, "eval", "apply sgn"
+ 854   var args-ah/eax: (addr handle cell) <- copy _args-ah
+ 855   var _args/eax: (addr cell) <- lookup *args-ah
+ 856   var args/esi: (addr cell) <- copy _args
+ 857   {
+ 858     var args-type/ecx: (addr int) <- get args, type
+ 859     compare *args-type, 0/pair
+ 860     break-if-=
+ 861     error trace, "args to sgn are not a list"
+ 862     return
+ 863   }
+ 864   var empty-args?/eax: boolean <- nil? args
+ 865   compare empty-args?, 0/false
+ 866   {
+ 867     break-if-=
+ 868     error trace, "sgn needs 1 arg but got 0"
+ 869     return
+ 870   }
+ 871   # args->left->value
+ 872   var first-ah/eax: (addr handle cell) <- get args, left
+ 873   var first/eax: (addr cell) <- lookup *first-ah
+ 874   var first-type/ecx: (addr int) <- get first, type
+ 875   compare *first-type, 1/number
+ 876   {
+ 877     break-if-=
+ 878     error trace, "arg for sgn is not a number"
+ 879     return
+ 880   }
+ 881   var first-value/ecx: (addr float) <- get first, number-data
+ 882   #
+ 883   var result/xmm0: float <- copy *first-value
+ 884   var zero: float
+ 885   $apply-sgn:core: {
+ 886     compare result, zero
+ 887     break-if-=
+ 888     {
+ 889       break-if-float>
+ 890       var neg1/eax: int <- copy -1
+ 891       result <- convert neg1
+ 892       break $apply-sgn:core
+ 893     }
+ 894     {
+ 895       break-if-float<
+ 896       var one/eax: int <- copy 1
+ 897       result <- convert one
+ 898       break $apply-sgn:core
+ 899     }
+ 900   }
+ 901   new-float out, result
+ 902 }
+ 903 
+ 904 fn apply-car _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+ 905   trace-text trace, "eval", "apply car"
+ 906   var args-ah/eax: (addr handle cell) <- copy _args-ah
+ 907   var _args/eax: (addr cell) <- lookup *args-ah
+ 908   var args/esi: (addr cell) <- copy _args
+ 909   {
+ 910     var args-type/ecx: (addr int) <- get args, type
+ 911     compare *args-type, 0/pair
+ 912     break-if-=
+ 913     error trace, "args to car are not a list"
+ 914     return
+ 915   }
+ 916   var empty-args?/eax: boolean <- nil? args
+ 917   compare empty-args?, 0/false
+ 918   {
+ 919     break-if-=
+ 920     error trace, "car needs 1 arg but got 0"
+ 921     return
+ 922   }
+ 923   # args->left
+ 924   var first-ah/edx: (addr handle cell) <- get args, left
+ 925   var first/eax: (addr cell) <- lookup *first-ah
+ 926   var first-type/ecx: (addr int) <- get first, type
+ 927   compare *first-type, 0/pair
+ 928   {
+ 929     break-if-=
+ 930     error trace, "arg for car is not a pair"
+ 931     return
+ 932   }
+ 933   # nil? return nil
+ 934   {
+ 935     var nil?/eax: boolean <- nil? first
+ 936     compare nil?, 0/false
+ 937     break-if-=
+ 938     copy-object first-ah, out
+ 939     return
+ 940   }
+ 941   # car
+ 942   var result/eax: (addr handle cell) <- get first, left
+ 943   copy-object result, out
+ 944 }
+ 945 
+ 946 fn apply-cdr _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+ 947   trace-text trace, "eval", "apply cdr"
+ 948   var args-ah/eax: (addr handle cell) <- copy _args-ah
+ 949   var _args/eax: (addr cell) <- lookup *args-ah
+ 950   var args/esi: (addr cell) <- copy _args
+ 951   {
+ 952     var args-type/ecx: (addr int) <- get args, type
+ 953     compare *args-type, 0/pair
+ 954     break-if-=
+ 955     error trace, "args to cdr are not a list"
+ 956     return
+ 957   }
+ 958   var empty-args?/eax: boolean <- nil? args
+ 959   compare empty-args?, 0/false
+ 960   {
+ 961     break-if-=
+ 962     error trace, "cdr needs 1 arg but got 0"
+ 963     return
+ 964   }
+ 965   # args->left
+ 966   var first-ah/edx: (addr handle cell) <- get args, left
+ 967   var first/eax: (addr cell) <- lookup *first-ah
+ 968   var first-type/ecx: (addr int) <- get first, type
+ 969   compare *first-type, 0/pair
+ 970   {
+ 971     break-if-=
+ 972     error trace, "arg for cdr is not a pair"
+ 973     return
+ 974   }
+ 975   # nil? return nil
+ 976   {
+ 977     var nil?/eax: boolean <- nil? first
+ 978     compare nil?, 0/false
+ 979     break-if-=
+ 980     copy-object first-ah, out
+ 981     return
+ 982   }
+ 983   # cdr
+ 984   var result/eax: (addr handle cell) <- get first, right
+ 985   copy-object result, out
+ 986 }
+ 987 
+ 988 fn apply-cons _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+ 989   trace-text trace, "eval", "apply cons"
+ 990   var args-ah/eax: (addr handle cell) <- copy _args-ah
+ 991   var _args/eax: (addr cell) <- lookup *args-ah
+ 992   var args/esi: (addr cell) <- copy _args
+ 993   {
+ 994     var args-type/ecx: (addr int) <- get args, type
+ 995     compare *args-type, 0/pair
+ 996     break-if-=
+ 997     error trace, "args to 'cons' are not a list"
+ 998     return
+ 999   }
+1000   var empty-args?/eax: boolean <- nil? args
+1001   compare empty-args?, 0/false
+1002   {
+1003     break-if-=
+1004     error trace, "cons needs 2 args but got 0"
+1005     return
+1006   }
+1007   # args->left
+1008   var first-ah/ecx: (addr handle cell) <- get args, left
+1009   # args->right->left
+1010   var right-ah/eax: (addr handle cell) <- get args, right
+1011   var right/eax: (addr cell) <- lookup *right-ah
+1012   {
+1013     var right-type/ecx: (addr int) <- get right, type
+1014     compare *right-type, 0/pair
+1015     break-if-=
+1016     error trace, "'cons' encountered non-pair"
+1017     return
+1018   }
+1019   {
+1020     var nil?/eax: boolean <- nil? right
+1021     compare nil?, 0/false
+1022     break-if-=
+1023     error trace, "'cons' needs 2 args but got 1"
+1024     return
+1025   }
+1026   var second-ah/eax: (addr handle cell) <- get right, left
+1027   # cons
+1028   new-pair out, *first-ah, *second-ah
+1029 }
+1030 
+1031 fn apply-structurally-equal _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1032   trace-text trace, "eval", "apply '='"
+1033   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1034   var _args/eax: (addr cell) <- lookup *args-ah
+1035   var args/esi: (addr cell) <- copy _args
+1036   {
+1037     var args-type/ecx: (addr int) <- get args, type
+1038     compare *args-type, 0/pair
+1039     break-if-=
+1040     error trace, "args to '=' are not a list"
+1041     return
+1042   }
+1043   var empty-args?/eax: boolean <- nil? args
+1044   compare empty-args?, 0/false
+1045   {
+1046     break-if-=
+1047     error trace, "'=' needs 2 args but got 0"
+1048     return
+1049   }
+1050   # args->left
+1051   var first-ah/ecx: (addr handle cell) <- get args, left
+1052   # args->right->left
+1053   var right-ah/eax: (addr handle cell) <- get args, right
+1054   var right/eax: (addr cell) <- lookup *right-ah
+1055   {
+1056     var right-type/ecx: (addr int) <- get right, type
+1057     compare *right-type, 0/pair
+1058     break-if-=
+1059     error trace, "'=' encountered non-pair"
+1060     return
+1061   }
+1062   {
+1063     var nil?/eax: boolean <- nil? right
+1064     compare nil?, 0/false
+1065     break-if-=
+1066     error trace, "'=' needs 2 args but got 1"
+1067     return
+1068   }
+1069   var second-ah/edx: (addr handle cell) <- get right, left
+1070   # compare
+1071   var _first/eax: (addr cell) <- lookup *first-ah
+1072   var first/ecx: (addr cell) <- copy _first
+1073   var second/eax: (addr cell) <- lookup *second-ah
+1074   var match?/eax: boolean <- cell-isomorphic? first, second, trace
+1075   compare match?, 0/false
+1076   {
+1077     break-if-!=
+1078     nil out
+1079     return
+1080   }
+1081   new-integer out, 1/true
+1082 }
+1083 
+1084 fn apply-not _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1085   trace-text trace, "eval", "apply 'not'"
+1086   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1087   var _args/eax: (addr cell) <- lookup *args-ah
+1088   var args/esi: (addr cell) <- copy _args
+1089   {
+1090     var args-type/ecx: (addr int) <- get args, type
+1091     compare *args-type, 0/pair
+1092     break-if-=
+1093     error trace, "args to 'not' are not a list"
+1094     return
+1095   }
+1096   var empty-args?/eax: boolean <- nil? args
+1097   compare empty-args?, 0/false
+1098   {
+1099     break-if-=
+1100     error trace, "'not' needs 1 arg but got 0"
+1101     return
+1102   }
+1103   # args->left
+1104   var first-ah/eax: (addr handle cell) <- get args, left
+1105   var first/eax: (addr cell) <- lookup *first-ah
+1106   # not
+1107   var nil?/eax: boolean <- nil? first
+1108   compare nil?, 0/false
+1109   {
+1110     break-if-!=
+1111     nil out
+1112     return
+1113   }
+1114   new-integer out, 1
+1115 }
+1116 
+1117 fn apply-debug _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1118   trace-text trace, "eval", "apply 'debug'"
+1119   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1120   var _args/eax: (addr cell) <- lookup *args-ah
+1121   var args/esi: (addr cell) <- copy _args
+1122   {
+1123     var args-type/ecx: (addr int) <- get args, type
+1124     compare *args-type, 0/pair
+1125     break-if-=
+1126     error trace, "args to 'debug' are not a list"
+1127     return
+1128   }
+1129   var empty-args?/eax: boolean <- nil? args
+1130   compare empty-args?, 0/false
+1131   {
+1132     break-if-=
+1133     error trace, "'debug' needs 1 arg but got 0"
+1134     return
+1135   }
+1136   # dump args->left uglily to screen and wait for a keypress
+1137   var first-ah/eax: (addr handle cell) <- get args, left
+1138   dump-cell-from-cursor-over-full-screen first-ah, 7/fg 0/bg
+1139   {
+1140     var foo/eax: byte <- read-key 0/keyboard
+1141     compare foo, 0
+1142     loop-if-=
+1143   }
+1144   # return nothing
+1145 }
+1146 
+1147 fn apply-< _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1148   trace-text trace, "eval", "apply '<'"
+1149   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1150   var _args/eax: (addr cell) <- lookup *args-ah
+1151   var args/esi: (addr cell) <- copy _args
+1152   {
+1153     var args-type/ecx: (addr int) <- get args, type
+1154     compare *args-type, 0/pair
+1155     break-if-=
+1156     error trace, "args to '<' are not a list"
+1157     return
+1158   }
+1159   var empty-args?/eax: boolean <- nil? args
+1160   compare empty-args?, 0/false
+1161   {
+1162     break-if-=
+1163     error trace, "'<' needs 2 args but got 0"
+1164     return
+1165   }
+1166   # args->left
+1167   var first-ah/ecx: (addr handle cell) <- get args, left
+1168   # args->right->left
+1169   var right-ah/eax: (addr handle cell) <- get args, right
+1170   var right/eax: (addr cell) <- lookup *right-ah
+1171   {
+1172     var right-type/ecx: (addr int) <- get right, type
+1173     compare *right-type, 0/pair
+1174     break-if-=
+1175     error trace, "'<' encountered non-pair"
+1176     return
+1177   }
+1178   {
+1179     var nil?/eax: boolean <- nil? right
+1180     compare nil?, 0/false
+1181     break-if-=
+1182     error trace, "'<' needs 2 args but got 1"
+1183     return
+1184   }
+1185   var second-ah/edx: (addr handle cell) <- get right, left
+1186   # compare
+1187   var _first/eax: (addr cell) <- lookup *first-ah
+1188   var first/ecx: (addr cell) <- copy _first
+1189   var first-type/eax: (addr int) <- get first, type
+1190   compare *first-type, 1/number
+1191   {
+1192     break-if-=
+1193     error trace, "first arg for '<' is not a number"
+1194     return
+1195   }
+1196   var first-value/ecx: (addr float) <- get first, number-data
+1197   var first-float/xmm0: float <- copy *first-value
+1198   var second/eax: (addr cell) <- lookup *second-ah
+1199   var second-type/edx: (addr int) <- get second, type
+1200   compare *second-type, 1/number
+1201   {
+1202     break-if-=
+1203     error trace, "second arg for '<' is not a number"
+1204     return
+1205   }
+1206   var second-value/eax: (addr float) <- get second, number-data
+1207   compare first-float, *second-value
+1208   {
+1209     break-if-float<
+1210     nil out
+1211     return
+1212   }
+1213   new-integer out, 1/true
+1214 }
+1215 
+1216 fn apply-> _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1217   trace-text trace, "eval", "apply '>'"
+1218   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1219   var _args/eax: (addr cell) <- lookup *args-ah
+1220   var args/esi: (addr cell) <- copy _args
+1221   {
+1222     var args-type/ecx: (addr int) <- get args, type
+1223     compare *args-type, 0/pair
+1224     break-if-=
+1225     error trace, "args to '>' are not a list"
+1226     return
+1227   }
+1228   var empty-args?/eax: boolean <- nil? args
+1229   compare empty-args?, 0/false
+1230   {
+1231     break-if-=
+1232     error trace, "'>' needs 2 args but got 0"
+1233     return
+1234   }
+1235   # args->left
+1236   var first-ah/ecx: (addr handle cell) <- get args, left
+1237   # args->right->left
+1238   var right-ah/eax: (addr handle cell) <- get args, right
+1239   var right/eax: (addr cell) <- lookup *right-ah
+1240   {
+1241     var right-type/ecx: (addr int) <- get right, type
+1242     compare *right-type, 0/pair
+1243     break-if-=
+1244     error trace, "'>' encountered non-pair"
+1245     return
+1246   }
+1247   {
+1248     var nil?/eax: boolean <- nil? right
+1249     compare nil?, 0/false
+1250     break-if-=
+1251     error trace, "'>' needs 2 args but got 1"
+1252     return
+1253   }
+1254   var second-ah/edx: (addr handle cell) <- get right, left
+1255   # compare
+1256   var _first/eax: (addr cell) <- lookup *first-ah
+1257   var first/ecx: (addr cell) <- copy _first
+1258   var first-type/eax: (addr int) <- get first, type
+1259   compare *first-type, 1/number
+1260   {
+1261     break-if-=
+1262     error trace, "first arg for '>' is not a number"
+1263     return
+1264   }
+1265   var first-value/ecx: (addr float) <- get first, number-data
+1266   var first-float/xmm0: float <- copy *first-value
+1267   var second/eax: (addr cell) <- lookup *second-ah
+1268   var second-type/edx: (addr int) <- get second, type
+1269   compare *second-type, 1/number
+1270   {
+1271     break-if-=
+1272     error trace, "second arg for '>' is not a number"
+1273     return
+1274   }
+1275   var second-value/eax: (addr float) <- get second, number-data
+1276   compare first-float, *second-value
+1277   {
+1278     break-if-float>
+1279     nil out
+1280     return
+1281   }
+1282   new-integer out, 1/true
+1283 }
+1284 
+1285 fn apply-<= _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1286   trace-text trace, "eval", "apply '<='"
+1287   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1288   var _args/eax: (addr cell) <- lookup *args-ah
+1289   var args/esi: (addr cell) <- copy _args
+1290   {
+1291     var args-type/ecx: (addr int) <- get args, type
+1292     compare *args-type, 0/pair
+1293     break-if-=
+1294     error trace, "args to '<=' are not a list"
+1295     return
+1296   }
+1297   var empty-args?/eax: boolean <- nil? args
+1298   compare empty-args?, 0/false
+1299   {
+1300     break-if-=
+1301     error trace, "'<=' needs 2 args but got 0"
+1302     return
+1303   }
+1304   # args->left
+1305   var first-ah/ecx: (addr handle cell) <- get args, left
+1306   # args->right->left
+1307   var right-ah/eax: (addr handle cell) <- get args, right
+1308   var right/eax: (addr cell) <- lookup *right-ah
+1309   {
+1310     var right-type/ecx: (addr int) <- get right, type
+1311     compare *right-type, 0/pair
+1312     break-if-=
+1313     error trace, "'<=' encountered non-pair"
+1314     return
+1315   }
+1316   {
+1317     var nil?/eax: boolean <- nil? right
+1318     compare nil?, 0/false
+1319     break-if-=
+1320     error trace, "'<=' needs 2 args but got 1"
+1321     return
+1322   }
+1323   var second-ah/edx: (addr handle cell) <- get right, left
+1324   # compare
+1325   var _first/eax: (addr cell) <- lookup *first-ah
+1326   var first/ecx: (addr cell) <- copy _first
+1327   var first-type/eax: (addr int) <- get first, type
+1328   compare *first-type, 1/number
+1329   {
+1330     break-if-=
+1331     error trace, "first arg for '<=' is not a number"
+1332     return
+1333   }
+1334   var first-value/ecx: (addr float) <- get first, number-data
+1335   var first-float/xmm0: float <- copy *first-value
+1336   var second/eax: (addr cell) <- lookup *second-ah
+1337   var second-type/edx: (addr int) <- get second, type
+1338   compare *second-type, 1/number
+1339   {
+1340     break-if-=
+1341     error trace, "second arg for '<=' is not a number"
+1342     return
+1343   }
+1344   var second-value/eax: (addr float) <- get second, number-data
+1345   compare first-float, *second-value
+1346   {
+1347     break-if-float<=
+1348     nil out
+1349     return
+1350   }
+1351   new-integer out, 1/true
+1352 }
+1353 
+1354 fn apply->= _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1355   trace-text trace, "eval", "apply '>='"
+1356   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1357   var _args/eax: (addr cell) <- lookup *args-ah
+1358   var args/esi: (addr cell) <- copy _args
+1359   {
+1360     var args-type/ecx: (addr int) <- get args, type
+1361     compare *args-type, 0/pair
+1362     break-if-=
+1363     error trace, "args to '>=' are not a list"
+1364     return
+1365   }
+1366   var empty-args?/eax: boolean <- nil? args
+1367   compare empty-args?, 0/false
+1368   {
+1369     break-if-=
+1370     error trace, "'>=' needs 2 args but got 0"
+1371     return
+1372   }
+1373   # args->left
+1374   var first-ah/ecx: (addr handle cell) <- get args, left
+1375   # args->right->left
+1376   var right-ah/eax: (addr handle cell) <- get args, right
+1377   var right/eax: (addr cell) <- lookup *right-ah
+1378   {
+1379     var right-type/ecx: (addr int) <- get right, type
+1380     compare *right-type, 0/pair
+1381     break-if-=
+1382     error trace, "'>=' encountered non-pair"
+1383     return
+1384   }
+1385   {
+1386     var nil?/eax: boolean <- nil? right
+1387     compare nil?, 0/false
+1388     break-if-=
+1389     error trace, "'>=' needs 2 args but got 1"
+1390     return
+1391   }
+1392   var second-ah/edx: (addr handle cell) <- get right, left
+1393   # compare
+1394   var _first/eax: (addr cell) <- lookup *first-ah
+1395   var first/ecx: (addr cell) <- copy _first
+1396   var first-type/eax: (addr int) <- get first, type
+1397   compare *first-type, 1/number
+1398   {
+1399     break-if-=
+1400     error trace, "first arg for '>=' is not a number"
+1401     return
+1402   }
+1403   var first-value/ecx: (addr float) <- get first, number-data
+1404   var first-float/xmm0: float <- copy *first-value
+1405   var second/eax: (addr cell) <- lookup *second-ah
+1406   var second-type/edx: (addr int) <- get second, type
+1407   compare *second-type, 1/number
+1408   {
+1409     break-if-=
+1410     error trace, "second arg for '>=' is not a number"
+1411     return
+1412   }
+1413   var second-value/eax: (addr float) <- get second, number-data
+1414   compare first-float, *second-value
+1415   {
+1416     break-if-float>=
+1417     nil out
+1418     return
+1419   }
+1420   new-integer out, 1/true
+1421 }
+1422 
+1423 fn apply-print _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1424   trace-text trace, "eval", "apply 'print'"
+1425   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1426   var _args/eax: (addr cell) <- lookup *args-ah
+1427   var args/esi: (addr cell) <- copy _args
+1428   {
+1429     var args-type/ecx: (addr int) <- get args, type
+1430     compare *args-type, 0/pair
+1431     break-if-=
+1432     error trace, "args to 'print' are not a list"
+1433     return
+1434   }
+1435   var empty-args?/eax: boolean <- nil? args
+1436   compare empty-args?, 0/false
+1437   {
+1438     break-if-=
+1439     error trace, "'print' needs 2 args but got 0"
+1440     return
+1441   }
+1442   # screen = args->left
+1443   var first-ah/eax: (addr handle cell) <- get args, left
+1444   var first/eax: (addr cell) <- lookup *first-ah
+1445   var first-type/ecx: (addr int) <- get first, type
+1446   compare *first-type, 5/screen
+1447   {
+1448     break-if-=
+1449     error trace, "first arg for 'print' is not a screen"
+1450     return
+1451   }
+1452   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+1453   var _screen/eax: (addr screen) <- lookup *screen-ah
+1454   var screen/ecx: (addr screen) <- copy _screen
+1455   # args->right->left
+1456   var right-ah/eax: (addr handle cell) <- get args, right
+1457   var right/eax: (addr cell) <- lookup *right-ah
+1458   {
+1459     var right-type/ecx: (addr int) <- get right, type
+1460     compare *right-type, 0/pair
+1461     break-if-=
+1462     error trace, "'print' encountered non-pair"
+1463     return
+1464   }
+1465   {
+1466     var nil?/eax: boolean <- nil? right
+1467     compare nil?, 0/false
+1468     break-if-=
+1469     error trace, "'print' needs 2 args but got 1"
+1470     return
+1471   }
+1472   var second-ah/eax: (addr handle cell) <- get right, left
+1473   var stream-storage: (stream byte 0x100)
+1474   var stream/edi: (addr stream byte) <- address stream-storage
+1475   print-cell second-ah, stream, trace
+1476   draw-stream-wrapping-right-then-down-from-cursor-over-full-screen screen, stream, 7/fg, 0/bg
+1477   # return what was printed
+1478   copy-object second-ah, out
+1479 }
+1480 
+1481 fn apply-clear _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1482   trace-text trace, "eval", "apply 'clear'"
+1483   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1484   var _args/eax: (addr cell) <- lookup *args-ah
+1485   var args/esi: (addr cell) <- copy _args
+1486   {
+1487     var args-type/ecx: (addr int) <- get args, type
+1488     compare *args-type, 0/pair
+1489     break-if-=
+1490     error trace, "args to 'clear' are not a list"
+1491     return
+1492   }
+1493   var empty-args?/eax: boolean <- nil? args
+1494   compare empty-args?, 0/false
+1495   {
+1496     break-if-=
+1497     error trace, "'clear' needs 1 arg but got 0"
+1498     return
+1499   }
+1500   # screen = args->left
+1501   var first-ah/eax: (addr handle cell) <- get args, left
+1502   var first/eax: (addr cell) <- lookup *first-ah
+1503   var first-type/ecx: (addr int) <- get first, type
+1504   compare *first-type, 5/screen
+1505   {
+1506     break-if-=
+1507     error trace, "first arg for 'clear' is not a screen"
+1508     return
+1509   }
+1510   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+1511   var _screen/eax: (addr screen) <- lookup *screen-ah
+1512   var screen/ecx: (addr screen) <- copy _screen
+1513   #
+1514   clear-screen screen
+1515 }
+1516 
+1517 fn apply-up _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1518   trace-text trace, "eval", "apply 'up'"
+1519   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1520   var _args/eax: (addr cell) <- lookup *args-ah
+1521   var args/esi: (addr cell) <- copy _args
+1522   {
+1523     var args-type/ecx: (addr int) <- get args, type
+1524     compare *args-type, 0/pair
+1525     break-if-=
+1526     error trace, "args to 'up' are not a list"
+1527     return
+1528   }
+1529   var empty-args?/eax: boolean <- nil? args
+1530   compare empty-args?, 0/false
+1531   {
+1532     break-if-=
+1533     error trace, "'up' needs 1 arg but got 0"
+1534     return
+1535   }
+1536   # screen = args->left
+1537   var first-ah/eax: (addr handle cell) <- get args, left
+1538   var first/eax: (addr cell) <- lookup *first-ah
+1539   var first-type/ecx: (addr int) <- get first, type
+1540   compare *first-type, 5/screen
+1541   {
+1542     break-if-=
+1543     error trace, "first arg for 'up' is not a screen"
+1544     return
+1545   }
+1546   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+1547   var _screen/eax: (addr screen) <- lookup *screen-ah
+1548   var screen/ecx: (addr screen) <- copy _screen
+1549   #
+1550   move-cursor-up screen
+1551 }
+1552 
+1553 fn apply-down _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1554   trace-text trace, "eval", "apply 'down'"
+1555   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1556   var _args/eax: (addr cell) <- lookup *args-ah
+1557   var args/esi: (addr cell) <- copy _args
+1558   {
+1559     var args-type/ecx: (addr int) <- get args, type
+1560     compare *args-type, 0/pair
+1561     break-if-=
+1562     error trace, "args to 'down' are not a list"
+1563     return
+1564   }
+1565   var empty-args?/eax: boolean <- nil? args
+1566   compare empty-args?, 0/false
+1567   {
+1568     break-if-=
+1569     error trace, "'down' needs 1 arg but got 0"
+1570     return
+1571   }
+1572   # screen = args->left
+1573   var first-ah/eax: (addr handle cell) <- get args, left
+1574   var first/eax: (addr cell) <- lookup *first-ah
+1575   var first-type/ecx: (addr int) <- get first, type
+1576   compare *first-type, 5/screen
+1577   {
+1578     break-if-=
+1579     error trace, "first arg for 'down' is not a screen"
+1580     return
+1581   }
+1582   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+1583   var _screen/eax: (addr screen) <- lookup *screen-ah
+1584   var screen/ecx: (addr screen) <- copy _screen
+1585   #
+1586   move-cursor-down screen
+1587 }
+1588 
+1589 fn apply-left _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1590   trace-text trace, "eval", "apply 'left'"
+1591   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1592   var _args/eax: (addr cell) <- lookup *args-ah
+1593   var args/esi: (addr cell) <- copy _args
+1594   {
+1595     var args-type/ecx: (addr int) <- get args, type
+1596     compare *args-type, 0/pair
+1597     break-if-=
+1598     error trace, "args to 'left' are not a list"
+1599     return
+1600   }
+1601   var empty-args?/eax: boolean <- nil? args
+1602   compare empty-args?, 0/false
+1603   {
+1604     break-if-=
+1605     error trace, "'left' needs 1 arg but got 0"
+1606     return
+1607   }
+1608   # screen = args->left
+1609   var first-ah/eax: (addr handle cell) <- get args, left
+1610   var first/eax: (addr cell) <- lookup *first-ah
+1611   var first-type/ecx: (addr int) <- get first, type
+1612   compare *first-type, 5/screen
+1613   {
+1614     break-if-=
+1615     error trace, "first arg for 'left' is not a screen"
+1616     return
+1617   }
+1618   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+1619   var _screen/eax: (addr screen) <- lookup *screen-ah
+1620   var screen/ecx: (addr screen) <- copy _screen
+1621   #
+1622   move-cursor-left screen
+1623 }
+1624 
+1625 fn apply-right _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1626   trace-text trace, "eval", "apply 'right'"
+1627   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1628   var _args/eax: (addr cell) <- lookup *args-ah
+1629   var args/esi: (addr cell) <- copy _args
+1630   {
+1631     var args-type/ecx: (addr int) <- get args, type
+1632     compare *args-type, 0/pair
+1633     break-if-=
+1634     error trace, "args to 'right' are not a list"
+1635     return
+1636   }
+1637   var empty-args?/eax: boolean <- nil? args
+1638   compare empty-args?, 0/false
+1639   {
+1640     break-if-=
+1641     error trace, "'right' needs 1 arg but got 0"
+1642     return
+1643   }
+1644   # screen = args->left
+1645   var first-ah/eax: (addr handle cell) <- get args, left
+1646   var first/eax: (addr cell) <- lookup *first-ah
+1647   var first-type/ecx: (addr int) <- get first, type
+1648   compare *first-type, 5/screen
+1649   {
+1650     break-if-=
+1651     error trace, "first arg for 'right' is not a screen"
+1652     return
+1653   }
+1654   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+1655   var _screen/eax: (addr screen) <- lookup *screen-ah
+1656   var screen/ecx: (addr screen) <- copy _screen
+1657   #
+1658   move-cursor-right screen
+1659 }
+1660 
+1661 fn apply-cr _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1662   trace-text trace, "eval", "apply 'cr'"
+1663   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1664   var _args/eax: (addr cell) <- lookup *args-ah
+1665   var args/esi: (addr cell) <- copy _args
+1666   {
+1667     var args-type/ecx: (addr int) <- get args, type
+1668     compare *args-type, 0/pair
+1669     break-if-=
+1670     error trace, "args to 'cr' are not a list"
+1671     return
+1672   }
+1673   var empty-args?/eax: boolean <- nil? args
+1674   compare empty-args?, 0/false
+1675   {
+1676     break-if-=
+1677     error trace, "'cr' needs 1 arg but got 0"
+1678     return
+1679   }
+1680   # screen = args->left
+1681   var first-ah/eax: (addr handle cell) <- get args, left
+1682   var first/eax: (addr cell) <- lookup *first-ah
+1683   var first-type/ecx: (addr int) <- get first, type
+1684   compare *first-type, 5/screen
+1685   {
+1686     break-if-=
+1687     error trace, "first arg for 'cr' is not a screen"
+1688     return
+1689   }
+1690   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+1691   var _screen/eax: (addr screen) <- lookup *screen-ah
+1692   var screen/ecx: (addr screen) <- copy _screen
+1693   #
+1694   move-cursor-to-left-margin-of-next-line screen
+1695 }
+1696 
+1697 fn apply-pixel _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1698   trace-text trace, "eval", "apply 'pixel'"
+1699   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1700   var _args/eax: (addr cell) <- lookup *args-ah
+1701   var args/esi: (addr cell) <- copy _args
+1702   {
+1703     var args-type/ecx: (addr int) <- get args, type
+1704     compare *args-type, 0/pair
+1705     break-if-=
+1706     error trace, "args to 'pixel' are not a list"
+1707     return
+1708   }
+1709   var empty-args?/eax: boolean <- nil? args
+1710   compare empty-args?, 0/false
+1711   {
+1712     break-if-=
+1713     error trace, "'pixel' needs 4 args but got 0"
+1714     return
+1715   }
+1716   # screen = args->left
+1717   var first-ah/eax: (addr handle cell) <- get args, left
+1718   var first/eax: (addr cell) <- lookup *first-ah
+1719   var first-type/ecx: (addr int) <- get first, type
+1720   compare *first-type, 5/screen
+1721   {
+1722     break-if-=
+1723     error trace, "first arg for 'pixel' is not a screen"
+1724     return
+1725   }
+1726   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+1727   var _screen/eax: (addr screen) <- lookup *screen-ah
+1728   var screen/edi: (addr screen) <- copy _screen
+1729   # x = args->right->left->value
+1730   var rest-ah/eax: (addr handle cell) <- get args, right
+1731   var _rest/eax: (addr cell) <- lookup *rest-ah
+1732   var rest/esi: (addr cell) <- copy _rest
+1733   {
+1734     var rest-type/ecx: (addr int) <- get rest, type
+1735     compare *rest-type, 0/pair
+1736     break-if-=
+1737     error trace, "'pixel' encountered non-pair"
+1738     return
+1739   }
+1740   {
+1741     var rest-nil?/eax: boolean <- nil? rest
+1742     compare rest-nil?, 0/false
+1743     break-if-=
+1744     error trace, "'pixel' needs 4 args but got 1"
+1745     return
+1746   }
+1747   var second-ah/eax: (addr handle cell) <- get rest, left
+1748   var second/eax: (addr cell) <- lookup *second-ah
+1749   var second-type/ecx: (addr int) <- get second, type
+1750   compare *second-type, 1/number
+1751   {
+1752     break-if-=
+1753     error trace, "second arg for 'pixel' is not an int (x coordinate)"
+1754     return
+1755   }
+1756   var second-value/eax: (addr float) <- get second, number-data
+1757   var x/edx: int <- convert *second-value
+1758   # y = rest->right->left->value
+1759   var rest-ah/eax: (addr handle cell) <- get rest, right
+1760   var _rest/eax: (addr cell) <- lookup *rest-ah
+1761   rest <- copy _rest
+1762   {
+1763     var rest-type/ecx: (addr int) <- get rest, type
+1764     compare *rest-type, 0/pair
+1765     break-if-=
+1766     error trace, "'pixel' encountered non-pair"
+1767     return
+1768   }
+1769   {
+1770     var rest-nil?/eax: boolean <- nil? rest
+1771     compare rest-nil?, 0/false
+1772     break-if-=
+1773     error trace, "'pixel' needs 4 args but got 2"
+1774     return
+1775   }
+1776   var third-ah/eax: (addr handle cell) <- get rest, left
+1777   var third/eax: (addr cell) <- lookup *third-ah
+1778   var third-type/ecx: (addr int) <- get third, type
+1779   compare *third-type, 1/number
+1780   {
+1781     break-if-=
+1782     error trace, "third arg for 'pixel' is not an int (y coordinate)"
+1783     return
+1784   }
+1785   var third-value/eax: (addr float) <- get third, number-data
+1786   var y/ebx: int <- convert *third-value
+1787   # color = rest->right->left->value
+1788   var rest-ah/eax: (addr handle cell) <- get rest, right
+1789   var _rest/eax: (addr cell) <- lookup *rest-ah
+1790   rest <- copy _rest
+1791   {
+1792     var rest-type/ecx: (addr int) <- get rest, type
+1793     compare *rest-type, 0/pair
+1794     break-if-=
+1795     error trace, "'pixel' encountered non-pair"
+1796     return
+1797   }
+1798   {
+1799     var rest-nil?/eax: boolean <- nil? rest
+1800     compare rest-nil?, 0/false
+1801     break-if-=
+1802     error trace, "'pixel' needs 4 args but got 3"
+1803     return
+1804   }
+1805   var fourth-ah/eax: (addr handle cell) <- get rest, left
+1806   var fourth/eax: (addr cell) <- lookup *fourth-ah
+1807   var fourth-type/ecx: (addr int) <- get fourth, type
+1808   compare *fourth-type, 1/number
+1809   {
+1810     break-if-=
+1811     error trace, "fourth arg for 'pixel' is not an int (color; 0..0xff)"
+1812     return
+1813   }
+1814   var fourth-value/eax: (addr float) <- get fourth, number-data
+1815   var color/eax: int <- convert *fourth-value
+1816   pixel screen, x, y, color
+1817   # return nothing
+1818 }
+1819 
+1820 fn apply-wait-for-key _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1821   trace-text trace, "eval", "apply 'key'"
+1822   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1823   var _args/eax: (addr cell) <- lookup *args-ah
+1824   var args/esi: (addr cell) <- copy _args
+1825   {
+1826     var args-type/ecx: (addr int) <- get args, type
+1827     compare *args-type, 0/pair
+1828     break-if-=
+1829     error trace, "args to 'key' are not a list"
+1830     return
+1831   }
+1832   var empty-args?/eax: boolean <- nil? args
+1833   compare empty-args?, 0/false
+1834   {
+1835     break-if-=
+1836     error trace, "'key' needs 1 arg but got 0"
+1837     return
+1838   }
+1839   # keyboard = args->left
+1840   var first-ah/eax: (addr handle cell) <- get args, left
+1841   var first/eax: (addr cell) <- lookup *first-ah
+1842   var first-type/ecx: (addr int) <- get first, type
+1843   compare *first-type, 6/keyboard
+1844   {
+1845     break-if-=
+1846     error trace, "first arg for 'key' is not a keyboard"
+1847     return
+1848   }
+1849   var keyboard-ah/eax: (addr handle gap-buffer) <- get first, keyboard-data
+1850   var _keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
+1851   var keyboard/ecx: (addr gap-buffer) <- copy _keyboard
+1852   var result/eax: int <- wait-for-key keyboard
+1853   # return key typed
+1854   new-integer out, result
+1855 }
+1856 
+1857 fn wait-for-key keyboard: (addr gap-buffer) -> _/eax: int {
+1858   # if keyboard is 0, use real keyboard
+1859   {
+1860     compare keyboard, 0/real-keyboard
+1861     break-if-!=
+1862     var key/eax: byte <- read-key 0/real-keyboard
+1863     var result/eax: int <- copy key
+1864     return result
+1865   }
+1866   # otherwise read from fake keyboard
+1867   var g/eax: grapheme <- read-from-gap-buffer keyboard
+1868   var result/eax: int <- copy g
+1869   return result
+1870 }
+1871 
+1872 fn apply-stream _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1873   trace-text trace, "eval", "apply stream"
+1874   allocate-stream out
+1875 }
+1876 
+1877 fn apply-write _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1878   trace-text trace, "eval", "apply 'write'"
+1879   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1880   var _args/eax: (addr cell) <- lookup *args-ah
+1881   var args/esi: (addr cell) <- copy _args
+1882   {
+1883     var args-type/ecx: (addr int) <- get args, type
+1884     compare *args-type, 0/pair
+1885     break-if-=
+1886     error trace, "args to 'write' are not a list"
+1887     return
+1888   }
+1889   var empty-args?/eax: boolean <- nil? args
+1890   compare empty-args?, 0/false
+1891   {
+1892     break-if-=
+1893     error trace, "'write' needs 2 args but got 0"
+1894     return
+1895   }
+1896   # stream = args->left
+1897   var first-ah/edx: (addr handle cell) <- get args, left
+1898   var first/eax: (addr cell) <- lookup *first-ah
+1899   var first-type/ecx: (addr int) <- get first, type
+1900   compare *first-type, 3/stream
+1901   {
+1902     break-if-=
+1903     error trace, "first arg for 'write' is not a stream"
+1904     return
+1905   }
+1906   var stream-data-ah/eax: (addr handle stream byte) <- get first, text-data
+1907   var _stream-data/eax: (addr stream byte) <- lookup *stream-data-ah
+1908   var stream-data/ebx: (addr stream byte) <- copy _stream-data
+1909   # args->right->left
+1910   var right-ah/eax: (addr handle cell) <- get args, right
+1911   var right/eax: (addr cell) <- lookup *right-ah
+1912   {
+1913     var right-type/ecx: (addr int) <- get right, type
+1914     compare *right-type, 0/pair
+1915     break-if-=
+1916     error trace, "'write' encountered non-pair"
+1917     return
+1918   }
+1919   {
+1920     var nil?/eax: boolean <- nil? right
+1921     compare nil?, 0/false
+1922     break-if-=
+1923     error trace, "'write' needs 2 args but got 1"
+1924     return
+1925   }
+1926   var second-ah/eax: (addr handle cell) <- get right, left
+1927   var second/eax: (addr cell) <- lookup *second-ah
+1928   var second-type/ecx: (addr int) <- get second, type
+1929   compare *second-type, 1/number
+1930   {
+1931     break-if-=
+1932     error trace, "second arg for 'write' is not a number/grapheme"
+1933     return
+1934   }
+1935   var second-value/eax: (addr float) <- get second, number-data
+1936   var x-float/xmm0: float <- copy *second-value
+1937   var x/eax: int <- convert x-float
+1938   var x-grapheme/eax: grapheme <- copy x
+1939   write-grapheme stream-data, x-grapheme
+1940   # return the stream
+1941   copy-object first-ah, out
+1942 }
+1943 
+1944 fn apply-lines _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1945   trace-text trace, "eval", "apply 'lines'"
+1946   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1947   var _args/eax: (addr cell) <- lookup *args-ah
+1948   var args/esi: (addr cell) <- copy _args
+1949   {
+1950     var args-type/ecx: (addr int) <- get args, type
+1951     compare *args-type, 0/pair
+1952     break-if-=
+1953     error trace, "args to 'lines' are not a list"
+1954     return
+1955   }
+1956   var empty-args?/eax: boolean <- nil? args
+1957   compare empty-args?, 0/false
+1958   {
+1959     break-if-=
+1960     error trace, "'lines' needs 1 arg but got 0"
+1961     return
+1962   }
+1963   # screen = args->left
+1964   var first-ah/eax: (addr handle cell) <- get args, left
+1965   var first/eax: (addr cell) <- lookup *first-ah
+1966   var first-type/ecx: (addr int) <- get first, type
+1967   compare *first-type, 5/screen
+1968   {
+1969     break-if-=
+1970     error trace, "first arg for 'lines' is not a screen"
+1971     return
+1972   }
+1973   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+1974   var _screen/eax: (addr screen) <- lookup *screen-ah
+1975   var screen/edx: (addr screen) <- copy _screen
+1976   # compute dimensions
+1977   var dummy/eax: int <- copy 0
+1978   var height/ecx: int <- copy 0
+1979   dummy, height <- screen-size screen
+1980   var result/xmm0: float <- convert height
+1981   new-float out, result
+1982 }
+1983 
+1984 fn apply-abort _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1985   abort "aa"
+1986 }
+1987 
+1988 fn apply-columns _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1989   trace-text trace, "eval", "apply 'columns'"
+1990   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1991   var _args/eax: (addr cell) <- lookup *args-ah
+1992   var args/esi: (addr cell) <- copy _args
+1993   {
+1994     var args-type/ecx: (addr int) <- get args, type
+1995     compare *args-type, 0/pair
+1996     break-if-=
+1997     error trace, "args to 'columns' are not a list"
+1998     return
+1999   }
+2000   var empty-args?/eax: boolean <- nil? args
+2001   compare empty-args?, 0/false
+2002   {
+2003     break-if-=
+2004     error trace, "'columns' needs 1 arg but got 0"
+2005     return
+2006   }
+2007   # screen = args->left
+2008   var first-ah/eax: (addr handle cell) <- get args, left
+2009   var first/eax: (addr cell) <- lookup *first-ah
+2010   var first-type/ecx: (addr int) <- get first, type
+2011   compare *first-type, 5/screen
+2012   {
+2013     break-if-=
+2014     error trace, "first arg for 'columns' is not a screen"
+2015     return
+2016   }
+2017   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+2018   var _screen/eax: (addr screen) <- lookup *screen-ah
+2019   var screen/edx: (addr screen) <- copy _screen
+2020   # compute dimensions
+2021   var width/eax: int <- copy 0
+2022   var dummy/ecx: int <- copy 0
+2023   width, dummy <- screen-size screen
+2024   var result/xmm0: float <- convert width
+2025   new-float out, result
+2026 }
+2027 
+2028 fn apply-width _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+2029   trace-text trace, "eval", "apply 'width'"
+2030   var args-ah/eax: (addr handle cell) <- copy _args-ah
+2031   var _args/eax: (addr cell) <- lookup *args-ah
+2032   var args/esi: (addr cell) <- copy _args
+2033   {
+2034     var args-type/ecx: (addr int) <- get args, type
+2035     compare *args-type, 0/pair
+2036     break-if-=
+2037     error trace, "args to 'width' are not a list"
+2038     return
+2039   }
+2040   var empty-args?/eax: boolean <- nil? args
+2041   compare empty-args?, 0/false
+2042   {
+2043     break-if-=
+2044     error trace, "'width' needs 1 arg but got 0"
+2045     return
+2046   }
+2047   # screen = args->left
+2048   var first-ah/eax: (addr handle cell) <- get args, left
+2049   var first/eax: (addr cell) <- lookup *first-ah
+2050   var first-type/ecx: (addr int) <- get first, type
+2051   compare *first-type, 5/screen
+2052   {
+2053     break-if-=
+2054     error trace, "first arg for 'width' is not a screen"
+2055     return
+2056   }
+2057   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+2058   var _screen/eax: (addr screen) <- lookup *screen-ah
+2059   var screen/edx: (addr screen) <- copy _screen
+2060   # compute dimensions
+2061   var width/eax: int <- copy 0
+2062   var dummy/ecx: int <- copy 0
+2063   width, dummy <- screen-size screen
+2064   width <- shift-left 3/log2-font-width
+2065   var result/xmm0: float <- convert width
+2066   new-float out, result
+2067 }
+2068 
+2069 fn apply-height _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+2070   trace-text trace, "eval", "apply 'height'"
+2071   var args-ah/eax: (addr handle cell) <- copy _args-ah
+2072   var _args/eax: (addr cell) <- lookup *args-ah
+2073   var args/esi: (addr cell) <- copy _args
+2074   {
+2075     var args-type/ecx: (addr int) <- get args, type
+2076     compare *args-type, 0/pair
+2077     break-if-=
+2078     error trace, "args to 'height' are not a list"
+2079     return
+2080   }
+2081   var empty-args?/eax: boolean <- nil? args
+2082   compare empty-args?, 0/false
+2083   {
+2084     break-if-=
+2085     error trace, "'height' needs 1 arg but got 0"
+2086     return
+2087   }
+2088   # screen = args->left
+2089   var first-ah/eax: (addr handle cell) <- get args, left
+2090   var first/eax: (addr cell) <- lookup *first-ah
+2091   var first-type/ecx: (addr int) <- get first, type
+2092   compare *first-type, 5/screen
+2093   {
+2094     break-if-=
+2095     error trace, "first arg for 'height' is not a screen"
+2096     return
+2097   }
+2098   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+2099   var _screen/eax: (addr screen) <- lookup *screen-ah
+2100   var screen/edx: (addr screen) <- copy _screen
+2101   # compute dimensions
+2102   var dummy/eax: int <- copy 0
+2103   var height/ecx: int <- copy 0
+2104   dummy, height <- screen-size screen
+2105   height <- shift-left 4/log2-font-height
+2106   var result/xmm0: float <- convert height
+2107   new-float out, result
+2108 }

diff --git a/html/shell/print.mu.html b/html/shell/print.mu.html index b528a799..0976b4f3 100644 --- a/html/shell/print.mu.html +++ b/html/shell/print.mu.html @@ -197,14 +197,14 @@ if ('onhashchange' in window) { 133 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, 0xc5/bg=blue-bg 134 } 135 -136 fn dump-cell-from-cursor-over-full-screen in-ah: (addr handle cell) { +136 fn dump-cell-from-cursor-over-full-screen in-ah: (addr handle cell), fg: int, bg: int { 137 var stream-storage: (stream byte 0x200) 138 var stream/edx: (addr stream byte) <- address stream-storage 139 var trace-storage: trace 140 var trace/edi: (addr trace) <- address trace-storage 141 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible 142 print-cell in-ah, stream, trace -143 draw-stream-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, stream, 7/fg, 0/bg +143 draw-stream-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, stream, fg, bg 144 } 145 146 fn print-symbol _in: (addr cell), out: (addr stream byte), trace: (addr trace) { @@ -281,7 +281,7 @@ if ('onhashchange' in window) { 217 } 218 var in/esi: (addr cell) <- copy _in 219 var val/eax: (addr float) <- get in, number-data -220 write-float-decimal-approximate out, *val, 3/precision +220 write-float-decimal-approximate out, *val, 0x10/precision 221 # trace 222 { 223 var should-trace?/eax: boolean <- should-trace? trace @@ -292,7 +292,7 @@ if ('onhashchange' in window) { 228 var stream-storage: (stream byte 0x40) 229 var stream/ecx: (addr stream byte) <- address stream-storage 230 write stream, "=> number " -231 write-float-decimal-approximate stream, *val, 3/precision +231 write-float-decimal-approximate stream, *val, 0x10/precision 232 trace trace, "print", stream 233 } 234 diff --git a/html/shell/read.mu.html b/html/shell/read.mu.html index e7ce90fd..3a86a52c 100644 --- a/html/shell/read.mu.html +++ b/html/shell/read.mu.html @@ -18,6 +18,7 @@ a { color:inherit; } .muRegEcx { color: #af875f; } .Special { color: #ff6060; } .LineNr { } +.muRegEdx { color: #878700; } .Constant { color: #008787; } .muRegEax { color: #875f00; } .Delimiter { color: #c000c0; } @@ -59,21 +60,29 @@ if ('onhashchange' in window) { https://github.com/akkartik/mu/blob/main/shell/read.mu

  1 fn read-cell in: (addr gap-buffer), out: (addr handle cell), trace: (addr trace) {
- 2   # TODO: we may be able to generate tokens lazily and drop this stream.
- 3   # Depends on how we implement indent-sensitivity and infix.
- 4   var tokens-storage: (stream cell 0x400)
- 5   var tokens/ecx: (addr stream cell) <- address tokens-storage
- 6   tokenize in, tokens, trace
- 7   var error?/eax: boolean <- has-errors? trace
- 8   compare error?, 0/false
- 9   {
-10     break-if-=
-11     return
-12   }
-13   # TODO: insert parens
-14   # TODO: transform infix
-15   parse-input tokens, out, trace
-16 }
+ 2   # eagerly tokenize everything so that the phases are easier to see in the trace
+ 3   var tokens-storage: (stream token 0x400)
+ 4   var tokens/edx: (addr stream token) <- address tokens-storage
+ 5   tokenize in, tokens, trace
+ 6   var error?/eax: boolean <- has-errors? trace
+ 7   compare error?, 0/false
+ 8   {
+ 9     break-if-=
+10     return
+11   }
+12   # insert more parens based on indentation
+13   var parenthesized-tokens-storage: (stream token 0x400)
+14   var parenthesized-tokens/ecx: (addr stream token) <- address parenthesized-tokens-storage
+15   parenthesize tokens, parenthesized-tokens, trace
+16   var error?/eax: boolean <- has-errors? trace
+17   compare error?, 0/false
+18   {
+19     break-if-=
+20     return
+21   }
+22   parse-input parenthesized-tokens, out, trace
+23   transform-infix out, trace
+24 }

diff --git a/html/shell/sandbox.mu.html b/html/shell/sandbox.mu.html index f0760df1..8c811c5e 100644 --- a/html/shell/sandbox.mu.html +++ b/html/shell/sandbox.mu.html @@ -137,9 +137,9 @@ if ('onhashchange' in window) { 71 break-if-!= 72 return 73 } - 74 write out, " (sandbox . " + 74 write out, " (sandbox . [" 75 append-gap-buffer data, out - 76 write out, ")\n" + 76 write out, "])\n" 77 } 78 79 ## @@ -599,7 +599,7 @@ if ('onhashchange' in window) { 533 break-if-= 534 var data-ah/eax: (addr handle gap-buffer) <- get self, data 535 var data/eax: (addr gap-buffer) <- lookup *data-ah - 536 edit-gap-buffer data, key + 536 edit-gap-buffer data, key 537 return 538 } 539 # if cursor in keyboard, send key to keyboard @@ -622,7 +622,7 @@ if ('onhashchange' in window) { 556 } 557 var keyboard-ah/eax: (addr handle gap-buffer) <- get inner-keyboard-var, keyboard-data 558 var keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah - 559 edit-gap-buffer keyboard, key + 559 edit-gap-buffer keyboard, key 560 return 561 } 562 # if cursor in trace, send key to trace @@ -750,9 +750,9 @@ if ('onhashchange' in window) { 684 # 685 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor 686 # skip one line of padding - 687 check-screen-row screen, 1/y, " 1a ", "F - test-run-error-invalid-integer/0" - 688 check-screen-row screen, 2/y, " ... ", "F - test-run-error-invalid-integer/1" - 689 check-screen-row-in-color screen, 0xc/fg=error, 3/y, " invalid number ", "F - test-run-error-invalid-integer/2" + 687 check-screen-row screen, 1/y, " 1a ", "F - test-run-error-invalid-integer/0" + 688 check-screen-row screen, 2/y, " ... ", "F - test-run-error-invalid-integer/1" + 689 check-screen-row-in-color screen, 0xc/fg=error, 3/y, " unbound symbol: 1a ", "F - test-run-error-invalid-integer/2" 690 } 691 692 fn test-run-error-unknown-symbol { @@ -1025,8 +1025,8 @@ if ('onhashchange' in window) { 959 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ||||||", "F - test-run-expand-trace/expand-1/cursor" 960 check-screen-row screen, 3/y, " ... ", "F - test-run-expand-trace/expand-2" 961 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-expand-trace/expand-2/cursor" - 962 check-screen-row screen, 4/y, " 1 pars", "F - test-run-expand-trace/expand-2" - 963 check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, " ", "F - test-run-expand-trace/expand-2/cursor" + 962 check-screen-row screen, 4/y, " 1 inse", "F - test-run-expand-trace/expand-3" + 963 check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, " ", "F - test-run-expand-trace/expand-3/cursor" 964 } 965 966 fn test-run-can-rerun-when-expanding-trace { @@ -1072,7 +1072,7 @@ if ('onhashchange' in window) { 1006 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ||||||", "F - test-run-can-rerun-when-expanding-trace/pre2-1/cursor" 1007 check-screen-row screen, 3/y, " ... ", "F - test-run-can-rerun-when-expanding-trace/pre2-2" 1008 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-can-rerun-when-expanding-trace/pre2-2/cursor" -1009 check-screen-row screen, 4/y, " 1 pars", "F - test-run-can-rerun-when-expanding-trace/pre2-2" +1009 check-screen-row screen, 4/y, " 1 inse", "F - test-run-can-rerun-when-expanding-trace/pre2-2" 1010 check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, " ", "F - test-run-can-rerun-when-expanding-trace/pre2-2/cursor" 1011 # move cursor down and expand 1012 edit-sandbox sandbox, 0x6a/j, 0/no-globals, 0/no-disk @@ -1090,111 +1090,139 @@ if ('onhashchange' in window) { 1024 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ||||||", "F - test-run-can-rerun-when-expanding-trace/expand-2/cursor" 1025 check-screen-row screen, 4/y, " ... ", "F - test-run-can-rerun-when-expanding-trace/expand-3" 1026 check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, " ", "F - test-run-can-rerun-when-expanding-trace/expand-3/cursor" -1027 check-screen-row screen, 5/y, " 2 => 1", "F - test-run-can-rerun-when-expanding-trace/expand-4" +1027 check-screen-row screen, 5/y, " 2 next", "F - test-run-can-rerun-when-expanding-trace/expand-4" 1028 check-background-color-in-screen-row screen, 7/bg=cursor, 5/y, " ", "F - test-run-can-rerun-when-expanding-trace/expand-4/cursor" -1029 } -1030 -1031 fn test-run-preserves-trace-view-on-rerun { -1032 var sandbox-storage: sandbox -1033 var sandbox/esi: (addr sandbox) <- address sandbox-storage -1034 # initialize sandbox with a max-depth of 3 -1035 initialize-sandbox-with sandbox, "7" -1036 # eval -1037 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk -1038 # setup: screen -1039 var screen-on-stack: screen -1040 var screen/edi: (addr screen) <- address screen-on-stack -1041 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics -1042 # -1043 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor -1044 # skip one line of padding -1045 check-screen-row screen, 1/y, " 7 ", "F - test-run-preserves-trace-view-on-rerun/pre0-0" -1046 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " | ", "F - test-run-preserves-trace-view-on-rerun/pre0-0/cursor" -1047 check-screen-row screen, 2/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre0-1" -1048 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre0-1/cursor" -1049 check-screen-row screen, 3/y, " => 7 ", "F - test-run-preserves-trace-view-on-rerun/pre0-2" -1050 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre0-2/cursor" -1051 # move cursor into trace -1052 edit-sandbox sandbox, 0xd/ctrl-m, 0/no-globals, 0/no-disk -1053 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor -1054 # -1055 check-screen-row screen, 1/y, " 7 ", "F - test-run-preserves-trace-view-on-rerun/pre1-0" -1056 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre1-0/cursor" -1057 check-screen-row screen, 2/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre1-1" -1058 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ||| ", "F - test-run-preserves-trace-view-on-rerun/pre1-1/cursor" -1059 check-screen-row screen, 3/y, " => 7 ", "F - test-run-preserves-trace-view-on-rerun/pre1-2" -1060 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre1-2/cursor" -1061 # expand -1062 edit-sandbox sandbox, 0xa/newline, 0/no-globals, 0/no-disk -1063 clear-screen screen -1064 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor -1065 # -1066 check-screen-row screen, 1/y, " 7 ", "F - test-run-preserves-trace-view-on-rerun/pre2-0" -1067 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre2-0/cursor" -1068 check-screen-row screen, 2/y, " 1 tokenize ", "F - test-run-preserves-trace-view-on-rerun/pre2-1" -1069 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " |||||||||| ", "F - test-run-preserves-trace-view-on-rerun/pre2-1/cursor" -1070 check-screen-row screen, 3/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre2-2" -1071 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre2-2/cursor" -1072 check-screen-row screen, 4/y, " 1 parse ", "F - test-run-preserves-trace-view-on-rerun/pre2-3" -1073 check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre2-3/cursor" -1074 check-screen-row screen, 5/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre2-4" -1075 check-background-color-in-screen-row screen, 7/bg=cursor, 5/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre2-4/cursor" -1076 check-screen-row screen, 6/y, " 1 macroexpand 7 ", "F - test-run-preserves-trace-view-on-rerun/pre2-5" -1077 check-background-color-in-screen-row screen, 7/bg=cursor, 6/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre2-5/cursor" -1078 check-screen-row screen, 7/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre2-6" -1079 check-background-color-in-screen-row screen, 7/bg=cursor, 7/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre2-6/cursor" -1080 check-screen-row screen, 8/y, " 1 => 7 ", "F - test-run-preserves-trace-view-on-rerun/pre2-7" -1081 check-background-color-in-screen-row screen, 7/bg=cursor, 8/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre2-7/cursor" -1082 # move cursor down below the macroexpand line and expand -1083 edit-sandbox sandbox, 0x6a/j, 0/no-globals, 0/no-disk -1084 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor -1085 edit-sandbox sandbox, 0x6a/j, 0/no-globals, 0/no-disk -1086 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor -1087 edit-sandbox sandbox, 0x6a/j, 0/no-globals, 0/no-disk -1088 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor -1089 edit-sandbox sandbox, 0x6a/j, 0/no-globals, 0/no-disk -1090 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor -1091 edit-sandbox sandbox, 0x6a/j, 0/no-globals, 0/no-disk -1092 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor -1093 # -1094 check-screen-row screen, 1/y, " 7 ", "F - test-run-preserves-trace-view-on-rerun/pre3-0" -1095 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre3-0/cursor" -1096 check-screen-row screen, 2/y, " 1 tokenize ", "F - test-run-preserves-trace-view-on-rerun/pre3-1" -1097 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre3-1/cursor" -1098 check-screen-row screen, 3/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre3-2" -1099 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre3-2/cursor" -1100 check-screen-row screen, 4/y, " 1 parse ", "F - test-run-preserves-trace-view-on-rerun/pre3-3" -1101 check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre3-3/cursor" -1102 check-screen-row screen, 5/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre3-4" -1103 check-background-color-in-screen-row screen, 7/bg=cursor, 5/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre3-4/cursor" -1104 check-screen-row screen, 6/y, " 1 macroexpand 7 ", "F - test-run-preserves-trace-view-on-rerun/pre3-5" -1105 check-background-color-in-screen-row screen, 7/bg=cursor, 6/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre3-5/cursor" -1106 check-screen-row screen, 7/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre3-6" -1107 check-background-color-in-screen-row screen, 7/bg=cursor, 7/y, " ||| ", "F - test-run-preserves-trace-view-on-rerun/pre3-6/cursor" -1108 check-screen-row screen, 8/y, " 1 => 7 ", "F - test-run-preserves-trace-view-on-rerun/pre3-7" -1109 check-background-color-in-screen-row screen, 7/bg=cursor, 8/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre3-7/cursor" -1110 # expand -1111 edit-sandbox sandbox, 0xa/newline, 0/no-globals, 0/no-disk -1112 clear-screen screen -1113 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor -1114 # cursor line is expanded -1115 check-screen-row screen, 1/y, " 7 ", "F - test-run-preserves-trace-view-on-rerun/expand-0" -1116 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-run-preserves-trace-view-on-rerun/expand-0/cursor" -1117 check-screen-row screen, 2/y, " 1 tokenize ", "F - test-run-preserves-trace-view-on-rerun/expand-1" -1118 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-run-preserves-trace-view-on-rerun/expand-1/cursor" -1119 check-screen-row screen, 3/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/expand-2" -1120 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-preserves-trace-view-on-rerun/expand-2/cursor" -1121 check-screen-row screen, 4/y, " 1 parse ", "F - test-run-preserves-trace-view-on-rerun/expand-3" -1122 check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, " ", "F - test-run-preserves-trace-view-on-rerun/expand-3/cursor" -1123 check-screen-row screen, 5/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/expand-4" -1124 check-background-color-in-screen-row screen, 7/bg=cursor, 5/y, " ", "F - test-run-preserves-trace-view-on-rerun/expand-4/cursor" -1125 check-screen-row screen, 6/y, " 1 macroexpand 7 ", "F - test-run-preserves-trace-view-on-rerun/expand-5" -1126 check-background-color-in-screen-row screen, 7/bg=cursor, 6/y, " ", "F - test-run-preserves-trace-view-on-rerun/expand-5/cursor" -1127 check-screen-row screen, 7/y, " 2 macroexpand-iter 7 ", "F - test-run-preserves-trace-view-on-rerun/expand-6" -1128 check-background-color-in-screen-row screen, 7/bg=cursor, 7/y, " |||||||||||||||||||| ", "F - test-run-preserves-trace-view-on-rerun/expand-6/cursor" -1129 check-screen-row screen, 8/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/expand-7" -1130 check-background-color-in-screen-row screen, 7/bg=cursor, 8/y, " ", "F - test-run-preserves-trace-view-on-rerun/expand-7/cursor" -1131 } +1029 check-screen-row screen, 6/y, " ... ", "F - test-run-can-rerun-when-expanding-trace/expand-5" +1030 check-background-color-in-screen-row screen, 7/bg=cursor, 6/y, " ", "F - test-run-can-rerun-when-expanding-trace/expand-5/cursor" +1031 check-screen-row screen, 7/y, " 2 => 1", "F - test-run-can-rerun-when-expanding-trace/expand-6" +1032 check-background-color-in-screen-row screen, 7/bg=cursor, 7/y, " ", "F - test-run-can-rerun-when-expanding-trace/expand-6/cursor" +1033 } +1034 +1035 fn test-run-preserves-trace-view-on-rerun { +1036 var sandbox-storage: sandbox +1037 var sandbox/esi: (addr sandbox) <- address sandbox-storage +1038 # initialize sandbox with a max-depth of 3 +1039 initialize-sandbox-with sandbox, "7" +1040 # eval +1041 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk +1042 # setup: screen +1043 var screen-on-stack: screen +1044 var screen/edi: (addr screen) <- address screen-on-stack +1045 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics +1046 # +1047 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor +1048 # skip one line of padding +1049 check-screen-row screen, 1/y, " 7 ", "F - test-run-preserves-trace-view-on-rerun/pre0-0" +1050 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " | ", "F - test-run-preserves-trace-view-on-rerun/pre0-0/cursor" +1051 check-screen-row screen, 2/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre0-1" +1052 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre0-1/cursor" +1053 check-screen-row screen, 3/y, " => 7 ", "F - test-run-preserves-trace-view-on-rerun/pre0-2" +1054 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre0-2/cursor" +1055 # move cursor into trace +1056 edit-sandbox sandbox, 0xd/ctrl-m, 0/no-globals, 0/no-disk +1057 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor +1058 # +1059 check-screen-row screen, 1/y, " 7 ", "F - test-run-preserves-trace-view-on-rerun/pre1-0" +1060 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre1-0/cursor" +1061 check-screen-row screen, 2/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre1-1" +1062 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ||| ", "F - test-run-preserves-trace-view-on-rerun/pre1-1/cursor" +1063 check-screen-row screen, 3/y, " => 7 ", "F - test-run-preserves-trace-view-on-rerun/pre1-2" +1064 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre1-2/cursor" +1065 # expand +1066 edit-sandbox sandbox, 0xa/newline, 0/no-globals, 0/no-disk +1067 clear-screen screen +1068 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor +1069 # +1070 check-screen-row screen, 1/y, " 7 ", "F - test-run-preserves-trace-view-on-rerun/pre2-0" +1071 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre2-0/cursor" +1072 check-screen-row screen, 2/y, " 1 tokenize ", "F - test-run-preserves-trace-view-on-rerun/pre2-1" +1073 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " |||||||||| ", "F - test-run-preserves-trace-view-on-rerun/pre2-1/cursor" +1074 check-screen-row screen, 3/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre2-2" +1075 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre2-2/cursor" +1076 check-screen-row screen, 4/y, " 1 insert parens ", "F - test-run-preserves-trace-view-on-rerun/pre2-3" +1077 check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre2-3/cursor" +1078 check-screen-row screen, 5/y, " 1 parse ", "F - test-run-preserves-trace-view-on-rerun/pre2-4" +1079 check-background-color-in-screen-row screen, 7/bg=cursor, 5/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre2-4/cursor" +1080 check-screen-row screen, 6/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre2-5" +1081 check-background-color-in-screen-row screen, 7/bg=cursor, 6/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre2-5/cursor" +1082 check-screen-row screen, 7/y, " 1 transform infix ", "F - test-run-preserves-trace-view-on-rerun/pre2-6" +1083 check-background-color-in-screen-row screen, 7/bg=cursor, 7/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre2-6/cursor" +1084 check-screen-row screen, 8/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre2-7" +1085 check-background-color-in-screen-row screen, 7/bg=cursor, 8/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre2-7/cursor" +1086 check-screen-row screen, 9/y, " 1 macroexpand 7 ", "F - test-run-preserves-trace-view-on-rerun/pre2-8" +1087 check-background-color-in-screen-row screen, 7/bg=cursor, 9/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre2-8/cursor" +1088 check-screen-row screen, 0xa/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre2-9" +1089 check-background-color-in-screen-row screen, 7/bg=cursor, 0xa/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre2-9/cursor" +1090 check-screen-row screen, 0xb/y, " 1 => 7 ", "F - test-run-preserves-trace-view-on-rerun/pre2-10" +1091 check-background-color-in-screen-row screen, 7/bg=cursor, 0xb/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre2-10/cursor" +1092 # move cursor down below the macroexpand line and expand +1093 edit-sandbox sandbox, 0x6a/j, 0/no-globals, 0/no-disk +1094 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor +1095 edit-sandbox sandbox, 0x6a/j, 0/no-globals, 0/no-disk +1096 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor +1097 edit-sandbox sandbox, 0x6a/j, 0/no-globals, 0/no-disk +1098 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor +1099 edit-sandbox sandbox, 0x6a/j, 0/no-globals, 0/no-disk +1100 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor +1101 edit-sandbox sandbox, 0x6a/j, 0/no-globals, 0/no-disk +1102 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor +1103 edit-sandbox sandbox, 0x6a/j, 0/no-globals, 0/no-disk +1104 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor +1105 edit-sandbox sandbox, 0x6a/j, 0/no-globals, 0/no-disk +1106 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor +1107 edit-sandbox sandbox, 0x6a/j, 0/no-globals, 0/no-disk +1108 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor +1109 # +1110 check-screen-row screen, 1/y, " 7 ", "F - test-run-preserves-trace-view-on-rerun/pre3-0" +1111 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre3-0/cursor" +1112 check-screen-row screen, 2/y, " 1 tokenize ", "F - test-run-preserves-trace-view-on-rerun/pre3-1" +1113 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre3-1/cursor" +1114 check-screen-row screen, 3/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre3-2" +1115 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre3-2/cursor" +1116 check-screen-row screen, 4/y, " 1 insert parens ", "F - test-run-preserves-trace-view-on-rerun/pre3-3" +1117 check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre3-3/cursor" +1118 check-screen-row screen, 5/y, " 1 parse ", "F - test-run-preserves-trace-view-on-rerun/pre3-4" +1119 check-background-color-in-screen-row screen, 7/bg=cursor, 5/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre3-4/cursor" +1120 check-screen-row screen, 6/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre3-5" +1121 check-background-color-in-screen-row screen, 7/bg=cursor, 6/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre3-5/cursor" +1122 check-screen-row screen, 7/y, " 1 transform infix ", "F - test-run-preserves-trace-view-on-rerun/pre3-6" +1123 check-background-color-in-screen-row screen, 7/bg=cursor, 7/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre3-6/cursor" +1124 check-screen-row screen, 8/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre3-7" +1125 check-background-color-in-screen-row screen, 7/bg=cursor, 8/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre3-7/cursor" +1126 check-screen-row screen, 9/y, " 1 macroexpand 7 ", "F - test-run-preserves-trace-view-on-rerun/pre3-8" +1127 check-background-color-in-screen-row screen, 7/bg=cursor, 9/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre3-8/cursor" +1128 check-screen-row screen, 0xa/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre3-9" +1129 check-background-color-in-screen-row screen, 7/bg=cursor, 0xa/y, " ||| ", "F - test-run-preserves-trace-view-on-rerun/pre3-9/cursor" +1130 check-screen-row screen, 0xb/y, " 1 => 7 ", "F - test-run-preserves-trace-view-on-rerun/pre3-10" +1131 check-background-color-in-screen-row screen, 7/bg=cursor, 0xb/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre3-10/cursor" +1132 # expand +1133 edit-sandbox sandbox, 0xa/newline, 0/no-globals, 0/no-disk +1134 clear-screen screen +1135 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor +1136 # cursor line is expanded +1137 check-screen-row screen, 1/y, " 7 ", "F - test-run-preserves-trace-view-on-rerun/expand-0" +1138 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-run-preserves-trace-view-on-rerun/expand-0/cursor" +1139 check-screen-row screen, 2/y, " 1 tokenize ", "F - test-run-preserves-trace-view-on-rerun/expand-1" +1140 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-run-preserves-trace-view-on-rerun/expand-1/cursor" +1141 check-screen-row screen, 3/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/expand-2" +1142 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-preserves-trace-view-on-rerun/expand-2/cursor" +1143 check-screen-row screen, 4/y, " 1 insert parens ", "F - test-run-preserves-trace-view-on-rerun/expand-3" +1144 check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, " ", "F - test-run-preserves-trace-view-on-rerun/expand-3/cursor" +1145 check-screen-row screen, 5/y, " 1 parse ", "F - test-run-preserves-trace-view-on-rerun/expand-4" +1146 check-background-color-in-screen-row screen, 7/bg=cursor, 5/y, " ", "F - test-run-preserves-trace-view-on-rerun/expand-4/cursor" +1147 check-screen-row screen, 6/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/expand-5" +1148 check-background-color-in-screen-row screen, 7/bg=cursor, 6/y, " ", "F - test-run-preserves-trace-view-on-rerun/expand-5/cursor" +1149 check-screen-row screen, 7/y, " 1 transform infix ", "F - test-run-preserves-trace-view-on-rerun/expand-6" +1150 check-background-color-in-screen-row screen, 7/bg=cursor, 7/y, " ", "F - test-run-preserves-trace-view-on-rerun/expand-6/cursor" +1151 check-screen-row screen, 8/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/expand-7" +1152 check-background-color-in-screen-row screen, 7/bg=cursor, 8/y, " ", "F - test-run-preserves-trace-view-on-rerun/expand-7/cursor" +1153 check-screen-row screen, 9/y, " 1 macroexpand 7 ", "F - test-run-preserves-trace-view-on-rerun/expand-8" +1154 check-background-color-in-screen-row screen, 7/bg=cursor, 9/y, " ", "F - test-run-preserves-trace-view-on-rerun/expand-8/cursor" +1155 check-screen-row screen, 0xa/y, " 2 macroexpand-iter 7 ", "F - test-run-preserves-trace-view-on-rerun/expand-9" +1156 check-background-color-in-screen-row screen, 7/bg=cursor, 0xa/y, " |||||||||||||||||||| ", "F - test-run-preserves-trace-view-on-rerun/expand-9/cursor" +1157 check-screen-row screen, 0xb/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/expand-10" +1158 check-background-color-in-screen-row screen, 7/bg=cursor, 0xb/y, " ", "F - test-run-preserves-trace-view-on-rerun/expand-10/cursor" +1159 } diff --git a/html/shell/tokenize.mu.html b/html/shell/tokenize.mu.html index 39730066..fd8cff43 100644 --- a/html/shell/tokenize.mu.html +++ b/html/shell/tokenize.mu.html @@ -63,132 +63,132 @@ if ('onhashchange' in window) { https://github.com/akkartik/mu/blob/main/shell/tokenize.mu

-   1 # We reuse the cell data structure for tokenization
-   2 # Token cells are special, though. They have no type, they're always atoms,
-   3 # they always have text-data.
-   4 
-   5 fn tokenize in: (addr gap-buffer), out: (addr stream cell), trace: (addr trace) {
-   6   trace-text trace, "tokenize", "tokenize"
-   7   trace-lower trace
-   8   rewind-gap-buffer in
-   9   var token-storage: cell
-  10   var token/edx: (addr cell) <- address token-storage
-  11   {
-  12     skip-whitespace-from-gap-buffer in
-  13     var done?/eax: boolean <- gap-buffer-scan-done? in
-  14     compare done?, 0/false
-  15     break-if-!=
-  16     #
-  17     next-token in, token, trace
-  18     var error?/eax: boolean <- has-errors? trace
-  19     compare error?, 0/false
-  20     {
-  21       break-if-=
-  22       return
-  23     }
-  24     var skip?/eax: boolean <- comment-token? token
-  25     compare skip?, 0/false
-  26     loop-if-!=
-  27     write-to-stream out, token  # shallow-copy text-data
-  28     loop
-  29   }
-  30   trace-higher trace
-  31 }
-  32 
-  33 fn test-tokenize-number {
-  34   var in-storage: gap-buffer
-  35   var in/esi: (addr gap-buffer) <- address in-storage
-  36   initialize-gap-buffer-with in, "123 a"
-  37   #
-  38   var stream-storage: (stream cell 0x10)
-  39   var stream/edi: (addr stream cell) <- address stream-storage
-  40   #
-  41   var trace-storage: trace
-  42   var trace/edx: (addr trace) <- address trace-storage
-  43   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
-  44   tokenize in, stream, trace
+   1 # The language is indent-sensitive.
+   2 # Each line consists of an initial indent token followed by other tokens.
+   3 type token {
+   4   type: int
+   5   # type 0: default
+   6   # type 1: stream
+   7   text-data: (handle stream byte)
+   8   # type 2: skip (end of line or end of file)
+   9   # type 3: indent
+  10   number-data: int
+  11 }
+  12 
+  13 fn tokenize in: (addr gap-buffer), out: (addr stream token), trace: (addr trace) {
+  14   trace-text trace, "tokenize", "tokenize"
+  15   trace-lower trace
+  16   rewind-gap-buffer in
+  17   var at-start-of-line?/edi: boolean <- copy 1/true
+  18   {
+  19     var done?/eax: boolean <- gap-buffer-scan-done? in
+  20     compare done?, 0/false
+  21     break-if-!=
+  22     #
+  23     var token-storage: token
+  24     var token/edx: (addr token) <- address token-storage
+  25     at-start-of-line? <- next-token in, token, at-start-of-line?, trace
+  26     var error?/eax: boolean <- has-errors? trace
+  27     compare error?, 0/false
+  28     {
+  29       break-if-=
+  30       return
+  31     }
+  32     var skip?/eax: boolean <- skip-token? token
+  33     compare skip?, 0/false
+  34     loop-if-!=
+  35     write-to-stream out, token  # shallow-copy text-data
+  36     loop
+  37   }
+  38   trace-higher trace
+  39 }
+  40 
+  41 fn test-tokenize-number {
+  42   var in-storage: gap-buffer
+  43   var in/esi: (addr gap-buffer) <- address in-storage
+  44   initialize-gap-buffer-with in, "123 a"
   45   #
-  46   var curr-token-storage: cell
-  47   var curr-token/ebx: (addr cell) <- address curr-token-storage
-  48   read-from-stream stream, curr-token
-  49   var number?/eax: boolean <- number-token? curr-token
-  50   check number?, "F - test-tokenize-number"
-  51   var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data
-  52   var curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah
-  53   check-stream-equal curr-token-data, "123", "F - test-tokenize-number: value"
-  54 }
-  55 
-  56 fn test-tokenize-negative-number {
-  57   var in-storage: gap-buffer
-  58   var in/esi: (addr gap-buffer) <- address in-storage
-  59   initialize-gap-buffer-with in, "-123 a"
-  60   #
-  61   var stream-storage: (stream cell 0x10)
-  62   var stream/edi: (addr stream cell) <- address stream-storage
-  63   #
-  64   var trace-storage: trace
-  65   var trace/edx: (addr trace) <- address trace-storage
-  66   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
-  67   tokenize in, stream, trace
-  68   #
-  69   var curr-token-storage: cell
-  70   var curr-token/ebx: (addr cell) <- address curr-token-storage
-  71   read-from-stream stream, curr-token
-  72   var number?/eax: boolean <- number-token? curr-token
-  73   check number?, "F - test-tokenize-negative-number"
-  74   var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data
-  75   var curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah
-  76   check-stream-equal curr-token-data, "-123", "F - test-tokenize-negative-number: value"
-  77 }
-  78 
-  79 fn test-tokenize-number-followed-by-hyphen {
-  80   var in-storage: gap-buffer
-  81   var in/esi: (addr gap-buffer) <- address in-storage
-  82   initialize-gap-buffer-with in, "123-4 a"
-  83   #
-  84   var stream-storage: (stream cell 0x10)
-  85   var stream/edi: (addr stream cell) <- address stream-storage
-  86   #
-  87   var trace-storage: trace
-  88   var trace/edx: (addr trace) <- address trace-storage
-  89   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
-  90   tokenize in, stream, trace
-  91   #
-  92   var curr-token-storage: cell
-  93   var curr-token/ebx: (addr cell) <- address curr-token-storage
-  94   read-from-stream stream, curr-token
-  95   var number?/eax: boolean <- number-token? curr-token
-  96   check number?, "F - test-tokenize-number-followed-by-hyphen"
-  97   var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data
-  98   var curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah
-  99   check-stream-equal curr-token-data, "123", "F - test-tokenize-number-followed-by-hyphen: value"
- 100 }
- 101 
- 102 fn test-tokenize-quote {
- 103   var in-storage: gap-buffer
- 104   var in/esi: (addr gap-buffer) <- address in-storage
- 105   initialize-gap-buffer-with in, "'(a)"
- 106   #
- 107   var stream-storage: (stream cell 0x10)
- 108   var stream/edi: (addr stream cell) <- address stream-storage
+  46   var stream-storage: (stream token 0x10)
+  47   var stream/edi: (addr stream token) <- address stream-storage
+  48   #
+  49   var trace-storage: trace
+  50   var trace/edx: (addr trace) <- address trace-storage
+  51   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+  52   tokenize in, stream, trace
+  53   #
+  54   var curr-token-storage: token
+  55   var curr-token/ebx: (addr token) <- address curr-token-storage
+  56   read-from-stream stream, curr-token
+  57   var curr-token-type/eax: (addr int) <- get curr-token, type
+  58   check-ints-equal *curr-token-type, 3/indent, "F - test-tokenize-number/before-indent-type"
+  59   var curr-token-data/eax: (addr int) <- get curr-token, number-data
+  60   check-ints-equal *curr-token-data, 0/spaces, "F - test-tokenize-number/before-indent"
+  61   read-from-stream stream, curr-token
+  62   var number?/eax: boolean <- number-token? curr-token
+  63   check number?, "F - test-tokenize-number"
+  64   var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data
+  65   var curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah
+  66   check-stream-equal curr-token-data, "123", "F - test-tokenize-number: value"
+  67 }
+  68 
+  69 fn test-tokenize-negative-number {
+  70   var in-storage: gap-buffer
+  71   var in/esi: (addr gap-buffer) <- address in-storage
+  72   initialize-gap-buffer-with in, "-123 a"
+  73   #
+  74   var stream-storage: (stream token 0x10)
+  75   var stream/edi: (addr stream token) <- address stream-storage
+  76   #
+  77   var trace-storage: trace
+  78   var trace/edx: (addr trace) <- address trace-storage
+  79   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+  80   tokenize in, stream, trace
+  81   #
+  82   var curr-token-storage: token
+  83   var curr-token/ebx: (addr token) <- address curr-token-storage
+  84   read-from-stream stream, curr-token
+  85   var curr-token-type/eax: (addr int) <- get curr-token, type
+  86   check-ints-equal *curr-token-type, 3/indent, "F - test-tokenize-negative-number/before-indent-type"
+  87   var curr-token-data/eax: (addr int) <- get curr-token, number-data
+  88   check-ints-equal *curr-token-data, 0/spaces, "F - test-tokenize-negative-number/before-indent"
+  89   read-from-stream stream, curr-token
+  90   var number?/eax: boolean <- number-token? curr-token
+  91   check number?, "F - test-tokenize-negative-number"
+  92   var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data
+  93   var curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah
+  94   check-stream-equal curr-token-data, "-123", "F - test-tokenize-negative-number: value"
+  95 }
+  96 
+  97 fn test-tokenize-quote {
+  98   var in-storage: gap-buffer
+  99   var in/esi: (addr gap-buffer) <- address in-storage
+ 100   initialize-gap-buffer-with in, "'(a)"
+ 101   #
+ 102   var stream-storage: (stream token 0x10)
+ 103   var stream/edi: (addr stream token) <- address stream-storage
+ 104   #
+ 105   var trace-storage: trace
+ 106   var trace/edx: (addr trace) <- address trace-storage
+ 107   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+ 108   tokenize in, stream, trace
  109   #
- 110   var trace-storage: trace
- 111   var trace/edx: (addr trace) <- address trace-storage
- 112   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
- 113   tokenize in, stream, trace
- 114   #
- 115   var curr-token-storage: cell
- 116   var curr-token/ebx: (addr cell) <- address curr-token-storage
+ 110   var curr-token-storage: token
+ 111   var curr-token/ebx: (addr token) <- address curr-token-storage
+ 112   read-from-stream stream, curr-token
+ 113   var curr-token-type/eax: (addr int) <- get curr-token, type
+ 114   check-ints-equal *curr-token-type, 3/indent, "F - test-tokenize-quote/before-indent-type"
+ 115   var curr-token-data/eax: (addr int) <- get curr-token, number-data
+ 116   check-ints-equal *curr-token-data, 0/spaces, "F - test-tokenize-quote/before-indent"
  117   read-from-stream stream, curr-token
- 118   var quote?/eax: boolean <- quote-token? curr-token
- 119   check quote?, "F - test-tokenize-quote: quote"
+ 118   var quote?/eax: boolean <- quote-token? curr-token
+ 119   check quote?, "F - test-tokenize-quote: quote"
  120   read-from-stream stream, curr-token
- 121   var open-paren?/eax: boolean <- open-paren-token? curr-token
- 122   check open-paren?, "F - test-tokenize-quote: open paren"
+ 121   var open-paren?/eax: boolean <- open-paren-token? curr-token
+ 122   check open-paren?, "F - test-tokenize-quote: open paren"
  123   read-from-stream stream, curr-token  # skip a
  124   read-from-stream stream, curr-token
- 125   var close-paren?/eax: boolean <- close-paren-token? curr-token
- 126   check close-paren?, "F - test-tokenize-quote: close paren"
+ 125   var close-paren?/eax: boolean <- close-paren-token? curr-token
+ 126   check close-paren?, "F - test-tokenize-quote: close paren"
  127 }
  128 
  129 fn test-tokenize-backquote {
@@ -196,1000 +196,978 @@ if ('onhashchange' in window) {
  131   var in/esi: (addr gap-buffer) <- address in-storage
  132   initialize-gap-buffer-with in, "`(a)"
  133   #
- 134   var stream-storage: (stream cell 0x10)
- 135   var stream/edi: (addr stream cell) <- address stream-storage
+ 134   var stream-storage: (stream token 0x10)
+ 135   var stream/edi: (addr stream token) <- address stream-storage
  136   #
  137   var trace-storage: trace
  138   var trace/edx: (addr trace) <- address trace-storage
  139   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
- 140   tokenize in, stream, trace
+ 140   tokenize in, stream, trace
  141   #
- 142   var curr-token-storage: cell
- 143   var curr-token/ebx: (addr cell) <- address curr-token-storage
+ 142   var curr-token-storage: token
+ 143   var curr-token/ebx: (addr token) <- address curr-token-storage
  144   read-from-stream stream, curr-token
- 145   var backquote?/eax: boolean <- backquote-token? curr-token
- 146   check backquote?, "F - test-tokenize-backquote: backquote"
- 147   read-from-stream stream, curr-token
- 148   var open-paren?/eax: boolean <- open-paren-token? curr-token
- 149   check open-paren?, "F - test-tokenize-backquote: open paren"
- 150   read-from-stream stream, curr-token  # skip a
- 151   read-from-stream stream, curr-token
- 152   var close-paren?/eax: boolean <- close-paren-token? curr-token
- 153   check close-paren?, "F - test-tokenize-backquote: close paren"
- 154 }
- 155 
- 156 fn test-tokenize-unquote {
- 157   var in-storage: gap-buffer
- 158   var in/esi: (addr gap-buffer) <- address in-storage
- 159   initialize-gap-buffer-with in, ",(a)"
- 160   #
- 161   var stream-storage: (stream cell 0x10)
- 162   var stream/edi: (addr stream cell) <- address stream-storage
- 163   #
- 164   var trace-storage: trace
- 165   var trace/edx: (addr trace) <- address trace-storage
- 166   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
- 167   tokenize in, stream, trace
+ 145   var curr-token-type/eax: (addr int) <- get curr-token, type
+ 146   check-ints-equal *curr-token-type, 3/indent, "F - test-tokenize-backquote/before-indent-type"
+ 147   var curr-token-data/eax: (addr int) <- get curr-token, number-data
+ 148   check-ints-equal *curr-token-data, 0/spaces, "F - test-tokenize-backquote/before-indent"
+ 149   read-from-stream stream, curr-token
+ 150   var backquote?/eax: boolean <- backquote-token? curr-token
+ 151   check backquote?, "F - test-tokenize-backquote: backquote"
+ 152   read-from-stream stream, curr-token
+ 153   var open-paren?/eax: boolean <- open-paren-token? curr-token
+ 154   check open-paren?, "F - test-tokenize-backquote: open paren"
+ 155   read-from-stream stream, curr-token  # skip a
+ 156   read-from-stream stream, curr-token
+ 157   var close-paren?/eax: boolean <- close-paren-token? curr-token
+ 158   check close-paren?, "F - test-tokenize-backquote: close paren"
+ 159 }
+ 160 
+ 161 fn test-tokenize-unquote {
+ 162   var in-storage: gap-buffer
+ 163   var in/esi: (addr gap-buffer) <- address in-storage
+ 164   initialize-gap-buffer-with in, ",(a)"
+ 165   #
+ 166   var stream-storage: (stream token 0x10)
+ 167   var stream/edi: (addr stream token) <- address stream-storage
  168   #
- 169   var curr-token-storage: cell
- 170   var curr-token/ebx: (addr cell) <- address curr-token-storage
- 171   read-from-stream stream, curr-token
- 172   var unquote?/eax: boolean <- unquote-token? curr-token
- 173   check unquote?, "F - test-tokenize-unquote: unquote"
- 174   read-from-stream stream, curr-token
- 175   var open-paren?/eax: boolean <- open-paren-token? curr-token
- 176   check open-paren?, "F - test-tokenize-unquote: open paren"
- 177   read-from-stream stream, curr-token  # skip a
- 178   read-from-stream stream, curr-token
- 179   var close-paren?/eax: boolean <- close-paren-token? curr-token
- 180   check close-paren?, "F - test-tokenize-unquote: close paren"
- 181 }
- 182 
- 183 fn test-tokenize-unquote-splice {
- 184   var in-storage: gap-buffer
- 185   var in/esi: (addr gap-buffer) <- address in-storage
- 186   initialize-gap-buffer-with in, ",@a"
- 187   #
- 188   var stream-storage: (stream cell 0x10)
- 189   var stream/edi: (addr stream cell) <- address stream-storage
- 190   #
- 191   var trace-storage: trace
- 192   var trace/edx: (addr trace) <- address trace-storage
- 193   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
- 194   tokenize in, stream, trace
- 195   #
- 196   var curr-token-storage: cell
- 197   var curr-token/ebx: (addr cell) <- address curr-token-storage
- 198   read-from-stream stream, curr-token
- 199   var unquote-splice?/eax: boolean <- unquote-splice-token? curr-token
- 200   check unquote-splice?, "F - test-tokenize-unquote-splice: unquote-splice"
- 201 }
- 202 
- 203 fn test-tokenize-dotted-list {
- 204   var in-storage: gap-buffer
- 205   var in/esi: (addr gap-buffer) <- address in-storage
- 206   initialize-gap-buffer-with in, "(a . b)"
- 207   #
- 208   var stream-storage: (stream cell 0x10)
- 209   var stream/edi: (addr stream cell) <- address stream-storage
- 210   #
- 211   var trace-storage: trace
- 212   var trace/edx: (addr trace) <- address trace-storage
- 213   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
- 214   tokenize in, stream, trace
- 215   #
- 216   var curr-token-storage: cell
- 217   var curr-token/ebx: (addr cell) <- address curr-token-storage
- 218   read-from-stream stream, curr-token
- 219   var open-paren?/eax: boolean <- open-paren-token? curr-token
- 220   check open-paren?, "F - test-tokenize-dotted-list: open paren"
- 221   read-from-stream stream, curr-token  # skip a
- 222   read-from-stream stream, curr-token
- 223   var dot?/eax: boolean <- dot-token? curr-token
- 224   check dot?, "F - test-tokenize-dotted-list: dot"
- 225   read-from-stream stream, curr-token  # skip b
- 226   read-from-stream stream, curr-token
- 227   var close-paren?/eax: boolean <- close-paren-token? curr-token
- 228   check close-paren?, "F - test-tokenize-dotted-list: close paren"
- 229 }
- 230 
- 231 fn test-tokenize-stream-literal {
- 232   var in-storage: gap-buffer
- 233   var in/esi: (addr gap-buffer) <- address in-storage
- 234   initialize-gap-buffer-with in, "[abc def]"
- 235   #
- 236   var stream-storage: (stream cell 0x10)
- 237   var stream/edi: (addr stream cell) <- address stream-storage
- 238   #
- 239   var trace-storage: trace
- 240   var trace/edx: (addr trace) <- address trace-storage
- 241   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
- 242   tokenize in, stream, trace
- 243   #
- 244   var curr-token-storage: cell
- 245   var curr-token/ebx: (addr cell) <- address curr-token-storage
+ 169   var trace-storage: trace
+ 170   var trace/edx: (addr trace) <- address trace-storage
+ 171   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+ 172   tokenize in, stream, trace
+ 173   #
+ 174   var curr-token-storage: token
+ 175   var curr-token/ebx: (addr token) <- address curr-token-storage
+ 176   read-from-stream stream, curr-token
+ 177   var curr-token-type/eax: (addr int) <- get curr-token, type
+ 178   check-ints-equal *curr-token-type, 3/indent, "F - test-tokenize-unquote/before-indent-type"
+ 179   var curr-token-data/eax: (addr int) <- get curr-token, number-data
+ 180   check-ints-equal *curr-token-data, 0/spaces, "F - test-tokenize-unquote/before-indent"
+ 181   read-from-stream stream, curr-token
+ 182   var unquote?/eax: boolean <- unquote-token? curr-token
+ 183   check unquote?, "F - test-tokenize-unquote: unquote"
+ 184   read-from-stream stream, curr-token
+ 185   var open-paren?/eax: boolean <- open-paren-token? curr-token
+ 186   check open-paren?, "F - test-tokenize-unquote: open paren"
+ 187   read-from-stream stream, curr-token  # skip a
+ 188   read-from-stream stream, curr-token
+ 189   var close-paren?/eax: boolean <- close-paren-token? curr-token
+ 190   check close-paren?, "F - test-tokenize-unquote: close paren"
+ 191 }
+ 192 
+ 193 fn test-tokenize-unquote-splice {
+ 194   var in-storage: gap-buffer
+ 195   var in/esi: (addr gap-buffer) <- address in-storage
+ 196   initialize-gap-buffer-with in, ",@a"
+ 197   #
+ 198   var stream-storage: (stream token 0x10)
+ 199   var stream/edi: (addr stream token) <- address stream-storage
+ 200   #
+ 201   var trace-storage: trace
+ 202   var trace/edx: (addr trace) <- address trace-storage
+ 203   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+ 204   tokenize in, stream, trace
+ 205   #
+ 206   var curr-token-storage: token
+ 207   var curr-token/ebx: (addr token) <- address curr-token-storage
+ 208   read-from-stream stream, curr-token
+ 209   var curr-token-type/eax: (addr int) <- get curr-token, type
+ 210   check-ints-equal *curr-token-type, 3/indent, "F - test-tokenize-unquote-splice/before-indent-type"
+ 211   var curr-token-data/eax: (addr int) <- get curr-token, number-data
+ 212   check-ints-equal *curr-token-data, 0/spaces, "F - test-tokenize-unquote-splice/before-indent"
+ 213   read-from-stream stream, curr-token
+ 214   var unquote-splice?/eax: boolean <- unquote-splice-token? curr-token
+ 215   check unquote-splice?, "F - test-tokenize-unquote-splice: unquote-splice"
+ 216 }
+ 217 
+ 218 fn test-tokenize-dotted-list {
+ 219   var in-storage: gap-buffer
+ 220   var in/esi: (addr gap-buffer) <- address in-storage
+ 221   initialize-gap-buffer-with in, "(a . b)"
+ 222   #
+ 223   var stream-storage: (stream token 0x10)
+ 224   var stream/edi: (addr stream token) <- address stream-storage
+ 225   #
+ 226   var trace-storage: trace
+ 227   var trace/edx: (addr trace) <- address trace-storage
+ 228   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+ 229   tokenize in, stream, trace
+ 230   #
+ 231   var curr-token-storage: token
+ 232   var curr-token/ebx: (addr token) <- address curr-token-storage
+ 233   read-from-stream stream, curr-token
+ 234   var curr-token-type/eax: (addr int) <- get curr-token, type
+ 235   check-ints-equal *curr-token-type, 3/indent, "F - test-tokenize-dotted-list/before-indent-type"
+ 236   var curr-token-data/eax: (addr int) <- get curr-token, number-data
+ 237   check-ints-equal *curr-token-data, 0/spaces, "F - test-tokenize-dotted-list/before-indent"
+ 238   read-from-stream stream, curr-token
+ 239   var open-paren?/eax: boolean <- open-paren-token? curr-token
+ 240   check open-paren?, "F - test-tokenize-dotted-list: open paren"
+ 241   read-from-stream stream, curr-token  # skip a
+ 242   read-from-stream stream, curr-token
+ 243   var dot?/eax: boolean <- dot-token? curr-token
+ 244   check dot?, "F - test-tokenize-dotted-list: dot"
+ 245   read-from-stream stream, curr-token  # skip b
  246   read-from-stream stream, curr-token
- 247   var stream?/eax: boolean <- stream-token? curr-token
- 248   check stream?, "F - test-tokenize-stream-literal: type"
- 249   var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data
- 250   var curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah
- 251   var data-equal?/eax: boolean <- stream-data-equal? curr-token-data, "abc def"
- 252   check data-equal?, "F - test-tokenize-stream-literal"
- 253   var empty?/eax: boolean <- stream-empty? stream
- 254   check empty?, "F - test-tokenize-stream-literal: empty?"
- 255 }
- 256 
- 257 fn test-tokenize-stream-literal-in-tree {
- 258   var in-storage: gap-buffer
- 259   var in/esi: (addr gap-buffer) <- address in-storage
- 260   initialize-gap-buffer-with in, "([abc def])"
- 261   #
- 262   var stream-storage: (stream cell 0x10)
- 263   var stream/edi: (addr stream cell) <- address stream-storage
- 264   #
- 265   var trace-storage: trace
- 266   var trace/edx: (addr trace) <- address trace-storage
- 267   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
- 268   tokenize in, stream, trace
- 269   #
- 270   var curr-token-storage: cell
- 271   var curr-token/ebx: (addr cell) <- address curr-token-storage
- 272   read-from-stream stream, curr-token
- 273   var bracket?/eax: boolean <- bracket-token? curr-token
- 274   check bracket?, "F - test-tokenize-stream-literal-in-tree: open paren"
- 275   read-from-stream stream, curr-token
- 276   var stream?/eax: boolean <- stream-token? curr-token
- 277   check stream?, "F - test-tokenize-stream-literal-in-tree: type"
- 278   var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data
- 279   var curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah
- 280   var data-equal?/eax: boolean <- stream-data-equal? curr-token-data, "abc def"
- 281   check data-equal?, "F - test-tokenize-stream-literal-in-tree"
- 282   read-from-stream stream, curr-token
- 283   var bracket?/eax: boolean <- bracket-token? curr-token
- 284   check bracket?, "F - test-tokenize-stream-literal-in-tree: close paren"
- 285   var empty?/eax: boolean <- stream-empty? stream
- 286   check empty?, "F - test-tokenize-stream-literal-in-tree: empty?"
- 287 }
- 288 
- 289 fn next-token in: (addr gap-buffer), _out-cell: (addr cell), trace: (addr trace) {
- 290   trace-text trace, "tokenize", "next-token"
- 291   trace-lower trace
- 292   var _g/eax: grapheme <- peek-from-gap-buffer in
- 293   var g/ecx: grapheme <- copy _g
- 294   {
- 295     var should-trace?/eax: boolean <- should-trace? trace
- 296     compare should-trace?, 0/false
- 297     break-if-=
- 298     var stream-storage: (stream byte 0x40)
- 299     var stream/esi: (addr stream byte) <- address stream-storage
- 300     write stream, "next: "
- 301     var gval/eax: int <- copy g
- 302     write-int32-hex stream, gval
- 303     trace trace, "tokenize", stream
- 304   }
- 305   var out-cell/eax: (addr cell) <- copy _out-cell
- 306   {
- 307     var out-cell-type/eax: (addr int) <- get out-cell, type
- 308     copy-to *out-cell-type, 0/uninitialized
- 309   }
- 310   var out-ah/edi: (addr handle stream byte) <- get out-cell, text-data
- 311   $next-token:allocate: {
- 312     # Allocate a large buffer if it's a stream.
- 313     # Sometimes a whole function definition will need to fit in it.
- 314     compare g, 0x5b/open-square-bracket
- 315     {
- 316       break-if-!=
- 317       populate-stream out-ah, 0x400/max-definition-size=1KB
- 318       break $next-token:allocate
- 319     }
- 320     populate-stream out-ah, 0x40
- 321   }
- 322   var _out/eax: (addr stream byte) <- lookup *out-ah
- 323   var out/edi: (addr stream byte) <- copy _out
- 324   clear-stream out
- 325   $next-token:case: {
- 326     # open square brackets begin streams
- 327     {
- 328       compare g, 0x5b/open-square-bracket
- 329       break-if-!=
- 330       var dummy/eax: grapheme <- read-from-gap-buffer in  # skip open bracket
- 331       next-stream-token in, out, trace
- 332       var out-cell/eax: (addr cell) <- copy _out-cell
- 333       # streams set the type
- 334       var out-cell-type/eax: (addr int) <- get out-cell, type
- 335       copy-to *out-cell-type, 3/stream
- 336       break $next-token:case
- 337     }
- 338     # comment
- 339     {
- 340       compare g, 0x23/comment
- 341       break-if-!=
- 342       rest-of-line in, out, trace
- 343       break $next-token:case
- 344     }
- 345     # special-case: '-'
- 346     {
- 347       compare g, 0x2d/minus
- 348       break-if-!=
- 349       var dummy/eax: grapheme <- read-from-gap-buffer in  # skip '-'
- 350       var g2/eax: grapheme <- peek-from-gap-buffer in
- 351       put-back-from-gap-buffer in
- 352       var digit?/eax: boolean <- decimal-digit? g2
- 353       compare digit?, 0/false
- 354       break-if-=
- 355       next-number-token in, out, trace
- 356       break $next-token:case
- 357     }
- 358     # digit
- 359     {
- 360       var digit?/eax: boolean <- decimal-digit? g
- 361       compare digit?, 0/false
- 362       break-if-=
- 363       next-number-token in, out, trace
- 364       break $next-token:case
- 365     }
- 366     # other symbol char
- 367     {
- 368       var symbol?/eax: boolean <- symbol-grapheme? g
- 369       compare symbol?, 0/false
- 370       break-if-=
- 371       next-symbol-token in, out, trace
- 372       break $next-token:case
- 373     }
- 374     # unbalanced close square brackets are errors
- 375     {
- 376       compare g, 0x5d/close-square-bracket
- 377       break-if-!=
- 378       error trace, "unbalanced ']'"
- 379       return
- 380     }
- 381     # other brackets are always single-char tokens
- 382     {
- 383       var bracket?/eax: boolean <- bracket-grapheme? g
- 384       compare bracket?, 0/false
- 385       break-if-=
- 386       var g/eax: grapheme <- read-from-gap-buffer in
- 387       next-bracket-token g, out, trace
- 388       break $next-token:case
- 389     }
- 390     # non-symbol operators
- 391     {
- 392       var operator?/eax: boolean <- operator-grapheme? g
- 393       compare operator?, 0/false
- 394       break-if-=
- 395       next-operator-token in, out, trace
- 396       break $next-token:case
- 397     }
- 398     # quote
- 399     {
- 400       compare g, 0x27/single-quote
- 401       break-if-!=
- 402       var g/eax: grapheme <- read-from-gap-buffer in  # consume
- 403       write-grapheme out, g
- 404       break $next-token:case
- 405     }
- 406     # backquote
- 407     {
- 408       compare g, 0x60/backquote
- 409       break-if-!=
- 410       var g/eax: grapheme <- read-from-gap-buffer in  # consume
- 411       write-grapheme out, g
- 412       break $next-token:case
- 413     }
- 414     # unquote
+ 247   var close-paren?/eax: boolean <- close-paren-token? curr-token
+ 248   check close-paren?, "F - test-tokenize-dotted-list: close paren"
+ 249 }
+ 250 
+ 251 fn test-tokenize-stream-literal {
+ 252   var in-storage: gap-buffer
+ 253   var in/esi: (addr gap-buffer) <- address in-storage
+ 254   initialize-gap-buffer-with in, "[abc def]"
+ 255   #
+ 256   var stream-storage: (stream token 0x10)
+ 257   var stream/edi: (addr stream token) <- address stream-storage
+ 258   #
+ 259   var trace-storage: trace
+ 260   var trace/edx: (addr trace) <- address trace-storage
+ 261   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+ 262   tokenize in, stream, trace
+ 263   #
+ 264   var curr-token-storage: token
+ 265   var curr-token/ebx: (addr token) <- address curr-token-storage
+ 266   read-from-stream stream, curr-token
+ 267   var curr-token-type/eax: (addr int) <- get curr-token, type
+ 268   check-ints-equal *curr-token-type, 3/indent, "F - test-tokenize-stream-literal/before-indent-type"
+ 269   var curr-token-data/eax: (addr int) <- get curr-token, number-data
+ 270   check-ints-equal *curr-token-data, 0/spaces, "F - test-tokenize-stream-literal/before-indent"
+ 271   read-from-stream stream, curr-token
+ 272   var stream?/eax: boolean <- stream-token? curr-token
+ 273   check stream?, "F - test-tokenize-stream-literal: type"
+ 274   var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data
+ 275   var curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah
+ 276   var data-equal?/eax: boolean <- stream-data-equal? curr-token-data, "abc def"
+ 277   check data-equal?, "F - test-tokenize-stream-literal"
+ 278   var empty?/eax: boolean <- stream-empty? stream
+ 279   check empty?, "F - test-tokenize-stream-literal: empty?"
+ 280 }
+ 281 
+ 282 fn test-tokenize-stream-literal-in-tree {
+ 283   var in-storage: gap-buffer
+ 284   var in/esi: (addr gap-buffer) <- address in-storage
+ 285   initialize-gap-buffer-with in, "([abc def])"
+ 286   #
+ 287   var stream-storage: (stream token 0x10)
+ 288   var stream/edi: (addr stream token) <- address stream-storage
+ 289   #
+ 290   var trace-storage: trace
+ 291   var trace/edx: (addr trace) <- address trace-storage
+ 292   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+ 293   tokenize in, stream, trace
+ 294   #
+ 295   var curr-token-storage: token
+ 296   var curr-token/ebx: (addr token) <- address curr-token-storage
+ 297   read-from-stream stream, curr-token
+ 298   var curr-token-type/eax: (addr int) <- get curr-token, type
+ 299   check-ints-equal *curr-token-type, 3/indent, "F - test-tokenize-stream-literal-in-tree/before-indent-type"
+ 300   var curr-token-data/eax: (addr int) <- get curr-token, number-data
+ 301   check-ints-equal *curr-token-data, 0/spaces, "F - test-tokenize-stream-literal-in-tree/before-indent"
+ 302   read-from-stream stream, curr-token
+ 303   var bracket?/eax: boolean <- bracket-token? curr-token
+ 304   check bracket?, "F - test-tokenize-stream-literal-in-tree: open paren"
+ 305   read-from-stream stream, curr-token
+ 306   var stream?/eax: boolean <- stream-token? curr-token
+ 307   check stream?, "F - test-tokenize-stream-literal-in-tree: type"
+ 308   var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data
+ 309   var curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah
+ 310   var data-equal?/eax: boolean <- stream-data-equal? curr-token-data, "abc def"
+ 311   check data-equal?, "F - test-tokenize-stream-literal-in-tree"
+ 312   read-from-stream stream, curr-token
+ 313   var bracket?/eax: boolean <- bracket-token? curr-token
+ 314   check bracket?, "F - test-tokenize-stream-literal-in-tree: close paren"
+ 315   var empty?/eax: boolean <- stream-empty? stream
+ 316   check empty?, "F - test-tokenize-stream-literal-in-tree: empty?"
+ 317 }
+ 318 
+ 319 fn test-tokenize-indent {
+ 320   var in-storage: gap-buffer
+ 321   var in/esi: (addr gap-buffer) <- address in-storage
+ 322   initialize-gap-buffer-with in, "abc\n  def"
+ 323   #
+ 324   var stream-storage: (stream token 0x10)
+ 325   var stream/edi: (addr stream token) <- address stream-storage
+ 326   #
+ 327   var trace-storage: trace
+ 328   var trace/edx: (addr trace) <- address trace-storage
+ 329   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+ 330   tokenize in, stream, trace
+ 331   #
+ 332   var curr-token-storage: token
+ 333   var curr-token/ebx: (addr token) <- address curr-token-storage
+ 334   read-from-stream stream, curr-token
+ 335   var curr-token-type/eax: (addr int) <- get curr-token, type
+ 336   check-ints-equal *curr-token-type, 3/indent, "F - test-tokenize-indent/before-indent-type"
+ 337   var curr-token-data/eax: (addr int) <- get curr-token, number-data
+ 338   check-ints-equal *curr-token-data, 0/spaces, "F - test-tokenize-indent/before-indent"
+ 339   read-from-stream stream, curr-token
+ 340   var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data
+ 341   var curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah
+ 342   check-stream-equal curr-token-data, "abc", "F - test-tokenize-indent/before"
+ 343   #
+ 344   read-from-stream stream, curr-token
+ 345   var curr-token-type/eax: (addr int) <- get curr-token, type
+ 346   check-ints-equal *curr-token-type, 3/indent, "F - test-tokenize-indent/type"
+ 347   var curr-token-data/eax: (addr int) <- get curr-token, number-data
+ 348   check-ints-equal *curr-token-data, 2/spaces, "F - test-tokenize-indent"
+ 349   #
+ 350   read-from-stream stream, curr-token
+ 351   var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data
+ 352   var curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah
+ 353   check-stream-equal curr-token-data, "def", "F - test-tokenize-indent/after"
+ 354 }
+ 355 
+ 356 # caller is responsible for threading start-of-line? between calls to next-token
+ 357 # 'in' may contain whitespace if start-of-line?
+ 358 fn next-token in: (addr gap-buffer), out: (addr token), start-of-line?: boolean, trace: (addr trace) -> _/edi: boolean {
+ 359   trace-text trace, "tokenize", "next-token"
+ 360   trace-lower trace
+ 361   # save an indent token if necessary
+ 362   {
+ 363     compare start-of-line?, 0/false
+ 364     break-if-=
+ 365     next-indent-token in, out, trace  # might not be returned
+ 366   }
+ 367   skip-spaces-from-gap-buffer in
+ 368   var g/eax: grapheme <- peek-from-gap-buffer in
+ 369   {
+ 370     compare g, 0x23/comment
+ 371     break-if-!=
+ 372     skip-rest-of-line in
+ 373   }
+ 374   var g/eax: grapheme <- peek-from-gap-buffer in
+ 375   {
+ 376     compare g, 0xa/newline
+ 377     break-if-!=
+ 378     trace-text trace, "tokenize", "newline"
+ 379     g <- read-from-gap-buffer in
+ 380     initialize-skip-token out  # might drop indent if that's all there was in this line
+ 381     trace-higher trace
+ 382     return 1/at-start-of-line
+ 383   }
+ 384   {
+ 385     compare start-of-line?, 0/false
+ 386     break-if-=
+ 387     # still here? no comment or newline? return saved indent
+ 388     trace-higher trace
+ 389     return 0/not-at-start-of-line
+ 390   }
+ 391   {
+ 392     var done?/eax: boolean <- gap-buffer-scan-done? in
+ 393     compare done?, 0/false
+ 394     break-if-=
+ 395     trace-text trace, "tokenize", "end"
+ 396     initialize-skip-token out
+ 397     trace-higher trace
+ 398     return 1/at-start-of-line
+ 399   }
+ 400   var _g/eax: grapheme <- peek-from-gap-buffer in
+ 401   var g/ecx: grapheme <- copy _g
+ 402   {
+ 403     var should-trace?/eax: boolean <- should-trace? trace
+ 404     compare should-trace?, 0/false
+ 405     break-if-=
+ 406     var stream-storage: (stream byte 0x40)
+ 407     var stream/esi: (addr stream byte) <- address stream-storage
+ 408     write stream, "next: "
+ 409     var gval/eax: int <- copy g
+ 410     write-int32-hex stream, gval
+ 411     trace trace, "tokenize", stream
+ 412   }
+ 413   $next-token:case: {
+ 414     # open square brackets begin streams
  415     {
- 416       compare g, 0x2c/comma
+ 416       compare g, 0x5b/open-square-bracket
  417       break-if-!=
- 418       var g/eax: grapheme <- read-from-gap-buffer in  # consume
- 419       write-grapheme out, g
- 420       # check for unquote-splice
- 421       {
- 422         var g2/eax: grapheme <- peek-from-gap-buffer in
- 423         compare g2, 0x40/at-sign
- 424         break-if-!=
- 425         g2 <- read-from-gap-buffer in
- 426         write-grapheme out, g2
- 427       }
+ 418       var dummy/eax: grapheme <- read-from-gap-buffer in  # skip open bracket
+ 419       next-stream-token in, out, trace
+ 420       break $next-token:case
+ 421     }
+ 422     # other symbol char
+ 423     {
+ 424       var symbol?/eax: boolean <- symbol-grapheme? g
+ 425       compare symbol?, 0/false
+ 426       break-if-=
+ 427       next-symbol-token in, out, trace
  428       break $next-token:case
  429     }
- 430     abort "unknown token type"
- 431   }
- 432   trace-higher trace
- 433   {
- 434     var should-trace?/eax: boolean <- should-trace? trace
- 435     compare should-trace?, 0/false
- 436     break-if-=
- 437     var stream-storage: (stream byte 0x400)  # maximum possible token size (next-stream-token)
- 438     var stream/eax: (addr stream byte) <- address stream-storage
- 439     write stream, "=> "
- 440     rewind-stream out
- 441     write-stream stream, out
- 442     trace trace, "tokenize", stream
- 443   }
- 444 }
- 445 
- 446 fn next-symbol-token in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) {
- 447   trace-text trace, "tokenize", "looking for a symbol"
- 448   trace-lower trace
- 449   $next-symbol-token:loop: {
- 450     var done?/eax: boolean <- gap-buffer-scan-done? in
- 451     compare done?, 0/false
- 452     break-if-!=
- 453     var g/eax: grapheme <- peek-from-gap-buffer in
- 454     {
- 455       {
- 456         var should-trace?/eax: boolean <- should-trace? trace
- 457         compare should-trace?, 0/false
- 458       }
- 459       break-if-=
- 460       var stream-storage: (stream byte 0x40)
- 461       var stream/esi: (addr stream byte) <- address stream-storage
- 462       write stream, "next: "
- 463       var gval/eax: int <- copy g
- 464       write-int32-hex stream, gval
- 465       trace trace, "tokenize", stream
- 466     }
- 467     # if non-symbol, return
- 468     {
- 469       var symbol-grapheme?/eax: boolean <- symbol-grapheme? g
- 470       compare symbol-grapheme?, 0/false
- 471       break-if-!=
- 472       trace-text trace, "tokenize", "stop"
- 473       break $next-symbol-token:loop
- 474     }
- 475     var g/eax: grapheme <- read-from-gap-buffer in
- 476     write-grapheme out, g
- 477     loop
- 478   }
- 479   trace-higher trace
- 480   {
- 481     var should-trace?/eax: boolean <- should-trace? trace
- 482     compare should-trace?, 0/false
- 483     break-if-=
- 484     var stream-storage: (stream byte 0x40)
- 485     var stream/esi: (addr stream byte) <- address stream-storage
- 486     write stream, "=> "
- 487     rewind-stream out
- 488     write-stream stream, out
- 489     trace trace, "tokenize", stream
- 490   }
- 491 }
- 492 
- 493 fn next-operator-token in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) {
- 494   trace-text trace, "tokenize", "looking for a operator"
- 495   trace-lower trace
- 496   $next-operator-token:loop: {
- 497     var done?/eax: boolean <- gap-buffer-scan-done? in
- 498     compare done?, 0/false
- 499     break-if-!=
- 500     var g/eax: grapheme <- peek-from-gap-buffer in
- 501     {
- 502       {
- 503         var should-trace?/eax: boolean <- should-trace? trace
- 504         compare should-trace?, 0/false
- 505       }
- 506       break-if-=
- 507       var stream-storage: (stream byte 0x40)
- 508       var stream/esi: (addr stream byte) <- address stream-storage
- 509       write stream, "next: "
- 510       var gval/eax: int <- copy g
- 511       write-int32-hex stream, gval
- 512       trace trace, "tokenize", stream
- 513     }
- 514     # if non-operator, return
- 515     {
- 516       var operator-grapheme?/eax: boolean <- operator-grapheme? g
- 517       compare operator-grapheme?, 0/false
- 518       break-if-!=
- 519       trace-text trace, "tokenize", "stop"
- 520       break $next-operator-token:loop
- 521     }
- 522     var g/eax: grapheme <- read-from-gap-buffer in
- 523     write-grapheme out, g
- 524     loop
- 525   }
- 526   trace-higher trace
- 527   {
- 528     var should-trace?/eax: boolean <- should-trace? trace
- 529     compare should-trace?, 0/false
- 530     break-if-=
- 531     var stream-storage: (stream byte 0x40)
- 532     var stream/esi: (addr stream byte) <- address stream-storage
- 533     write stream, "=> "
- 534     rewind-stream out
- 535     write-stream stream, out
- 536     trace trace, "tokenize", stream
+ 430     # unbalanced close square brackets are errors
+ 431     {
+ 432       compare g, 0x5d/close-square-bracket
+ 433       break-if-!=
+ 434       error trace, "unbalanced ']'"
+ 435       return start-of-line?
+ 436     }
+ 437     # other brackets are always single-char tokens
+ 438     {
+ 439       var bracket?/eax: boolean <- bracket-grapheme? g
+ 440       compare bracket?, 0/false
+ 441       break-if-=
+ 442       var g/eax: grapheme <- read-from-gap-buffer in
+ 443       next-bracket-token g, out, trace
+ 444       break $next-token:case
+ 445     }
+ 446     # quote
+ 447     {
+ 448       compare g, 0x27/single-quote
+ 449       break-if-!=
+ 450       var g/eax: grapheme <- read-from-gap-buffer in  # consume
+ 451       initialize-token out, "'"
+ 452       break $next-token:case
+ 453     }
+ 454     # backquote
+ 455     {
+ 456       compare g, 0x60/backquote
+ 457       break-if-!=
+ 458       var g/eax: grapheme <- read-from-gap-buffer in  # consume
+ 459       initialize-token out, "`"
+ 460       break $next-token:case
+ 461     }
+ 462     # unquote
+ 463     {
+ 464       compare g, 0x2c/comma
+ 465       break-if-!=
+ 466       var g/eax: grapheme <- read-from-gap-buffer in  # consume
+ 467       # check for unquote-splice
+ 468       {
+ 469         g <- peek-from-gap-buffer in
+ 470         compare g, 0x40/at-sign
+ 471         break-if-!=
+ 472         g <- read-from-gap-buffer in
+ 473         initialize-token out, ",@"
+ 474         break $next-token:case
+ 475       }
+ 476       initialize-token out, ","
+ 477       break $next-token:case
+ 478     }
+ 479     set-cursor-position 0/screen, 0x40 0x20
+ 480     {
+ 481       var foo/eax: int <- copy g
+ 482       draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, foo, 7/fg 0/bg
+ 483     }
+ 484     abort "unknown token type"
+ 485   }
+ 486   trace-higher trace
+ 487   {
+ 488     var should-trace?/eax: boolean <- should-trace? trace
+ 489     compare should-trace?, 0/false
+ 490     break-if-=
+ 491     var stream-storage: (stream byte 0x400)  # maximum possible token size (next-stream-token)
+ 492     var stream/eax: (addr stream byte) <- address stream-storage
+ 493     write stream, "=> "
+ 494     write-token-text-data stream, out
+ 495     trace trace, "tokenize", stream
+ 496   }
+ 497   return start-of-line?
+ 498 }
+ 499 
+ 500 fn next-symbol-token in: (addr gap-buffer), _out: (addr token), trace: (addr trace) {
+ 501   trace-text trace, "tokenize", "looking for a symbol"
+ 502   trace-lower trace
+ 503   var out/eax: (addr token) <- copy _out
+ 504   var out-data-ah/eax: (addr handle stream byte) <- get out, text-data
+ 505   populate-stream out-data-ah, 0x40/max-symbol-size
+ 506   var _out-data/eax: (addr stream byte) <- lookup *out-data-ah
+ 507   var out-data/edi: (addr stream byte) <- copy _out-data
+ 508   $next-symbol-token:loop: {
+ 509     var done?/eax: boolean <- gap-buffer-scan-done? in
+ 510     compare done?, 0/false
+ 511     break-if-!=
+ 512     var g/eax: grapheme <- peek-from-gap-buffer in
+ 513     {
+ 514       {
+ 515         var should-trace?/eax: boolean <- should-trace? trace
+ 516         compare should-trace?, 0/false
+ 517       }
+ 518       break-if-=
+ 519       var stream-storage: (stream byte 0x40)
+ 520       var stream/esi: (addr stream byte) <- address stream-storage
+ 521       write stream, "next: "
+ 522       var gval/eax: int <- copy g
+ 523       write-int32-hex stream, gval
+ 524       trace trace, "tokenize", stream
+ 525     }
+ 526     # if non-symbol, return
+ 527     {
+ 528       var symbol-grapheme?/eax: boolean <- symbol-grapheme? g
+ 529       compare symbol-grapheme?, 0/false
+ 530       break-if-!=
+ 531       trace-text trace, "tokenize", "stop"
+ 532       break $next-symbol-token:loop
+ 533     }
+ 534     var g/eax: grapheme <- read-from-gap-buffer in
+ 535     write-grapheme out-data, g
+ 536     loop
  537   }
- 538 }
- 539 
- 540 fn next-number-token in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) {
- 541   trace-text trace, "tokenize", "looking for a number"
- 542   trace-lower trace
- 543   $next-number-token:check-minus: {
- 544     var g/eax: grapheme <- peek-from-gap-buffer in
- 545     compare g, 0x2d/minus
- 546     g <- read-from-gap-buffer in  # consume
- 547     write-grapheme out, g
- 548   }
- 549   $next-number-token:loop: {
- 550     var done?/eax: boolean <- gap-buffer-scan-done? in
- 551     compare done?, 0/false
- 552     break-if-!=
- 553     var g/eax: grapheme <- peek-from-gap-buffer in
- 554     {
- 555       {
- 556         var should-trace?/eax: boolean <- should-trace? trace
- 557         compare should-trace?, 0/false
- 558       }
- 559       break-if-=
- 560       var stream-storage: (stream byte 0x40)
- 561       var stream/esi: (addr stream byte) <- address stream-storage
- 562       write stream, "next: "
- 563       var gval/eax: int <- copy g
- 564       write-int32-hex stream, gval
- 565       trace trace, "tokenize", stream
- 566     }
- 567     # if not symbol grapheme, return
- 568     {
- 569       var symbol-grapheme?/eax: boolean <- symbol-grapheme? g
- 570       compare symbol-grapheme?, 0/false
- 571       break-if-!=
- 572       trace-text trace, "tokenize", "stop"
- 573       break $next-number-token:loop
- 574     }
- 575     # if not digit grapheme, abort
- 576     {
- 577       var digit?/eax: boolean <- decimal-digit? g
- 578       compare digit?, 0/false
- 579       break-if-!=
- 580       error trace, "invalid number"
- 581       return
- 582     }
- 583     trace-text trace, "tokenize", "append"
- 584     var g/eax: grapheme <- read-from-gap-buffer in
- 585     write-grapheme out, g
- 586     loop
- 587   }
- 588   trace-higher trace
- 589 }
- 590 
- 591 fn next-stream-token in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) {
- 592   trace-text trace, "tokenize", "stream"
- 593   {
- 594     var empty?/eax: boolean <- gap-buffer-scan-done? in
- 595     compare empty?, 0/false
- 596     {
- 597       break-if-=
- 598       error trace, "unbalanced '['"
- 599       return
- 600     }
+ 538   trace-higher trace
+ 539   {
+ 540     var should-trace?/eax: boolean <- should-trace? trace
+ 541     compare should-trace?, 0/false
+ 542     break-if-=
+ 543     var stream-storage: (stream byte 0x40)
+ 544     var stream/esi: (addr stream byte) <- address stream-storage
+ 545     write stream, "=> "
+ 546     rewind-stream out-data
+ 547     write-stream stream, out-data
+ 548     trace trace, "tokenize", stream
+ 549   }
+ 550 }
+ 551 
+ 552 fn next-number-token in: (addr gap-buffer), _out: (addr token), trace: (addr trace) {
+ 553   trace-text trace, "tokenize", "looking for a number"
+ 554   trace-lower trace
+ 555   var out/eax: (addr token) <- copy _out
+ 556   var out-data-ah/eax: (addr handle stream byte) <- get out, text-data
+ 557   populate-stream out-data-ah, 0x40
+ 558   var _out-data/eax: (addr stream byte) <- lookup *out-data-ah
+ 559   var out-data/edi: (addr stream byte) <- copy _out-data
+ 560   $next-number-token:check-minus: {
+ 561     var g/eax: grapheme <- peek-from-gap-buffer in
+ 562     compare g, 0x2d/minus
+ 563     g <- read-from-gap-buffer in  # consume
+ 564     write-grapheme out-data, g
+ 565   }
+ 566   $next-number-token:loop: {
+ 567     var done?/eax: boolean <- gap-buffer-scan-done? in
+ 568     compare done?, 0/false
+ 569     break-if-!=
+ 570     var g/eax: grapheme <- peek-from-gap-buffer in
+ 571     {
+ 572       {
+ 573         var should-trace?/eax: boolean <- should-trace? trace
+ 574         compare should-trace?, 0/false
+ 575       }
+ 576       break-if-=
+ 577       var stream-storage: (stream byte 0x40)
+ 578       var stream/esi: (addr stream byte) <- address stream-storage
+ 579       write stream, "next: "
+ 580       var gval/eax: int <- copy g
+ 581       write-int32-hex stream, gval
+ 582       trace trace, "tokenize", stream
+ 583     }
+ 584     # if not symbol grapheme, return
+ 585     {
+ 586       var symbol-grapheme?/eax: boolean <- symbol-grapheme? g
+ 587       compare symbol-grapheme?, 0/false
+ 588       break-if-!=
+ 589       trace-text trace, "tokenize", "stop"
+ 590       break $next-number-token:loop
+ 591     }
+ 592     # if not digit grapheme, abort
+ 593     {
+ 594       var digit?/eax: boolean <- decimal-digit? g
+ 595       compare digit?, 0/false
+ 596       break-if-!=
+ 597       error trace, "invalid number"
+ 598       return
+ 599     }
+ 600     trace-text trace, "tokenize", "append"
  601     var g/eax: grapheme <- read-from-gap-buffer in
- 602     compare g, 0x5d/close-square-bracket
- 603     break-if-=
- 604     write-grapheme out, g
- 605     loop
- 606   }
- 607   {
- 608     var should-trace?/eax: boolean <- should-trace? trace
- 609     compare should-trace?, 0/false
- 610     break-if-=
- 611     var stream-storage: (stream byte 0x400)  # max-definition-size
- 612     var stream/esi: (addr stream byte) <- address stream-storage
- 613     write stream, "=> "
- 614     rewind-stream out
- 615     write-stream stream, out
- 616     trace trace, "tokenize", stream
- 617   }
- 618 }
- 619 
- 620 fn next-bracket-token g: grapheme, out: (addr stream byte), trace: (addr trace) {
- 621   trace-text trace, "tokenize", "bracket"
- 622   write-grapheme out, g
- 623   {
- 624     var should-trace?/eax: boolean <- should-trace? trace
- 625     compare should-trace?, 0/false
- 626     break-if-=
- 627     var stream-storage: (stream byte 0x40)
- 628     var stream/esi: (addr stream byte) <- address stream-storage
- 629     write stream, "=> "
- 630     rewind-stream out
- 631     write-stream stream, out
- 632     trace trace, "tokenize", stream
- 633   }
- 634 }
- 635 
- 636 fn rest-of-line in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) {
- 637   trace-text trace, "tokenize", "comment"
- 638   {
- 639     var empty?/eax: boolean <- gap-buffer-scan-done? in
- 640     compare empty?, 0/false
- 641     {
- 642       break-if-=
- 643       return
- 644     }
- 645     var g/eax: grapheme <- read-from-gap-buffer in
- 646     compare g, 0xa/newline
- 647     break-if-=
- 648     write-grapheme out, g
- 649     loop
- 650   }
- 651   {
- 652     var should-trace?/eax: boolean <- should-trace? trace
- 653     compare should-trace?, 0/false
- 654     break-if-=
- 655     var stream-storage: (stream byte 0x80)
- 656     var stream/esi: (addr stream byte) <- address stream-storage
- 657     write stream, "=> "
- 658     rewind-stream out
- 659     write-stream stream, out
- 660     trace trace, "tokenize", stream
- 661   }
- 662 }
- 663 
- 664 fn symbol-grapheme? g: grapheme -> _/eax: boolean {
- 665   ## whitespace
- 666   compare g, 9/tab
- 667   {
- 668     break-if-!=
- 669     return 0/false
- 670   }
- 671   compare g, 0xa/newline
- 672   {
- 673     break-if-!=
- 674     return 0/false
- 675   }
- 676   compare g, 0x20/space
- 677   {
- 678     break-if-!=
- 679     return 0/false
- 680   }
- 681   ## quotes
- 682   compare g, 0x22/double-quote
- 683   {
- 684     break-if-!=
- 685     return 0/false
- 686   }
- 687   compare g, 0x60/backquote
+ 602     write-grapheme out-data, g
+ 603     loop
+ 604   }
+ 605   trace-higher trace
+ 606 }
+ 607 
+ 608 fn next-stream-token in: (addr gap-buffer), _out: (addr token), trace: (addr trace) {
+ 609   trace-text trace, "tokenize", "stream"
+ 610   var out/edi: (addr token) <- copy _out
+ 611   var out-type/eax: (addr int) <- get out, type
+ 612   copy-to *out-type, 1/stream
+ 613   var out-data-ah/eax: (addr handle stream byte) <- get out, text-data
+ 614   # stream tokens contain whole function definitions on boot, so we always
+ 615   # give them plenty of space
+ 616   populate-stream out-data-ah, 0x400/max-definition-size=1KB
+ 617   var _out-data/eax: (addr stream byte) <- lookup *out-data-ah
+ 618   var out-data/edi: (addr stream byte) <- copy _out-data
+ 619   {
+ 620     var empty?/eax: boolean <- gap-buffer-scan-done? in
+ 621     compare empty?, 0/false
+ 622     {
+ 623       break-if-=
+ 624       error trace, "unbalanced '['"
+ 625       return
+ 626     }
+ 627     var g/eax: grapheme <- read-from-gap-buffer in
+ 628     compare g, 0x5d/close-square-bracket
+ 629     break-if-=
+ 630     write-grapheme out-data, g
+ 631     loop
+ 632   }
+ 633   {
+ 634     var should-trace?/eax: boolean <- should-trace? trace
+ 635     compare should-trace?, 0/false
+ 636     break-if-=
+ 637     var stream-storage: (stream byte 0x400)  # max-definition-size
+ 638     var stream/esi: (addr stream byte) <- address stream-storage
+ 639     write stream, "=> "
+ 640     rewind-stream out-data
+ 641     write-stream stream, out-data
+ 642     trace trace, "tokenize", stream
+ 643   }
+ 644 }
+ 645 
+ 646 fn next-bracket-token g: grapheme, _out: (addr token), trace: (addr trace) {
+ 647   trace-text trace, "tokenize", "bracket"
+ 648   var out/eax: (addr token) <- copy _out
+ 649   var out-data-ah/eax: (addr handle stream byte) <- get out, text-data
+ 650   populate-stream out-data-ah, 0x40
+ 651   var _out-data/eax: (addr stream byte) <- lookup *out-data-ah
+ 652   var out-data/edi: (addr stream byte) <- copy _out-data
+ 653   write-grapheme out-data, g
+ 654   {
+ 655     var should-trace?/eax: boolean <- should-trace? trace
+ 656     compare should-trace?, 0/false
+ 657     break-if-=
+ 658     var stream-storage: (stream byte 0x40)
+ 659     var stream/esi: (addr stream byte) <- address stream-storage
+ 660     write stream, "=> "
+ 661     rewind-stream out-data
+ 662     write-stream stream, out-data
+ 663     trace trace, "tokenize", stream
+ 664   }
+ 665 }
+ 666 
+ 667 fn skip-rest-of-line in: (addr gap-buffer) {
+ 668   {
+ 669     var done?/eax: boolean <- gap-buffer-scan-done? in
+ 670     compare done?, 0/false
+ 671     break-if-!=
+ 672     var g/eax: grapheme <- peek-from-gap-buffer in
+ 673     compare g, 0xa/newline
+ 674     break-if-=
+ 675     g <- read-from-gap-buffer in  # consume
+ 676     loop
+ 677   }
+ 678 }
+ 679 
+ 680 fn next-indent-token in: (addr gap-buffer), _out: (addr token), trace: (addr trace) {
+ 681   trace-text trace, "tokenize", "indent"
+ 682   trace-lower trace
+ 683   var out/edi: (addr token) <- copy _out
+ 684   var out-type/eax: (addr int) <- get out, type
+ 685   copy-to *out-type, 3/indent
+ 686   var dest/edi: (addr int) <- get out, number-data
+ 687   copy-to *dest, 0
  688   {
- 689     break-if-!=
- 690     return 0/false
- 691   }
- 692   ## brackets
- 693   compare g, 0x28/open-paren
- 694   {
- 695     break-if-!=
- 696     return 0/false
- 697   }
- 698   compare g, 0x29/close-paren
- 699   {
- 700     break-if-!=
- 701     return 0/false
- 702   }
- 703   compare g, 0x5b/open-square-bracket
- 704   {
- 705     break-if-!=
- 706     return 0/false
- 707   }
- 708   compare g, 0x5d/close-square-bracket
- 709   {
- 710     break-if-!=
- 711     return 0/false
+ 689     var done?/eax: boolean <- gap-buffer-scan-done? in
+ 690     compare done?, 0/false
+ 691     break-if-!=
+ 692     var g/eax: grapheme <- peek-from-gap-buffer in
+ 693     {
+ 694       {
+ 695         var should-trace?/eax: boolean <- should-trace? trace
+ 696         compare should-trace?, 0/false
+ 697       }
+ 698       break-if-=
+ 699       var stream-storage: (stream byte 0x40)
+ 700       var stream/esi: (addr stream byte) <- address stream-storage
+ 701       write stream, "next: "
+ 702       var gval/eax: int <- copy g
+ 703       write-int32-hex stream, gval
+ 704       trace trace, "tokenize", stream
+ 705     }
+ 706     # if non-space, break
+ 707     compare g, 0x20/space
+ 708     break-if-!=
+ 709     g <- read-from-gap-buffer in
+ 710     increment *dest
+ 711     loop
  712   }
- 713   compare g, 0x7b/open-curly-bracket
+ 713   trace-higher trace
  714   {
- 715     break-if-!=
- 716     return 0/false
- 717   }
- 718   compare g, 0x7d/close-curly-bracket
- 719   {
- 720     break-if-!=
- 721     return 0/false
- 722   }
- 723   # - other punctuation
- 724   # '!' is a symbol char
- 725   compare g, 0x23/hash
- 726   {
- 727     break-if-!=
- 728     return 0/false
- 729   }
- 730   # '$' is a symbol char
- 731   compare g, 0x25/percent
- 732   {
- 733     break-if-!=
- 734     return 0/false
- 735   }
- 736   compare g, 0x26/ampersand
- 737   {
- 738     break-if-!=
- 739     return 0/false
- 740   }
- 741   compare g, 0x27/single-quote
- 742   {
- 743     break-if-!=
- 744     return 0/false
- 745   }
- 746   compare g, 0x60/backquote
+ 715     var should-trace?/eax: boolean <- should-trace? trace
+ 716     compare should-trace?, 0/false
+ 717     break-if-=
+ 718     var stream-storage: (stream byte 0x40)
+ 719     var stream/esi: (addr stream byte) <- address stream-storage
+ 720     write stream, "=> indent "
+ 721     write-int32-hex stream, *dest
+ 722     trace trace, "tokenize", stream
+ 723   }
+ 724 }
+ 725 
+ 726 # Mu carves up the space of graphemes into 4 categories:
+ 727 #   whitespace
+ 728 #   quotes and unquotes (from a Lisp perspective; doesn't include double
+ 729 #                        quotes or other Unicode quotes)
+ 730 #   operators
+ 731 #   symbols
+ 732 # (Numbers have their own parsing rules that don't fit cleanly in this
+ 733 # partition.)
+ 734 #
+ 735 # During tokenization operators and symbols are treated identically.
+ 736 # A later phase digs into that nuance.
+ 737 
+ 738 fn symbol-grapheme? g: grapheme -> _/eax: boolean {
+ 739   var whitespace?/eax: boolean <- whitespace-grapheme? g
+ 740   compare whitespace?, 0/false
+ 741   {
+ 742     break-if-=
+ 743     return 0/false
+ 744   }
+ 745   var quote-or-unquote?/eax: boolean <- quote-or-unquote-grapheme? g
+ 746   compare quote-or-unquote?, 0/false
  747   {
- 748     break-if-!=
+ 748     break-if-=
  749     return 0/false
  750   }
- 751   compare g, 0x2c/comma
- 752   {
- 753     break-if-!=
- 754     return 0/false
- 755   }
- 756   compare g, 0x40/at-sign
- 757   {
- 758     break-if-!=
- 759     return 0/false
- 760   }
- 761   compare g, 0x2a/asterisk
- 762   {
- 763     break-if-!=
- 764     return 0/false
- 765   }
- 766   compare g, 0x2b/plus
- 767   {
- 768     break-if-!=
- 769     return 0/false
- 770   }
- 771   compare g, 0x2d/dash  # '-' not allowed in symbols
+ 751   var bracket?/eax: boolean <- bracket-grapheme? g
+ 752   compare bracket?, 0/false
+ 753   {
+ 754     break-if-=
+ 755     return 0/false
+ 756   }
+ 757   compare g, 0x23/hash  # comments get filtered out
+ 758   {
+ 759     break-if-!=
+ 760     return 0/false
+ 761   }
+ 762   compare g, 0x22/double-quote  # double quotes reserved for now
+ 763   {
+ 764     break-if-!=
+ 765     return 0/false
+ 766   }
+ 767   return 1/true
+ 768 }
+ 769 
+ 770 fn whitespace-grapheme? g: grapheme -> _/eax: boolean {
+ 771   compare g, 9/tab
  772   {
  773     break-if-!=
- 774     return 0/false
+ 774     return 1/true
  775   }
- 776   compare g, 0x2e/period
+ 776   compare g, 0xa/newline
  777   {
  778     break-if-!=
- 779     return 0/false
+ 779     return 1/true
  780   }
- 781   compare g, 0x2f/slash
+ 781   compare g, 0x20/space
  782   {
  783     break-if-!=
- 784     return 0/false
+ 784     return 1/true
  785   }
- 786   compare g, 0x3a/colon
- 787   {
- 788     break-if-!=
- 789     return 0/false
- 790   }
- 791   compare g, 0x3b/semi-colon
- 792   {
- 793     break-if-!=
- 794     return 0/false
- 795   }
- 796   compare g, 0x3c/less-than
- 797   {
- 798     break-if-!=
- 799     return 0/false
- 800   }
- 801   compare g, 0x3d/equal
- 802   {
- 803     break-if-!=
- 804     return 0/false
- 805   }
- 806   compare g, 0x3e/greater-than
- 807   {
- 808     break-if-!=
- 809     return 0/false
- 810   }
- 811   # '?' is a symbol char
- 812   compare g, 0x5c/backslash
- 813   {
- 814     break-if-!=
- 815     return 0/false
- 816   }
- 817   compare g, 0x5e/caret
- 818   {
- 819     break-if-!=
- 820     return 0/false
- 821   }
- 822   # '_' is a symbol char
- 823   compare g, 0x7c/vertical-line
- 824   {
- 825     break-if-!=
- 826     return 0/false
- 827   }
- 828   compare g, 0x7e/tilde
- 829   {
- 830     break-if-!=
- 831     return 0/false
- 832   }
- 833   return 1/true
- 834 }
- 835 
- 836 fn bracket-grapheme? g: grapheme -> _/eax: boolean {
- 837   compare g, 0x28/open-paren
- 838   {
- 839     break-if-!=
- 840     return 1/true
- 841   }
- 842   compare g, 0x29/close-paren
- 843   {
- 844     break-if-!=
- 845     return 1/true
- 846   }
- 847   compare g, 0x5b/open-square-bracket
- 848   {
- 849     break-if-!=
- 850     return 1/true
- 851   }
- 852   compare g, 0x5d/close-square-bracket
- 853   {
- 854     break-if-!=
- 855     return 1/true
- 856   }
- 857   compare g, 0x7b/open-curly-bracket
- 858   {
- 859     break-if-!=
- 860     return 1/true
- 861   }
- 862   compare g, 0x7d/close-curly-bracket
- 863   {
- 864     break-if-!=
- 865     return 1/true
- 866   }
- 867   return 0/false
- 868 }
- 869 
- 870 fn operator-grapheme? g: grapheme -> _/eax: boolean {
- 871   # '$' is a symbol char
- 872   compare g, 0x25/percent
- 873   {
- 874     break-if-!=
- 875     return 1/false
- 876   }
- 877   compare g, 0x26/ampersand
- 878   {
- 879     break-if-!=
- 880     return 1/true
- 881   }
- 882   compare g, 0x27/single-quote
- 883   {
- 884     break-if-!=
- 885     return 0/true
+ 786   return 0/false
+ 787 }
+ 788 
+ 789 fn quote-or-unquote-grapheme? g: grapheme -> _/eax: boolean {
+ 790   compare g, 0x27/single-quote
+ 791   {
+ 792     break-if-!=
+ 793     return 1/true
+ 794   }
+ 795   compare g, 0x60/backquote
+ 796   {
+ 797     break-if-!=
+ 798     return 1/true
+ 799   }
+ 800   compare g, 0x2c/comma
+ 801   {
+ 802     break-if-!=
+ 803     return 1/true
+ 804   }
+ 805   compare g, 0x40/at-sign
+ 806   {
+ 807     break-if-!=
+ 808     return 1/true
+ 809   }
+ 810   return 0/false
+ 811 }
+ 812 
+ 813 fn bracket-grapheme? g: grapheme -> _/eax: boolean {
+ 814   compare g, 0x28/open-paren
+ 815   {
+ 816     break-if-!=
+ 817     return 1/true
+ 818   }
+ 819   compare g, 0x29/close-paren
+ 820   {
+ 821     break-if-!=
+ 822     return 1/true
+ 823   }
+ 824   compare g, 0x5b/open-square-bracket
+ 825   {
+ 826     break-if-!=
+ 827     return 1/true
+ 828   }
+ 829   compare g, 0x5d/close-square-bracket
+ 830   {
+ 831     break-if-!=
+ 832     return 1/true
+ 833   }
+ 834   compare g, 0x7b/open-curly-bracket
+ 835   {
+ 836     break-if-!=
+ 837     return 1/true
+ 838   }
+ 839   compare g, 0x7d/close-curly-bracket
+ 840   {
+ 841     break-if-!=
+ 842     return 1/true
+ 843   }
+ 844   return 0/false
+ 845 }
+ 846 
+ 847 fn number-token? _self: (addr token) -> _/eax: boolean {
+ 848   var self/eax: (addr token) <- copy _self
+ 849   var in-data-ah/eax: (addr handle stream byte) <- get self, text-data
+ 850   var _in-data/eax: (addr stream byte) <- lookup *in-data-ah
+ 851   var in-data/ecx: (addr stream byte) <- copy _in-data
+ 852   rewind-stream in-data
+ 853   var g/eax: grapheme <- read-grapheme in-data
+ 854   # if '-', read another
+ 855   {
+ 856     compare g, 0x2d/minus
+ 857     break-if-!=
+ 858     g <- read-grapheme in-data
+ 859   }
+ 860   {
+ 861     {
+ 862       var result/eax: boolean <- decimal-digit? g
+ 863       compare result, 0/false
+ 864       break-if-!=
+ 865       return 0/false
+ 866     }
+ 867     {
+ 868       var done?/eax: boolean <- stream-empty? in-data
+ 869       compare done?, 0/false
+ 870     }
+ 871     break-if-!=
+ 872     g <- read-grapheme in-data
+ 873     loop
+ 874   }
+ 875   return 1/true
+ 876 }
+ 877 
+ 878 fn bracket-token? _self: (addr token) -> _/eax: boolean {
+ 879   var self/eax: (addr token) <- copy _self
+ 880   {
+ 881     var in-type/eax: (addr int) <- get self, type
+ 882     compare *in-type, 1/stream
+ 883     break-if-!=
+ 884     # streams are never paren tokens
+ 885     return 0/false
  886   }
- 887   compare g, 0x60/backquote
- 888   {
- 889     break-if-!=
- 890     return 0/false
- 891   }
- 892   compare g, 0x2c/comma
- 893   {
- 894     break-if-!=
- 895     return 0/false
- 896   }
- 897   compare g, 0x40/at-sign
- 898   {
- 899     break-if-!=
- 900     return 0/false
- 901   }
- 902   compare g, 0x2a/asterisk
- 903   {
- 904     break-if-!=
- 905     return 1/true
- 906   }
- 907   compare g, 0x2b/plus
- 908   {
- 909     break-if-!=
- 910     return 1/true
- 911   }
- 912   compare g, 0x2d/dash  # '-' not allowed in symbols
- 913   {
- 914     break-if-!=
- 915     return 1/true
- 916   }
- 917   compare g, 0x2e/period
- 918   {
- 919     break-if-!=
- 920     return 1/true
- 921   }
- 922   compare g, 0x2f/slash
- 923   {
- 924     break-if-!=
- 925     return 1/true
- 926   }
- 927   compare g, 0x3a/colon
- 928   {
- 929     break-if-!=
- 930     return 1/true
- 931   }
- 932   compare g, 0x3b/semi-colon
- 933   {
- 934     break-if-!=
- 935     return 1/true
- 936   }
- 937   compare g, 0x3c/less-than
- 938   {
- 939     break-if-!=
- 940     return 1/true
- 941   }
- 942   compare g, 0x3d/equal
- 943   {
- 944     break-if-!=
- 945     return 1/true
- 946   }
- 947   compare g, 0x3e/greater-than
- 948   {
- 949     break-if-!=
- 950     return 1/true
- 951   }
- 952   # '?' is a symbol char
- 953   compare g, 0x5c/backslash
- 954   {
- 955     break-if-!=
- 956     return 1/true
- 957   }
- 958   compare g, 0x5e/caret
- 959   {
- 960     break-if-!=
- 961     return 1/true
- 962   }
- 963   # '_' is a symbol char
- 964   compare g, 0x7c/vertical-line
- 965   {
- 966     break-if-!=
- 967     return 1/true
- 968   }
- 969   compare g, 0x7e/tilde
- 970   {
- 971     break-if-!=
- 972     return 1/true
- 973   }
- 974   return 0/false
- 975 }
- 976 
- 977 fn number-token? _in: (addr cell) -> _/eax: boolean {
- 978   var in/eax: (addr cell) <- copy _in
- 979   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
- 980   var _in-data/eax: (addr stream byte) <- lookup *in-data-ah
- 981   var in-data/ecx: (addr stream byte) <- copy _in-data
- 982   rewind-stream in-data
- 983   var g/eax: grapheme <- read-grapheme in-data
- 984   # if '-', read another
- 985   {
- 986     compare g, 0x2d/minus
- 987     break-if-!=
- 988     g <- read-grapheme in-data
- 989   }
- 990   var result/eax: boolean <- decimal-digit? g
- 991   return result
- 992 }
- 993 
- 994 fn bracket-token? _in: (addr cell) -> _/eax: boolean {
- 995   var in/eax: (addr cell) <- copy _in
- 996   {
- 997     var in-type/eax: (addr int) <- get in, type
- 998     compare *in-type, 3/stream
- 999     break-if-!=
-1000     # streams are never paren tokens
-1001     return 0/false
-1002   }
-1003   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
-1004   var in-data/eax: (addr stream byte) <- lookup *in-data-ah
-1005   rewind-stream in-data
-1006   var g/eax: grapheme <- read-grapheme in-data
-1007   var result/eax: boolean <- bracket-grapheme? g
-1008   return result
+ 887   var in-data-ah/eax: (addr handle stream byte) <- get self, text-data
+ 888   var in-data/eax: (addr stream byte) <- lookup *in-data-ah
+ 889   rewind-stream in-data
+ 890   var g/eax: grapheme <- read-grapheme in-data
+ 891   var result/eax: boolean <- bracket-grapheme? g
+ 892   return result
+ 893 }
+ 894 
+ 895 fn quote-token? _self: (addr token) -> _/eax: boolean {
+ 896   var self/eax: (addr token) <- copy _self
+ 897   var in-data-ah/eax: (addr handle stream byte) <- get self, text-data
+ 898   var in-data/eax: (addr stream byte) <- lookup *in-data-ah
+ 899   rewind-stream in-data
+ 900   var result/eax: boolean <- stream-data-equal? in-data, "'"
+ 901   return result
+ 902 }
+ 903 
+ 904 fn backquote-token? _self: (addr token) -> _/eax: boolean {
+ 905   var self/eax: (addr token) <- copy _self
+ 906   var in-data-ah/eax: (addr handle stream byte) <- get self, text-data
+ 907   var in-data/eax: (addr stream byte) <- lookup *in-data-ah
+ 908   rewind-stream in-data
+ 909   var result/eax: boolean <- stream-data-equal? in-data, "`"
+ 910   return result
+ 911 }
+ 912 
+ 913 fn unquote-token? _self: (addr token) -> _/eax: boolean {
+ 914   var self/eax: (addr token) <- copy _self
+ 915   var in-data-ah/eax: (addr handle stream byte) <- get self, text-data
+ 916   var in-data/eax: (addr stream byte) <- lookup *in-data-ah
+ 917   rewind-stream in-data
+ 918   var result/eax: boolean <- stream-data-equal? in-data, ","
+ 919   return result
+ 920 }
+ 921 
+ 922 fn unquote-splice-token? _self: (addr token) -> _/eax: boolean {
+ 923   var self/eax: (addr token) <- copy _self
+ 924   var in-data-ah/eax: (addr handle stream byte) <- get self, text-data
+ 925   var in-data/eax: (addr stream byte) <- lookup *in-data-ah
+ 926   rewind-stream in-data
+ 927   var result/eax: boolean <- stream-data-equal? in-data, ",@"
+ 928   return result
+ 929 }
+ 930 
+ 931 fn open-paren-token? _self: (addr token) -> _/eax: boolean {
+ 932   var self/eax: (addr token) <- copy _self
+ 933   var in-data-ah/eax: (addr handle stream byte) <- get self, text-data
+ 934   var _in-data/eax: (addr stream byte) <- lookup *in-data-ah
+ 935   var in-data/ecx: (addr stream byte) <- copy _in-data
+ 936   rewind-stream in-data
+ 937   var g/eax: grapheme <- read-grapheme in-data
+ 938   compare g, 0x28/open-paren
+ 939   {
+ 940     break-if-!=
+ 941     var result/eax: boolean <- stream-empty? in-data
+ 942     return result
+ 943   }
+ 944   return 0/false
+ 945 }
+ 946 
+ 947 fn close-paren-token? _self: (addr token) -> _/eax: boolean {
+ 948   var self/eax: (addr token) <- copy _self
+ 949   var in-data-ah/eax: (addr handle stream byte) <- get self, text-data
+ 950   var _in-data/eax: (addr stream byte) <- lookup *in-data-ah
+ 951   var in-data/ecx: (addr stream byte) <- copy _in-data
+ 952   rewind-stream in-data
+ 953   var g/eax: grapheme <- read-grapheme in-data
+ 954   compare g, 0x29/close-paren
+ 955   {
+ 956     break-if-!=
+ 957     var result/eax: boolean <- stream-empty? in-data
+ 958     return result
+ 959   }
+ 960   return 0/false
+ 961 }
+ 962 
+ 963 fn dot-token? _self: (addr token) -> _/eax: boolean {
+ 964   var self/eax: (addr token) <- copy _self
+ 965   var in-data-ah/eax: (addr handle stream byte) <- get self, text-data
+ 966   var _in-data/eax: (addr stream byte) <- lookup *in-data-ah
+ 967   var in-data/ecx: (addr stream byte) <- copy _in-data
+ 968   rewind-stream in-data
+ 969   var g/eax: grapheme <- read-grapheme in-data
+ 970   compare g, 0x2e/dot
+ 971   {
+ 972     break-if-!=
+ 973     var result/eax: boolean <- stream-empty? in-data
+ 974     return result
+ 975   }
+ 976   return 0/false
+ 977 }
+ 978 
+ 979 fn test-dot-token {
+ 980   var tmp-storage: (handle token)
+ 981   var tmp-ah/eax: (addr handle token) <- address tmp-storage
+ 982   allocate-token tmp-ah
+ 983   var tmp/eax: (addr token) <- lookup *tmp-ah
+ 984   initialize-token tmp, "."
+ 985   var result/eax: boolean <- dot-token? tmp
+ 986   check result, "F - test-dot-token"
+ 987 }
+ 988 
+ 989 fn stream-token? _self: (addr token) -> _/eax: boolean {
+ 990   var self/eax: (addr token) <- copy _self
+ 991   var in-type/eax: (addr int) <- get self, type
+ 992   compare *in-type, 1/stream
+ 993   {
+ 994     break-if-=
+ 995     return 0/false
+ 996   }
+ 997   return 1/true
+ 998 }
+ 999 
+1000 fn skip-token? _self: (addr token) -> _/eax: boolean {
+1001   var self/eax: (addr token) <- copy _self
+1002   var in-type/eax: (addr int) <- get self, type
+1003   compare *in-type, 2/skip
+1004   {
+1005     break-if-=
+1006     return 0/false
+1007   }
+1008   return 1/true
 1009 }
 1010 
-1011 fn quote-token? _in: (addr cell) -> _/eax: boolean {
-1012   var in/eax: (addr cell) <- copy _in
-1013   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
-1014   var in-data/eax: (addr stream byte) <- lookup *in-data-ah
-1015   rewind-stream in-data
-1016   var result/eax: boolean <- stream-data-equal? in-data, "'"
-1017   return result
-1018 }
-1019 
-1020 fn backquote-token? _in: (addr cell) -> _/eax: boolean {
-1021   var in/eax: (addr cell) <- copy _in
-1022   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
-1023   var in-data/eax: (addr stream byte) <- lookup *in-data-ah
-1024   rewind-stream in-data
-1025   var result/eax: boolean <- stream-data-equal? in-data, "`"
-1026   return result
-1027 }
-1028 
-1029 fn unquote-token? _in: (addr cell) -> _/eax: boolean {
-1030   var in/eax: (addr cell) <- copy _in
-1031   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
-1032   var in-data/eax: (addr stream byte) <- lookup *in-data-ah
-1033   rewind-stream in-data
-1034   var result/eax: boolean <- stream-data-equal? in-data, ","
-1035   return result
+1011 fn indent-token? _self: (addr token) -> _/eax: boolean {
+1012   var self/eax: (addr token) <- copy _self
+1013   var in-type/eax: (addr int) <- get self, type
+1014   compare *in-type, 3/indent
+1015   {
+1016     break-if-=
+1017     return 0/false
+1018   }
+1019   return 1/true
+1020 }
+1021 
+1022 fn allocate-token _self-ah: (addr handle token) {
+1023   var self-ah/eax: (addr handle token) <- copy _self-ah
+1024   allocate self-ah
+1025   var self/eax: (addr token) <- lookup *self-ah
+1026   var dest-ah/eax: (addr handle stream byte) <- get self, text-data
+1027   populate-stream dest-ah, 0x40/max-symbol-size
+1028 }
+1029 
+1030 fn initialize-token _self: (addr token), val: (addr array byte) {
+1031   var self/eax: (addr token) <- copy _self
+1032   var dest-ah/eax: (addr handle stream byte) <- get self, text-data
+1033   populate-stream dest-ah, 0x40
+1034   var dest/eax: (addr stream byte) <- lookup *dest-ah
+1035   write dest, val
 1036 }
 1037 
-1038 fn unquote-splice-token? _in: (addr cell) -> _/eax: boolean {
-1039   var in/eax: (addr cell) <- copy _in
-1040   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
-1041   var in-data/eax: (addr stream byte) <- lookup *in-data-ah
-1042   rewind-stream in-data
-1043   var result/eax: boolean <- stream-data-equal? in-data, ",@"
-1044   return result
-1045 }
-1046 
-1047 fn open-paren-token? _in: (addr cell) -> _/eax: boolean {
-1048   var in/eax: (addr cell) <- copy _in
-1049   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
-1050   var _in-data/eax: (addr stream byte) <- lookup *in-data-ah
-1051   var in-data/ecx: (addr stream byte) <- copy _in-data
-1052   rewind-stream in-data
-1053   var g/eax: grapheme <- read-grapheme in-data
-1054   compare g, 0x28/open-paren
-1055   {
-1056     break-if-!=
-1057     var result/eax: boolean <- stream-empty? in-data
-1058     return result
-1059   }
-1060   return 0/false
-1061 }
-1062 
-1063 fn close-paren-token? _in: (addr cell) -> _/eax: boolean {
-1064   var in/eax: (addr cell) <- copy _in
-1065   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
-1066   var _in-data/eax: (addr stream byte) <- lookup *in-data-ah
-1067   var in-data/ecx: (addr stream byte) <- copy _in-data
-1068   rewind-stream in-data
-1069   var g/eax: grapheme <- read-grapheme in-data
-1070   compare g, 0x29/close-paren
-1071   {
-1072     break-if-!=
-1073     var result/eax: boolean <- stream-empty? in-data
-1074     return result
-1075   }
-1076   return 0/false
-1077 }
-1078 
-1079 fn dot-token? _in: (addr cell) -> _/eax: boolean {
-1080   var in/eax: (addr cell) <- copy _in
-1081   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
-1082   var _in-data/eax: (addr stream byte) <- lookup *in-data-ah
-1083   var in-data/ecx: (addr stream byte) <- copy _in-data
-1084   rewind-stream in-data
-1085   var g/eax: grapheme <- read-grapheme in-data
-1086   compare g, 0x2e/dot
-1087   {
-1088     break-if-!=
-1089     var result/eax: boolean <- stream-empty? in-data
-1090     return result
-1091   }
-1092   return 0/false
-1093 }
-1094 
-1095 fn test-dot-token {
-1096   var tmp-storage: (handle cell)
-1097   var tmp-ah/eax: (addr handle cell) <- address tmp-storage
-1098   new-symbol tmp-ah, "."
-1099   var tmp/eax: (addr cell) <- lookup *tmp-ah
-1100   var result/eax: boolean <- dot-token? tmp
-1101   check result, "F - test-dot-token"
-1102 }
-1103 
-1104 fn stream-token? _in: (addr cell) -> _/eax: boolean {
-1105   var in/eax: (addr cell) <- copy _in
-1106   var in-type/eax: (addr int) <- get in, type
-1107   compare *in-type, 3/stream
-1108   {
-1109     break-if-=
-1110     return 0/false
-1111   }
-1112   return 1/true
-1113 }
-1114 
-1115 fn comment-token? _in: (addr cell) -> _/eax: boolean {
-1116   var in/eax: (addr cell) <- copy _in
-1117   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
-1118   var in-data/eax: (addr stream byte) <- lookup *in-data-ah
-1119   rewind-stream in-data
-1120   var g/eax: grapheme <- read-grapheme in-data
-1121   compare g, 0x23/hash
-1122   {
-1123     break-if-=
-1124     return 0/false
-1125   }
-1126   return 1/true
-1127 }
+1038 fn initialize-skip-token _self: (addr token) {
+1039   var self/eax: (addr token) <- copy _self
+1040   var self-type/eax: (addr int) <- get self, type
+1041   copy-to *self-type, 2/skip
+1042 }
+1043 
+1044 fn write-token-text-data out: (addr stream byte), _self: (addr token) {
+1045   var self/eax: (addr token) <- copy _self
+1046   var data-ah/eax: (addr handle stream byte) <- get self, text-data
+1047   var data/eax: (addr stream byte) <- lookup *data-ah
+1048   rewind-stream data
+1049   write-stream out, data
+1050 }
+1051 
+1052 fn tokens-equal? _a: (addr token), _b: (addr token) -> _/eax: boolean {
+1053   var a/edx: (addr token) <- copy _a
+1054   var b/ebx: (addr token) <- copy _b
+1055   var a-type-addr/eax: (addr int) <- get a, type
+1056   var a-type/eax: int <- copy *a-type-addr
+1057   var b-type-addr/ecx: (addr int) <- get b, type
+1058   compare a-type, *b-type-addr
+1059   {
+1060     break-if-=
+1061     return 0/false
+1062   }
+1063   compare a-type, 2/skip
+1064   {
+1065     break-if-!=
+1066     # skip tokens have no other data
+1067     return 1/true
+1068   }
+1069   compare a-type, 3/indent
+1070   {
+1071     break-if-!=
+1072     # indent tokens have no other data
+1073     var a-number-data-addr/eax: (addr int) <- get a, number-data
+1074     var a-number-data/eax: int <- copy *a-number-data-addr
+1075     var b-number-data-addr/ecx: (addr int) <- get b, number-data
+1076     compare a-number-data, *b-number-data-addr
+1077     {
+1078       break-if-=
+1079       return 0/false
+1080     }
+1081     return 1/true
+1082   }
+1083   var b-data-ah/eax: (addr handle stream byte) <- get b, text-data
+1084   var _b-data/eax: (addr stream byte) <- lookup *b-data-ah
+1085   var b-data/ebx: (addr stream byte) <- copy _b-data
+1086   var a-data-ah/eax: (addr handle stream byte) <- get a, text-data
+1087   var a-data/eax: (addr stream byte) <- lookup *a-data-ah
+1088   var data-match?/eax: boolean <- streams-data-equal? a-data, b-data
+1089   return data-match?
+1090 }
+1091 
+1092 fn dump-token-from-cursor _t: (addr token) {
+1093   var t/esi: (addr token) <- copy _t
+1094   var type/eax: (addr int) <- get t, type
+1095   draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, *type, 7/fg 0/bg
+1096   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, " ", 7/fg 0/bg
+1097   var text-ah/eax: (addr handle stream byte) <- get t, text-data
+1098   var text/eax: (addr stream byte) <- lookup *text-ah
+1099   rewind-stream text
+1100   draw-stream-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, text, 7/fg 0/bg
+1101   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, " ", 7/fg 0/bg
+1102   var num/eax: (addr int) <- get t, number-data
+1103   draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, *num, 7/fg 0/bg
+1104   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "\n", 7/fg 0/bg
+1105 }

-- cgit 1.4.1-2-gfad0