shell: starting to implement arrays

2 files changed, 65 insertions, 5 deletions

diff --git a/shell/data.limg b/shell/data.limg
index 407af097..b0fc60c0 100644
--- a/shell/data.limg
+++ b/shell/data.limg
@@ -22,10 +22,6 @@
   args])
     (ret . [mac (ret var val . body)
   `(let ,var ,val ,@body ,var)])
-    (len . [def (len l)
-  if (no l)
-    0
-    (1 + (len (cdr l)))])
     (nth . [def (nth n xs)
   if (n < 1)
     (car xs)
diff --git a/shell/primitives.mu b/shell/primitives.mu
index 6c58f00f..c957abf9 100644
--- a/shell/primitives.mu
+++ b/shell/primitives.mu
@@ -22,6 +22,7 @@ fn initialize-primitives _self: (addr global-table) {
   append-primitive self, "no"
   append-primitive self, "not"
   append-primitive self, "dbg"
+  append-primitive self, "len"
   # for pairs
   append-primitive self, "car"
   append-primitive self, "cdr"
@@ -84,7 +85,7 @@ fn render-primitives screen: (addr screen), xmin: int, xmax: int, ymax: int {
   draw-text-wrapping-right-then-down-from-cursor screen, "lists", 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, "  cons car cdr no cons?", right-min, y, xmax, ymax, 0x2a/fg=orange, 0xdc/bg=green-bg
+  draw-text-wrapping-right-then-down-from-cursor screen, "  cons car cdr no cons? len", 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, "numbers", right-min, y, xmax, ymax, 7/fg=grey, 0xdc/bg=green-bg
@@ -312,6 +313,13 @@ fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr hand
     return
   }
   {
+    var len?/eax: boolean <- string-equal? f-name, "len"
+    compare len?, 0/false
+    break-if-=
+    apply-len args-ah, out, trace
+    return
+  }
+  {
     var cell-isomorphic?/eax: boolean <- string-equal? f-name, "="
     compare cell-isomorphic?, 0/false
     break-if-=
@@ -1184,6 +1192,62 @@ fn apply-cons-check _args-ah: (addr handle cell), out: (addr handle cell), trace
   new-integer out, 1
 }
 
+fn apply-len _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+  trace-text trace, "eval", "apply len"
+  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 len are not a list"
+    return
+  }
+  var empty-args?/eax: boolean <- nil? args
+  compare empty-args?, 0/false
+  {
+    break-if-=
+    error trace, "len needs 1 arg but got 0"
+    return
+  }
+  # args->left
+  var first-ah/edx: (addr handle cell) <- get args, left
+  var first/eax: (addr cell) <- lookup *first-ah
+  {
+    {
+      var first-pair?/eax: boolean <- pair? first
+      compare first-pair?, 0/false
+    }
+    break-if-=
+    var result/eax: int <- list-length first
+    new-integer out, result
+    return
+  }
+  nil out
+}
+
+fn list-length in: (addr cell) -> _/eax: int {
+  var curr/ecx: (addr cell) <- copy in
+  var result/edi: int <- copy 0
+  {
+    var pair?/eax: boolean <- pair? curr
+    {
+      compare pair?, 0/false
+      break-if-!=
+      abort "len: ran into a non-cons"
+    }
+    var nil?/eax: boolean <- nil? curr
+    compare nil?, 0/false
+    break-if-!=
+    result <- increment
+    var next-ah/eax: (addr handle cell) <- get curr, right
+    var next/eax: (addr cell) <- lookup *next-ah
+    curr <- copy next
+    loop
+  }
+  return result
+}
 
 fn apply-cell-isomorphic _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
   trace-text trace, "eval", "apply '='"