about summary refs log tree commit diff stats
path: root/shell
diff options
context:
space:
mode:
Diffstat (limited to 'shell')
-rw-r--r--shell/evaluate.mu41
-rw-r--r--shell/primitives.mu124
-rw-r--r--shell/print.mu7
-rw-r--r--shell/tokenize.mu2
4 files changed, 152 insertions, 22 deletions
diff --git a/shell/evaluate.mu b/shell/evaluate.mu
index b27405e0..923bd0e4 100644
--- a/shell/evaluate.mu
+++ b/shell/evaluate.mu
@@ -1277,14 +1277,9 @@ fn cell-isomorphic? _a: (addr cell), _b: (addr cell), trace: (addr trace) -> _/e
     trace-text trace, "eval", "=> true (numbers)"
     return 1/true
   }
-  $cell-isomorphic?:text-data: {
-    {
-      compare b-type, 2/symbol
-      break-if-=
-      compare b-type, 3/stream
-      break-if-=
-      break $cell-isomorphic?:text-data
-    }
+  {
+    compare b-type, 2/symbol
+    break-if-!=
     var b-val-ah/eax: (addr handle stream byte) <- get b, text-data
     var _b-val/eax: (addr stream byte) <- lookup *b-val-ah
     var b-val/ecx: (addr stream byte) <- copy _b-val
@@ -1309,6 +1304,36 @@ fn cell-isomorphic? _a: (addr cell), _b: (addr cell), trace: (addr trace) -> _/e
     }
     return match?
   }
