7837 - printing s-expressions

6 files changed, 343 insertions, 25 deletions

diff --git a/baremetal/shell/cell.mu b/baremetal/shell/cell.mu
index 2e1beb0e..8627af1c 100644
--- a/baremetal/shell/cell.mu
+++ b/baremetal/shell/cell.mu
@@ -28,3 +28,9 @@ fn new-number _out: (addr handle cell) {
   var type/ecx: (addr int) <- get out-addr, type
   copy-to *type, 1/number
 }
+
+fn new-pair _out: (addr handle cell) {
+  var out/eax: (addr handle cell) <- copy _out
+  allocate out
+  # new cells have type pair by default
+}
diff --git a/baremetal/shell/parse.mu b/baremetal/shell/parse.mu
index ab7f440d..5acab714 100644
--- a/baremetal/shell/parse.mu
+++ b/baremetal/shell/parse.mu
@@ -1,13 +1,29 @@
 fn parse-input tokens: (addr stream cell), out: (addr handle cell), trace: (addr trace) {
   rewind-stream tokens
-  parse-sexpression tokens, out, trace
   var empty?/eax: boolean <- stream-empty? tokens
   compare empty?, 0/false
-  break-if-!=
-  error trace, "unexpected tokens at end; only type in a single expression at a time"
+  {
+    break-if-=
+    error trace, "nothing to parse"
+    return
+  }
+  var close-paren?/eax: boolean <- parse-sexpression tokens, out, trace
+  {
+    compare close-paren?, 0/false
+    break-if-=
+    error trace, "')' is not a valid expression"
+    return
+  }
+  {
+    var empty?/eax: boolean <- stream-empty? tokens
+    compare empty?, 0/false
+    break-if-!=
+    error trace, "unexpected tokens at end; only type in a single expression at a time"
+  }
 }
 
