shell: streams that you can append graphemes to

3 files changed, 110 insertions, 2 deletions

diff --git a/shell/cell.mu b/shell/cell.mu
index 7d04e5db..9cb6ea9e 100644
--- a/shell/cell.mu
+++ b/shell/cell.mu
@@ -6,7 +6,7 @@ type cell {
   # type 1: number
   number-data: float
   # type 2: symbol
-  # type 3: string
+  # type 3: stream
   text-data: (handle stream byte)
   # type 4: primitive function
   index-data: int
@@ -14,7 +14,7 @@ type cell {
   screen-data: (handle screen)
   # type 6: keyboard
   keyboard-data: (handle gap-buffer)
-  # TODO: array, (associative) table, stream
+  # TODO: array, (associative) table
 }
 
 fn allocate-symbol _out: (addr handle cell) {
@@ -40,6 +40,16 @@ fn new-symbol out: (addr handle cell), val: (addr array byte) {
   initialize-symbol out, val
 }
 
+fn allocate-stream _out: (addr handle cell) {
+  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, 3/stream
+  var dest-ah/eax: (addr handle stream byte) <- get out-addr, text-data
+  populate-stream dest-ah, 0x40/max-stream-size
+}
+
 fn allocate-number _out: (addr handle cell) {
   var out/eax: (addr handle cell) <- copy _out
   allocate out
diff --git a/shell/global.mu b/shell/global.mu
index 1c0dd506..2aacb230 100644
--- a/shell/global.mu
+++ b/shell/global.mu
@@ -28,6 +28,9 @@ fn initialize-globals _self: (addr global-table) {
   append-primitive self, "print"
   # for keyboards
   append-primitive self, "key"
+  # for streams
+  append-primitive self, "stream"
+  append-primitive self, "write"
 }
 
 fn render-globals screen: (addr screen), _self: (addr global-table), xmin: int, ymin: int, xmax: int, ymax: int {
@@ -306,6 +309,20 @@ fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr hand
     apply-wait-for-key args-ah, out, env-h, trace
     return
   }
+  {
+    var is-stream?/eax: boolean <- string-equal? f-name, "stream"
+    compare is-stream?, 0/false
+    break-if-=
+    apply-stream args-ah, out, env-h, trace
+    return
+  }
+  {
+    var write?/eax: boolean <- string-equal? f-name, "write"
+    compare write?, 0/false
+    break-if-=
+    apply-write args-ah, out, env-h, trace
+    return
+  }
   abort "unknown primitive function"
 }
 
@@ -736,3 +753,58 @@ fn wait-for-key keyboard: (addr gap-buffer) -> _/eax: int {
   var result/eax: int <- copy g
   return result
 }
+
+fn apply-stream _args-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), trace: (addr trace) {
+  trace-text trace, "eval", "apply stream"
+  allocate-stream out
+}
+
+fn apply-write _args-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), trace: (addr trace) {
+  trace-text trace, "eval", "apply write"
+  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 _env/eax: (addr cell) <- lookup env-h
+  var env/edi: (addr cell) <- copy _env
+  # TODO: check that args is a pair
+  var empty-args?/eax: boolean <- nil? args
+  compare empty-args?, 0/false
+  {
+    break-if-=
+    error trace, "write needs 2 args but got 0"
+    return
+  }
+  # stream = args->left
+  var first-ah/edx: (addr handle cell) <- get args, left
+  var first/eax: (addr cell) <- lookup *first-ah
+  var first-type/ecx: (addr int) <- get first, type
+  compare *first-type, 3/stream
+  {
+    break-if-=
+    error trace, "first arg for 'write' is not a stream"
+    return
+  }
+  var stream-data-ah/eax: (addr handle stream byte) <- get first, text-data
+  var _stream-data/eax: (addr stream byte) <- lookup *stream-data-ah
+  var stream-data/ebx: (addr stream byte) <- copy _stream-data
+  # args->right->left
+  var right-ah/eax: (addr handle cell) <- get args, right
+  var right/eax: (addr cell) <- lookup *right-ah
+  # TODO: check that right is a pair
+  var second-ah/eax: (addr handle cell) <- get right, left
+  var second/eax: (addr cell) <- lookup *second-ah
+  var second-type/ecx: (addr int) <- get second, type
+  compare *second-type, 1/number
+  {
+    break-if-=
+    error trace, "second arg for stream is not a number/grapheme"
+    return
+  }
+  var second-value/eax: (addr float) <- get second, number-data
+  var x-float/xmm0: float <- copy *second-value
+  var x/eax: int <- convert x-float
+  var x-grapheme/eax: grapheme <- copy x
+  write-grapheme stream-data, x-grapheme
+  # return the stream
+  copy-object first-ah, out
+}
diff --git a/shell/print.mu b/shell/print.mu
index 307b9ffd..ce65b4df 100644
--- a/shell/print.mu
+++ b/shell/print.mu
@@ -40,6 +40,13 @@ fn print-cell _in: (addr handle cell), out: (addr stream byte), trace: (addr tra
     trace-higher trace
     return
   }
+  compare *in-type, 3/stream
+  {
+    break-if-!=
+    print-stream in-addr, out, trace
+    trace-higher trace
+    return
+  }
   compare *in-type, 4/primitive
   {
     break-if-!=
@@ -88,6 +95,25 @@ fn print-symbol _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
   trace trace, "print", stream
 }
 
+fn print-stream _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
+  trace-text trace, "print", "stream"
+  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
+  write out, "["
+  write-stream out, data
+  write out, "]"
+  # trace
+  rewind-stream data
+  var stream-storage: (stream byte 0x40)
+  var stream/ecx: (addr stream byte) <- address stream-storage
+  write stream, "=> stream "
+  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