diff options
| -rw-r--r-- | shell/cell.mu | 25 | ||||
| -rw-r--r-- | shell/evaluate.mu | 45 | ||||
| -rw-r--r-- | shell/primitives.mu | 69 | ||||
| -rw-r--r-- | shell/print.mu | 23 |
4 files changed, 161 insertions, 1 deletions
diff --git a/shell/cell.mu b/shell/cell.mu index 57ea0110..79a9fb17 100644 --- a/shell/cell.mu +++ b/shell/cell.mu @@ -14,7 +14,9 @@ type cell { screen-data: (handle screen) # type 6: keyboard keyboard-data: (handle gap-buffer) - # TODO: array, (associative) table + # type 7: array + array-data: (handle array handle cell) + # TODO: (associative) table # if you add types here, don't forget to update cell-isomorphic? } @@ -272,3 +274,24 @@ fn rewind-keyboard-var _self-ah: (addr handle cell) { var keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah rewind-gap-buffer keyboard } + +fn new-array _out: (addr handle cell), capacity: int { + var out/eax: (addr handle cell) <- copy _out + allocate out + var out-addr/eax: (addr cell) <- lookup *out + var type/ecx: (addr int) <- get out-addr, type + copy-to *type, 7/array + var dest-ah/eax: (addr handle array handle cell) <- get out-addr, array-data + populate dest-ah, capacity +} + +fn array? _x: (addr cell) -> _/eax: boolean { + var x/esi: (addr cell) <- copy _x + var type/eax: (addr int) <- get x, type + compare *type, 7/array + { + break-if-= + return 0/false + } + return 1/true +} diff --git a/shell/evaluate.mu b/shell/evaluate.mu index c789d755..cb2c84ef 100644 --- a/shell/evaluate.mu +++ b/shell/evaluate.mu @@ -134,6 +134,14 @@ fn evaluate _in-ah: (addr handle cell), _out-ah: (addr handle cell), env-h: (han trace-higher trace return } + compare *in-type, 7/array + { + break-if-!= + trace-text trace, "eval", "array" + copy-object _in-ah, _out-ah + trace-higher trace + return + } # 'in' is a syntax tree $evaluate:literal-function: { # trees starting with "litfn" are literals @@ -1374,6 +1382,43 @@ fn cell-isomorphic? _a: (addr cell), _b: (addr cell), trace: (addr trace) -> _/e var result/eax: boolean <- gap-buffers-equal? a-val, b-val return result } + # if objects are arrays, check if they have the same contents + compare b-type, 7/array + { + break-if-!= + var a-val-ah/ecx: (addr handle array handle cell) <- get a, array-data + var _a-val/eax: (addr array handle cell) <- lookup *a-val-ah + var a-val/ecx: (addr array handle cell) <- copy _a-val + var b-val-ah/eax: (addr handle array handle cell) <- get b, array-data + var _b-val/eax: (addr array handle cell) <- lookup *b-val-ah + var b-val/edx: (addr array handle cell) <- copy _b-val + var a-len/eax: int <- length a-val + var b-len/ebx: int <- length b-val + { + compare a-len, b-len + break-if-= + return 0/false + } + var i/esi: int <- copy 0 + { + compare i, b-len + break-if->= + var a-elem-ah/eax: (addr handle cell) <- index a-val, i + var _a-elem/eax: (addr cell) <- lookup *a-elem-ah + var a-elem/edi: (addr cell) <- copy _a-elem + var b-elem-ah/eax: (addr handle cell) <- index b-val, i + var b-elem/eax: (addr cell) <- lookup *b-elem-ah + var curr-result/eax: boolean <- cell-isomorphic? a-elem, b-elem, trace + { + compare curr-result, 0/false + break-if-!= + return 0/false + } + i <- increment + loop + } + return 1/true + } # if a is nil, b should be nil { # (assumes nil? returns 0 or 1) diff --git a/shell/primitives.mu b/shell/primitives.mu index 94eab171..d6d61933 100644 --- a/shell/primitives.mu +++ b/shell/primitives.mu @@ -55,6 +55,8 @@ fn initialize-primitives _self: (addr global-table) { append-primitive self, "write" append-primitive self, "read" append-primitive self, "rewind" + # for arrays + append-primitive self, "array" # misc append-primitive self, "abort" # keep sync'd with render-primitives @@ -98,6 +100,12 @@ fn render-primitives screen: (addr screen), xmin: int, xmax: int, ymax: int { y <- increment set-cursor-position screen, right-min, y draw-text-wrapping-right-then-down-from-cursor screen, " sqrt abs sgn", right-min, y, xmax, ymax, 0x2a/fg=orange, 0xdc/bg=green-bg + y <- increment + set-cursor-position screen, right-min, y + draw-text-wrapping-right-then-down-from-cursor screen, "arrays", right-min, y, xmax, ymax, 7/fg=grey, 0xdc/bg=green-bg + y <- increment + set-cursor-position screen, right-min, y + draw-text-wrapping-right-then-down-from-cursor screen, " array len", right-min, y, xmax, ymax, 0x2a/fg=orange, 0xdc/bg=green-bg #? { #? compare screen, 0 #? break-if-!= @@ -544,6 +552,13 @@ fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr hand return } { + var array?/eax: boolean <- string-equal? f-name, "array" + compare array?, 0/false + break-if-= + apply-array args-ah, out, trace + return + } + { var abort?/eax: boolean <- string-equal? f-name, "abort" compare abort?, 0/false break-if-= @@ -1224,6 +1239,16 @@ fn apply-len _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr new-integer out, result return } + { + { + var first-array?/eax: boolean <- array? first + compare first-array?, 0/false + } + break-if-= + var result/eax: int <- array-length first + new-integer out, result + return + } nil out } @@ -1249,6 +1274,14 @@ fn list-length in: (addr cell) -> _/eax: int { return result } +fn array-length _in: (addr cell) -> _/eax: int { + var in/esi: (addr cell) <- copy _in + var in-data-ah/eax: (addr handle array handle cell) <- get in, array-data + var in-data/eax: (addr array handle cell) <- lookup *in-data-ah + var result/eax: int <- length in-data + return result +} + fn apply-cell-isomorphic _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { trace-text trace, "eval", "apply '='" var args-ah/eax: (addr handle cell) <- copy _args-ah @@ -3420,6 +3453,42 @@ fn apply-blit _args-ah: (addr handle cell), out: (addr handle cell), trace: (add copy-pixels src, dest } +fn apply-array _args-ah: (addr handle cell), _out-ah: (addr handle cell), trace: (addr trace) { + trace-text trace, "eval", "apply 'array'" + var args-ah/eax: (addr handle cell) <- copy _args-ah + var _args/eax: (addr cell) <- lookup *args-ah + var args/esi: (addr cell) <- copy _args + { + var args-type/eax: (addr int) <- get args, type + compare *args-type, 0/pair + break-if-= + error trace, "args to 'array' are not a list" + return + } + var capacity/eax: int <- list-length args + var out-ah/edi: (addr handle cell) <- copy _out-ah + new-array out-ah, capacity + var out/eax: (addr cell) <- lookup *out-ah + var out-data-ah/eax: (addr handle array handle cell) <- get out, array-data + var _out-data/eax: (addr array handle cell) <- lookup *out-data-ah + var out-data/edi: (addr array handle cell) <- copy _out-data + var i/ecx: int <- copy 0 + { + var done?/eax: boolean <- nil? args + compare done?, 0/false + break-if-!= + var curr-ah/eax: (addr handle cell) <- get args, left + var dest-ah/edx: (addr handle cell) <- index out-data, i + copy-object curr-ah, dest-ah + # update loop variables + i <- increment + var next-ah/eax: (addr handle cell) <- get args, right + var next/eax: (addr cell) <- lookup *next-ah + args <- copy next + loop + } +} + fn apply-abort _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { abort "aa" } diff --git a/shell/print.mu b/shell/print.mu index 65e387a7..f37c1ec4 100644 --- a/shell/print.mu +++ b/shell/print.mu @@ -118,6 +118,29 @@ fn print-cell _in: (addr handle cell), out: (addr stream byte), trace: (addr tra trace-higher trace return } + compare *in-type, 7/array + { + break-if-!= + # TODO: gracefully handle trace filling up + write out, "{array" + var data-ah/eax: (addr handle array handle cell) <- get in-addr, array-data + var _data/eax: (addr array handle cell) <- lookup *data-ah + var data/esi: (addr array handle cell) <- copy _data + var i/ecx: int <- copy 0 + var max/edx: int <- length data + { + compare i, max + break-if->= + write out " " + var curr-ah/eax: (addr handle cell) <- index data, i + print-cell curr-ah, out, trace + i <- increment + loop + } + write out, "}" + trace-higher trace + return + } } # debug helper |