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 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