shell: array type

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

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)

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-!=
@@ -543,6 +551,13 @@ fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr hand
     apply-read args-ah, out, trace
     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
@@ -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"
 }

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