662 - abort current command cleanly on ctrl-g

Poor man's continuation. Not first class or delimited yet. And we see
the problem: hard to specify precisely what to do after unwinding the
stack. We start reaching for a try/catch statement. But let's see if
there's a better way.

2 files changed, 30 insertions, 5 deletions

diff --git a/color-repl.mu b/color-repl.mu
index 104c79f9..aaa7bd58 100644
--- a/color-repl.mu
+++ b/color-repl.mu
@@ -17,6 +17,7 @@
     ;   test: 34<enter>
     next-key
     (c:character <- $wait-for-key-from-host)
+    (check-abort c:character)
     ; check for backspace
     ;   test: 3<backspace>4<enter>
     ;   todo: backspace past newline
@@ -129,7 +130,6 @@
     ($print-key-to-host c:character)
     ;   todo: error on space outside parens, like python
     ;   todo: []
-    ;   todo: give up on ctrl-g
     ;   todo: history on up/down
     ;   todo: don't return if there's no non-whitespace in result
     (jump next-key:offset)
@@ -148,6 +148,7 @@
   { begin
     next-key-in-comment
     (c:character <- $wait-for-key-from-host)
+    (check-abort c:character)  ; test: check needs to come before print
     ($print-key-to-host c:character 4:literal/fg/blue)
     ; handle backspace
     ;   test: ; abc<backspace><backspace>def<enter>
@@ -178,6 +179,7 @@
   { begin
     next-key-in-string
     (c:character <- $wait-for-key-from-host)
+    (check-abort c:character)  ; test: check needs to come before print
     ($print-key-to-host c:character 6:literal/fg/cyan)
     ; handle backspace
     ;   test: "abc<backspace>d"
@@ -215,8 +217,9 @@
   (default-space:space-address <- new space:literal 30:literal)
   (in:buffer-address <- next-input)
   (color-code:integer <- next-input)
-  (c2:character <- $wait-for-key-from-host)
-  ($print-key-to-host c2:character color-code:integer)
+  (c:character <- $wait-for-key-from-host)
+  (check-abort c:character)  ; test: check needs to come before print
+  ($print-key-to-host c:character color-code:integer)
   (escapes:integer-buffer-address <- next-input)
   (len:integer-address <- get-address in:buffer-address/deref length:offset)
   (escapes:integer-buffer-address <- append escapes:integer-buffer-address len:integer-address/deref)  ; todo: type violation
@@ -225,7 +228,7 @@
   ;   test: "abc\<backspace>def"
   ;   test: #\<backspace>
   { begin
-    (backspace?:boolean <- equal c2:character ((#\backspace literal)))
+    (backspace?:boolean <- equal c:character ((#\backspace literal)))
     (break-unless backspace?:boolean)
     ; just typed a backslash, so buffer can't be empty
     (len:integer-address/deref <- subtract len:integer-address/deref 1:literal)
@@ -235,7 +238,7 @@
     (reply in:buffer-address/same-as-arg:0 escapes:integer-buffer-address/same-as-arg:2)
   }
   ; if not backspace, save and return
-  (in:buffer-address <- append in:buffer-address c2:character)
+  (in:buffer-address <- append in:buffer-address c:character)
   (reply in:buffer-address/same-as-arg:0 escapes:integer-buffer-address/same-as-arg:2)
 ])
 
@@ -280,6 +283,19 @@
   (reply result:character)
 ])
 
+(function check-abort [
+  ; check for ctrl-g and abort
+  (default-space:space-address <- new space:literal 30:literal)
+  (c:character <- next-input)
+  { begin
+    (interrupt?:boolean <- equal c:character ((ctrl-g literal)))
+    (break-unless interrupt?:boolean)
+    ($print-key-to-host (("^G" literal)))
+    ($print-key-to-host ((#\newline literal)))
+    (abort-to main:fn)
+  }
+])
+
 (function main [
   (default-space:space-address <- new space:literal 30:literal)
   (cursor-mode)
diff --git a/mu.arc b/mu.arc
index fd6812a4..7e1c5f3e 100644
--- a/mu.arc
+++ b/mu.arc
@@ -825,6 +825,15 @@
 ;?                     (prn x) ;? 1
 ;?                     (new-string:repr:eval x)) ;? 1
 
+                abort-to
+                  (let caller (m arg.0)
+                    (until (is caller top.routine*!fn-name)
+                      (pop-stack routine*)
+                      ; no incrementing pc; we want to retry the call
+                      (-- pc.routine*)  ; temporary hack, hardcoded for color-repl.mu
+                      )
+                    ((abort-routine*)))
+
                 ; user-defined functions
                 next-input
                   (let idx caller-arg-idx.routine*