-fn parse-sexpression tokens: (addr stream cell), _out: (addr handle cell), trace: (addr trace) {
+# return value: true if close-paren was encountered
+fn parse-sexpression tokens: (addr stream cell), _out: (addr handle cell), trace: (addr trace) -> _/eax: boolean {
   trace-text trace, "read", "parse"
   trace-lower trace
   var curr-token-storage: cell
@@ -16,12 +32,60 @@ fn parse-sexpression tokens: (addr stream cell), _out: (addr handle cell), trace
   compare empty?, 0/false
   {
     break-if-=
-    error trace, "nothing to parse"
-    return
+    error trace, "end of stream; never found a balancing ')'"
+    return 1/true
   }
   read-from-stream tokens, curr-token
-  parse-atom curr-token, _out, trace
+  $parse-sexpression:type-check: {
+    # not bracket -> parse atom
+    var is-bracket-token?/eax: boolean <- is-bracket-token? curr-token
+    compare is-bracket-token?, 0/false
+    {
+      break-if-!=
+      parse-atom curr-token, _out, trace
+      break $parse-sexpression:type-check
+    }
+    # open paren -> parse list
+    var is-open-paren?/eax: boolean <- is-open-paren-token? curr-token
+    compare is-open-paren?, 0/false
+    {
+      break-if-=
+      var curr/esi: (addr handle cell) <- copy _out
+      $parse-sexpression:list-loop: {
+        new-pair curr
+        var curr-addr/eax: (addr cell) <- lookup *curr
+        var left/ecx: (addr handle cell) <- get curr-addr, left
+        {
+          var is-close-paren?/eax: boolean <- parse-sexpression tokens, left, trace
+          compare is-close-paren?, 0/false
+          break-if-!= $parse-sexpression:list-loop
+        }
+        #
+        curr <- get curr-addr, right
+        loop
+      }
+      break $parse-sexpression:type-check
+    }
+    # close paren -> parse list
+    var is-close-paren?/eax: boolean <- is-close-paren-token? curr-token
+    compare is-close-paren?, 0/false
+    {
+      break-if-=
+      trace-higher trace
+      return 1/true
+    }
+    # otherwise abort
+    var stream-storage: (stream byte 0x40)
+    var stream/edx: (addr stream byte) <- address stream-storage
+    write stream, "unexpected token "
+    var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data
+    var curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah
+    rewind-stream curr-token-data
+    write-stream stream, curr-token-data
+    trace trace, "error", stream
+  }
   trace-higher trace
+  return 0/false
 }
 
 fn parse-atom _curr-token: (addr cell), _out: (addr handle cell), trace: (addr trace) {
diff --git a/baremetal/shell/print.mu b/baremetal/shell/print.mu
index d7f24eb2..d3eb6f1f 100644
--- a/baremetal/shell/print.mu
+++ b/baremetal/shell/print.mu
@@ -1,50 +1,242 @@
 fn print-cell _in: (addr handle cell), out: (addr stream byte), trace: (addr trace) {
-  clear-stream out
+  trace-text trace, "print", "print-cell"
+  trace-lower trace
   var in/eax: (addr handle cell) <- copy _in
   var in-addr/eax: (addr cell) <- lookup *in
+  {
+    var is-nil?/eax: boolean <- is-nil? in-addr
+    compare is-nil?, 0/false
+    break-if-=
+    write out, "()"
+    trace-higher trace
+    return
+  }
   var in-type/ecx: (addr int) <- get in-addr, type
+  compare *in-type, 0/pair
+  {
+    break-if-!=
+    print-list in-addr, out, trace
+    trace-higher trace
+    return
+  }
   compare *in-type, 1/number
   {
     break-if-!=
     print-number in-addr, out, trace
+    trace-higher trace
     return
   }
   compare *in-type, 2/symbol
   {
     break-if-!=
     print-symbol in-addr, out, trace
+    trace-higher trace
     return
   }
 }
 
 fn print-symbol _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
-  {
-    compare trace, 0
-    break-if-=
-#?     trace-text trace, "print", "symbol"
-  }
+  trace-text trace, "print", "symbol"
   var in/esi: (addr cell) <- copy _in
   var data-ah/eax: (addr handle stream byte) <- get in, text-data
   var _data/eax: (addr stream byte) <- lookup *data-ah
   var data/esi: (addr stream byte) <- copy _data
   rewind-stream data
-  {
-    var done?/eax: boolean <- stream-empty? data
-    compare done?, 0/false
-    break-if-!=
-    var g/eax: grapheme <- read-grapheme data
-    write-grapheme out, g
+  write-stream out, data
+  # trace
+  rewind-stream data
+  var stream-storage: (stream byte 0x40)
+  var stream/ecx: (addr stream byte) <- address stream-storage
+  write stream, "=> symbol "
+  write-stream stream, data
+  trace trace, "print", stream
+}
+
+fn print-number _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
+  var in/esi: (addr cell) <- copy _in
+  var val/eax: (addr float) <- get in, number-data
+  write-float-decimal-approximate out, *val, 3/precision
+  # trace
+  var stream-storage: (stream byte 0x40)
+  var stream/ecx: (addr stream byte) <- address stream-storage
+  write stream, "=> number "
+  write-float-decimal-approximate stream, *val, 3/precision
+  trace trace, "print", stream
+}
+
+fn print-list _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
+  var curr/esi: (addr cell) <- copy _in
+  write out, "("
+  $print-list:loop: {
+    var left/ecx: (addr handle cell) <- get curr, left
+    {
+      var left-addr/eax: (addr cell) <- lookup *left
+      var left-is-nil?/eax: boolean <- is-nil? left-addr
+      compare left-is-nil?, 0/false
+      {
+        break-if-=
+        trace-text trace, "print", "left is null"
+        break $print-list:loop
+      }
+    }
+    print-cell left, out, trace
+    var right/ecx: (addr handle cell) <- get curr, right
+    var right-addr/eax: (addr cell) <- lookup *right
+    {
+      compare right-addr, 0
+      break-if-!=
+      abort "null encountered"
+    }
+    {
+      var right-is-nil?/eax: boolean <- is-nil? right-addr
+      compare right-is-nil?, 0/false
+      {
+        break-if-=
+        trace-text trace, "print", "right is null"
+        break $print-list:loop
+      }
+    }
+    write out, " "
+    var right-type-addr/edx: (addr int) <- get right-addr, type
+    {
+      compare *right-type-addr, 0/pair
+      break-if-=
+      write out, ". "
+      print-cell right, out, trace
+      break $print-list:loop
+    }
+    curr <- copy right-addr
     loop
   }
+  write out, ")"
 }
 