+  {
+    compare b-type, 3/stream
+    break-if-!=
+    var a-val-ah/eax: (addr handle stream byte) <- get a, text-data
+    var a-val/eax: (addr stream byte) <- lookup *a-val-ah
+    var a-data-h: (handle array byte)
+    var a-data-ah/edx: (addr handle array byte) <- address a-data-h
+    stream-to-array a-val, a-data-ah
+    var _a-data/eax: (addr array byte) <- lookup *a-data-ah
+    var a-data/edx: (addr array byte) <- copy _a-data
+    var b-val-ah/eax: (addr handle stream byte) <- get b, text-data
+    var b-val/eax: (addr stream byte) <- lookup *b-val-ah
+    var b-data-h: (handle array byte)
+    var b-data-ah/ecx: (addr handle array byte) <- address b-data-h
+    stream-to-array b-val, b-data-ah
+    var b-data/eax: (addr array byte) <- lookup *b-data-ah
+    var match?/eax: boolean <- string-equal? a-data, b-data
+    trace-higher trace
+    {
+      compare match?, 0/false
+      break-if-=
+      trace-text trace, "eval", "=> true (streams)"
+    }
+    {
+      compare match?, 0/false
+      break-if-!=
+      trace-text trace, "eval", "=> false (streams)"
+    }
+    return match?
+  }
   # if objects are primitive functions, compare index-data
   compare b-type, 4/primitive
   {
diff --git a/shell/primitives.mu b/shell/primitives.mu
index c78b44e0..6dc61c23 100644
--- a/shell/primitives.mu
+++ b/shell/primitives.mu
@@ -45,6 +45,8 @@ fn initialize-primitives _self: (addr global-table) {
   # for streams
   append-primitive self, "stream"
   append-primitive self, "write"
+  append-primitive self, "read"
+  append-primitive self, "rewind"
   # misc
   append-primitive self, "abort"
   # keep sync'd with render-primitives
@@ -54,7 +56,7 @@ fn initialize-primitives _self: (addr global-table) {
 # evaluate all their arguments.
 fn render-primitives screen: (addr screen), xmin: int, xmax: int, ymax: int {
   var y/ecx: int <- copy ymax
-  y <- subtract 0xf/primitives-border
+  y <- subtract 0x11/primitives-border
   clear-rect screen, xmin, y, xmax, ymax, 0xdc/bg=green-bg
   y <- increment
   var right-min/edx: int <- copy xmax
@@ -96,7 +98,7 @@ fn render-primitives screen: (addr screen), xmin: int, xmax: int, ymax: int {
 #?     loop-if-=
 #?   }
   y <- copy ymax
-  y <- subtract 0xe/primitives-border
+  y <- subtract 0x10/primitives-border
   var left-max/edx: int <- copy xmax
   left-max <- subtract 0x20/primitives-divider
   var tmpx/eax: int <- copy xmin
@@ -151,6 +153,14 @@ fn render-primitives screen: (addr screen), xmin: int, xmax: int, ymax: int {
   var tmpx/eax: int <- copy xmin
   tmpx <- draw-text-rightward screen, "  write", tmpx, left-max, y, 0x2a/fg=orange, 0xdc/bg=green-bg
   tmpx <- draw-text-rightward screen, ": stream grapheme -> stream", tmpx, left-max, y, 7/fg=grey, 0xdc/bg=green-bg
+  y <- increment
+  var tmpx/eax: int <- copy xmin
+  tmpx <- draw-text-rightward screen, "  rewind clear", tmpx, left-max, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+  tmpx <- draw-text-rightward screen, ": stream", tmpx, left-max, y, 7/fg=grey, 0xdc/bg=green-bg
+  y <- increment
+  var tmpx/eax: int <- copy xmin
+  tmpx <- draw-text-rightward screen, "  read", tmpx, left-max, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+  tmpx <- draw-text-rightward screen, ": stream -> grapheme", tmpx, left-max, y, 7/fg=grey, 0xdc/bg=green-bg
 }
 
 fn primitive-global? _x: (addr global) -> _/eax: boolean {
@@ -462,6 +472,20 @@ fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr hand
     return
   }
   {
+    var rewind?/eax: boolean <- string-equal? f-name, "rewind"
+    compare rewind?, 0/false
+    break-if-=
+    apply-rewind args-ah, out, trace
+    return
+  }
+  {
+    var read?/eax: boolean <- string-equal? f-name, "read"
+    compare read?, 0/false
+    break-if-=
+    apply-read args-ah, out, trace
+    return
+  }
+  {
     var abort?/eax: boolean <- string-equal? f-name, "abort"
     compare abort?, 0/false
     break-if-=
@@ -1584,17 +1608,25 @@ fn apply-clear _args-ah: (addr handle cell), out: (addr handle cell), trace: (ad
   var first-ah/eax: (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, 5/screen
+  compare *first-type, 3/stream
   {
     break-if-=
-    error trace, "first arg for 'clear' is not a screen"
+    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
+    clear-stream stream-data
     return
   }
-  var screen-ah/eax: (addr handle screen) <- get first, screen-data
-  var _screen/eax: (addr screen) <- lookup *screen-ah
-  var screen/ecx: (addr screen) <- copy _screen
-  #
-  clear-screen screen
+  compare *first-type, 5/screen
+  {
+    break-if-!=
+    var screen-ah/eax: (addr handle screen) <- get first, screen-data
+    var _screen/eax: (addr screen) <- lookup *screen-ah
+    var screen/ecx: (addr screen) <- copy _screen
+    clear-screen screen
+    return
+  }
+  error trace, "first arg for 'clear' is not a screen or a stream"
 }
 
 fn apply-up _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
@@ -2024,6 +2056,80 @@ fn apply-write _args-ah: (addr handle cell), out: (addr handle cell), trace: (ad
   copy-object first-ah, out
 }
 
+fn apply-rewind _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+  trace-text trace, "eval", "apply 'rewind'"
+  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/ecx: (addr int) <- get args, type
+    compare *args-type, 0/pair
+    break-if-=
+    error trace, "args to 'rewind' are not a list"
+    return
+  }
+  var empty-args?/eax: boolean <- nil? args
+  compare empty-args?, 0/false
+  {
+    break-if-=
+    error trace, "'rewind' needs 1 arg 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 'rewind' 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
+  rewind-stream stream-data
+  copy-object first-ah, out
+}
+
+fn apply-read _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+  trace-text trace, "eval", "apply 'read'"
+  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/ecx: (addr int) <- get args, type
+    compare *args-type, 0/pair
+    break-if-=
+    error trace, "args to 'read' are not a list"
+    return
+  }
+  var empty-args?/eax: boolean <- nil? args
+  compare empty-args?, 0/false
+  {
+    break-if-=
+    error trace, "'read' needs 1 arg 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 'read' 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
+#?   rewind-stream stream-data
+  var result-grapheme/eax: grapheme <- read-grapheme stream-data
+  var result/eax: int <- copy result-grapheme
+  new-integer out, result
+}
+
 fn apply-lines _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
   trace-text trace, "eval", "apply 'lines'"
   var args-ah/eax: (addr handle cell) <- copy _args-ah
diff --git a/shell/print.mu b/shell/print.mu
index 6db5a25d..0469c002 100644
--- a/shell/print.mu
+++ b/shell/print.mu
@@ -160,7 +160,7 @@ fn print-symbol _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
     error trace, "print-symbol: no space"
     return
   }
-  write-stream out, data
+  write-stream-immutable out, data
   # trace
   var should-trace?/eax: boolean <- should-trace? trace
   compare should-trace?, 0/false
@@ -179,7 +179,6 @@ fn print-stream _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
   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 _required-space/eax: int <- stream-size data
   var required-space/ecx: int <- copy _required-space
   required-space <- add 2  # for []
@@ -192,7 +191,7 @@ fn print-stream _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
     return
   }
   write out, "["
-  write-stream out, data
+  write-stream-immutable out, data
   write out, "]"
   # trace
   var should-trace?/eax: boolean <- should-trace? trace
@@ -202,7 +201,7 @@ fn print-stream _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
   var stream-storage: (stream byte 0x40)
   var stream/ecx: (addr stream byte) <- address stream-storage
   write stream, "=> stream "
-  write-stream stream, data
+  write-stream-immutable stream, data
   trace trace, "print", stream
 }
 
diff --git a/shell/tokenize.mu b/shell/tokenize.mu
index 6ebf5e46..e097e460 100644
--- a/shell/tokenize.mu
+++ b/shell/tokenize.mu
@@ -638,7 +638,7 @@ fn next-stream-token in: (addr gap-buffer), _out: (addr token), trace: (addr tra
     var stream/esi: (addr stream byte) <- address stream-storage
     write stream, "=> "
     rewind-stream out-data
-    write-stream stream, out-data
+    write-stream-immutable stream, out-data
     trace trace, "tokenize", stream
   }
 }
generated by cgit-pink 1.4.1-2-gfad0 (git 2.36.2.497.gbbea4dcf42) at 2024-06-26 15:01:56 +0000