-fn print-number _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
+# Most lisps intern nil, but we don't really have globals yet, so we'll be
+# less efficient for now.
+fn is-nil? _in: (addr cell) -> _/eax: boolean {
+  var in/esi: (addr cell) <- copy _in
+  # if type != pair, return false
+  var type/eax: (addr int) <- get in, type
+  compare *type, 0/pair
   {
-    compare trace, 0
     break-if-=
-#?     trace-text trace, "print", "number"
+    return 0/false
   }
-  var in/esi: (addr cell) <- copy _in
-  var val/eax: (addr float) <- get in, number-data
-  write-float-decimal-approximate out, *val, 3/precision
+  # if left != null, return false
+  var left-ah/eax: (addr handle cell) <- get in, left
+  var left/eax: (addr cell) <- lookup *left-ah
+  compare left, 0
+  {
+    break-if-=
+    return 0/false
+  }
+  # if right != null, return false
+  var right-ah/eax: (addr handle cell) <- get in, right
+  var right/eax: (addr cell) <- lookup *right-ah
+  compare right, 0
+  {
+    break-if-=
+    return 0/false
+  }
+  return 1/true
+}
+
+fn test-print-cell-zero {
+  var num-storage: (handle cell)
+  var num/esi: (addr handle cell) <- address num-storage
+  new-number num
+  # value is 0 by default
+  var out-storage: (stream byte 0x40)
+  var out/edi: (addr stream byte) <- address out-storage
+  print-cell num, out, 0/no-trace
+  check-stream-equal out, "0", "F - test-print-cell-zero"
+}
+
+fn test-print-cell-integer {
+  var num-storage: (handle cell)
+  var num/esi: (addr handle cell) <- address num-storage
+  new-number num
+  var num-addr/eax: (addr cell) <- lookup *num
+  var num-data/eax: (addr float) <- get num-addr, number-data
+  var src/xmm0: float <- rational 1, 1
+  copy-to *num-data, src
+  var out-storage: (stream byte 0x40)
+  var out/edi: (addr stream byte) <- address out-storage
+  print-cell num, out, 0/no-trace
+  check-stream-equal out, "1", "F - test-print-cell-integer"
+}
+
+fn test-print-cell-integer-2 {
+  var num-storage: (handle cell)
+  var num/esi: (addr handle cell) <- address num-storage
+  new-number num
+  var num-addr/eax: (addr cell) <- lookup *num
+  var num-data/eax: (addr float) <- get num-addr, number-data
+  var src/xmm0: float <- rational 0x30, 1
+  copy-to *num-data, src
+  var out-storage: (stream byte 0x40)
+  var out/edi: (addr stream byte) <- address out-storage
+  print-cell num, out, 0/no-trace
+  check-stream-equal out, "48", "F - test-print-cell-integer-2"
+}
+
+fn test-print-cell-fraction {
+  var num-storage: (handle cell)
+  var num/esi: (addr handle cell) <- address num-storage
+  new-number num
+  var num-addr/eax: (addr cell) <- lookup *num
+  var num-data/eax: (addr float) <- get num-addr, number-data
+  var src/xmm0: float <- rational 1, 2
+  copy-to *num-data, src
+  var out-storage: (stream byte 0x40)
+  var out/edi: (addr stream byte) <- address out-storage
+  print-cell num, out, 0/no-trace
+  check-stream-equal out, "0.5", "F - test-print-cell-fraction"
+}
+
+fn test-print-cell-symbol {
+  var sym-storage: (handle cell)
+  var sym/esi: (addr handle cell) <- address sym-storage
+  new-symbol sym
+  var sym-addr/eax: (addr cell) <- lookup *sym
+  var sym-data-ah/eax: (addr handle stream byte) <- get sym-addr, text-data
+  var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah
+  write sym-data, "abc"
+  var out-storage: (stream byte 0x40)
+  var out/edi: (addr stream byte) <- address out-storage
+  print-cell sym, out, 0/no-trace
+  check-stream-equal out, "abc", "F - test-print-cell-symbol"
+}
+
+fn test-print-cell-nil-list {
+  var nil-storage: (handle cell)
+  var nil/esi: (addr handle cell) <- address nil-storage
+  new-pair nil
+  var out-storage: (stream byte 0x40)
+  var out/edi: (addr stream byte) <- address out-storage
+  print-cell nil, out, 0/no-trace
+  check-stream-equal out, "()", "F - test-print-cell-nil-list"
+}
+
+fn test-print-cell-singleton-list {
+  var list-storage: (handle cell)
+  var list/esi: (addr handle cell) <- address list-storage
+  new-pair list
+  # left
+  var list-addr/eax: (addr cell) <- lookup *list
+  var list-left/eax: (addr handle cell) <- get list-addr, left
+  new-symbol list-left
+  var sym-addr/eax: (addr cell) <- lookup *list-left
+  var sym-data-ah/eax: (addr handle stream byte) <- get sym-addr, text-data
+  var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah
+  write sym-data, "abc"
+  # right
+  var list-addr/eax: (addr cell) <- lookup *list
+  var list-right/eax: (addr handle cell) <- get list-addr, right
+  new-pair list-right
+  #
+  var out-storage: (stream byte 0x40)
+  var out/edi: (addr stream byte) <- address out-storage
+  print-cell list, out, 0/no-trace
+  check-stream-equal out, "(abc)", "F - test-print-cell-singleton-list"
 }
diff --git a/baremetal/shell/sandbox.mu b/baremetal/shell/sandbox.mu
index c8841378..49c2a5f9 100644
--- a/baremetal/shell/sandbox.mu
+++ b/baremetal/shell/sandbox.mu
@@ -175,6 +175,7 @@ fn run in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) {
     return
   }
   # TODO: eval
+  clear-stream out
   print-cell read-result, out, trace
   mark-lines-dirty trace
 }
diff --git a/baremetal/shell/tokenize.mu b/baremetal/shell/tokenize.mu
index 6e8cca0c..7beedf23 100644
--- a/baremetal/shell/tokenize.mu
+++ b/baremetal/shell/tokenize.mu
@@ -382,3 +382,41 @@ fn is-number-token? _in: (addr cell) -> _/eax: boolean {
   var result/eax: boolean <- is-decimal-digit? g
   return result
 }
+
+fn is-bracket-token? _in: (addr cell) -> _/eax: boolean {
+  var in/eax: (addr cell) <- copy _in
+  var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
+  var in-data/eax: (addr stream byte) <- lookup *in-data-ah
+  rewind-stream in-data
+  var g/eax: grapheme <- read-grapheme in-data
+  var result/eax: boolean <- is-bracket-grapheme? g
+  return result
+}
+
+fn is-open-paren-token? _in: (addr cell) -> _/eax: boolean {
+  var in/eax: (addr cell) <- copy _in
+  var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
+  var in-data/eax: (addr stream byte) <- lookup *in-data-ah
+  rewind-stream in-data
+  var g/eax: grapheme <- read-grapheme in-data
+  compare g, 0x28/open-paren
+  {
+    break-if-!=
+    return 1/true
+  }
+  return 0/false
+}
+
+fn is-close-paren-token? _in: (addr cell) -> _/eax: boolean {
+  var in/eax: (addr cell) <- copy _in
+  var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
+  var in-data/eax: (addr stream byte) <- lookup *in-data-ah
+  rewind-stream in-data
+  var g/eax: grapheme <- read-grapheme in-data
+  compare g, 0x29/open-paren
+  {
+    break-if-!=
+    return 1/true
+  }
+  return 0/false
+}
diff --git a/baremetal/shell/trace.mu b/baremetal/shell/trace.mu
index 1fd5ecba..7fd52ceb 100644
--- a/baremetal/shell/trace.mu
+++ b/baremetal/shell/trace.mu
@@ -30,6 +30,8 @@ type trace-line {
 
 fn initialize-trace _self: (addr trace), capacity: int, visible-capacity: int {
   var self/esi: (addr trace) <- copy _self
+  compare self, 0
+  break-if-=
   var trace-ah/eax: (addr handle array trace-line) <- get self, data
   populate trace-ah, capacity
   var visible-ah/eax: (addr handle array trace-line) <- get self, visible
@@ -38,6 +40,8 @@ fn initialize-trace _self: (addr trace), capacity: int, visible-capacity: int {
 
 fn clear-trace _self: (addr trace) {
   var self/eax: (addr trace) <- copy _self
+  compare self, 0
+  break-if-=
   var len/edx: (addr int) <- get self, first-free
   copy-to *len, 0
   # might leak memory; existing elements won't be used anymore
@@ -83,6 +87,8 @@ fn has-errors? _self: (addr trace) -> _/eax: boolean {
 
 fn trace _self: (addr trace), label: (addr array byte), message: (addr stream byte) {
   var self/esi: (addr trace) <- copy _self
+  compare self, 0
+  break-if-=
   var data-ah/eax: (addr handle array trace-line) <- get self, data
   var data/eax: (addr array trace-line) <- lookup *data-ah
   var index-addr/edi: (addr int) <- get self, first-free
@@ -96,6 +102,8 @@ fn trace _self: (addr trace), label: (addr array byte), message: (addr stream by
 }
 
 fn trace-text self: (addr trace), label: (addr array byte), s: (addr array byte) {
+  compare self, 0
+  break-if-=
   var data-storage: (stream byte 0x100)
   var data/eax: (addr stream byte) <- address data-storage
   write data, s
@@ -122,12 +130,16 @@ fn initialize-trace-line depth: int, label: (addr array byte), data: (addr strea
 
 fn trace-lower _self: (addr trace) {
   var self/esi: (addr trace) <- copy _self
+  compare self, 0
+  break-if-=
   var depth/eax: (addr int) <- get self, curr-depth
   increment *depth
 }
 
 fn trace-higher _self: (addr trace) {
   var self/esi: (addr trace) <- copy _self
+  compare self, 0
+  break-if-=
   var depth/eax: (addr int) <- get self, curr-depth
   decrement *depth
 }
@@ -136,6 +148,11 @@ fn render-trace screen: (addr screen), _self: (addr trace), xmin: int, ymin: int
   var already-hiding-lines?: boolean
   var y/ecx: int <- copy ymin
   var self/esi: (addr trace) <- copy _self
+  compare self, 0
+  {
+    break-if-!=
+    return ymin
+  }
   clamp-cursor-to-top self, y
   var trace-ah/eax: (addr handle array trace-line) <- get self, data
   var _trace/eax: (addr array trace-line) <- lookup *trace-ah