666 - first-class continuations!

3 files changed, 62 insertions, 19 deletions

diff --git a/callcc.mu b/callcc.mu
new file mode 100644
index 00000000..c0c48ef6
--- /dev/null
+++ b/callcc.mu
@@ -0,0 +1,20 @@
+; in mu, call-cc (http://en.wikipedia.org/wiki/Call-with-current-continuation)
+; is constructed out of a combination of two primitives:
+;   'current-continuation', which returns a continuation, and
+;   'continue-from', which takes a continuation to
+
+(function g [
+  (c:continuation <- current-continuation)  ; <-- loop back to here
+  (print-primitive-to-host (("a" literal)))
+  (reply c:continuation)
+])
+
+(function f [
+  (c:continuation <- g)
+  (reply c:continuation)
+])
+
+(function main [
+  (c:continuation <- f)
+  (continue-from c:continuation)            ; <-- ..when you hit this
+])
diff --git a/color-repl.mu b/color-repl.mu
index efa80344..09a29eea 100644
--- a/color-repl.mu
+++ b/color-repl.mu
@@ -5,8 +5,10 @@
 ; how to color each key right as it is printed
 ; lots of logic devoted to handling backspace correctly
 
+; abort continuation -> string
 (function read-sexp [
   (default-space:space-address <- new space:literal 30:literal)
+  (abort:continuation <- next-input)
   (result:buffer-address <- init-buffer 3:literal)
   (open-parens:integer <- copy 0:literal)  ; for balancing parens and tracking nesting depth
   ; we can change color when backspacing over parens or comments or strings,
@@ -17,7 +19,7 @@
     ;   test: 34<enter>
     next-key
     (c:character <- $wait-for-key-from-host)
-    (check-abort c:character)
+    (maybe-cancel-this-sexp c:character abort:continuation)
     ; check for ctrl-d and exit
     { begin
       (eof?:boolean <- equal c:character ((ctrl-d literal)))
@@ -43,7 +45,7 @@
         { begin
           (backspaced-over-close-quote?:boolean <- backspaced-over-unescaped? result:buffer-address ((#\" literal)) escapes:integer-buffer-address)  ; "
           (break-unless backspaced-over-close-quote?:boolean)
-          (slurp-string result:buffer-address escapes:integer-buffer-address)
+          (slurp-string result:buffer-address escapes:integer-buffer-address abort:continuation)
           (jump next-key:offset)
         }
         ;   test: (+ 1 (<backspace>2)
@@ -75,7 +77,7 @@
       (backslash?:boolean <- equal c:character ((#\\ literal)))
       (break-unless backslash?:boolean)
       ($print-key-to-host c:character 7:literal/white)
-      (result:buffer-address escapes:integer-buffer-address <- slurp-escaped-character result:buffer-address 7:literal/white escapes:integer-buffer-address)
+      (result:buffer-address escapes:integer-buffer-address <- slurp-escaped-character result:buffer-address 7:literal/white escapes:integer-buffer-address abort:continuation)
       (jump next-key:offset)
     }
     ; if it's a semi-colon, parse a comment
@@ -83,7 +85,7 @@
       (comment?:boolean <- equal c:character ((#\; literal)))
       (break-unless comment?:boolean)
       ($print-key-to-host c:character 4:literal/fg/blue)
-      (comment-read?:boolean <- slurp-comment result:buffer-address escapes:integer-buffer-address)
+      (comment-read?:boolean <- slurp-comment result:buffer-address escapes:integer-buffer-address abort:continuation)
       ; return if comment was read (i.e. consumed a newline)
       ; test: ;a<backspace><backspace> (shouldn't end command until <enter>)
       (jump-unless comment-read?:boolean next-key:offset)
@@ -97,7 +99,7 @@
       (string-started?:boolean <- equal c:character ((#\" literal)))  ; for vim: "
       (break-unless string-started?:boolean)
       ($print-key-to-host c:character 6:literal/fg/cyan)
-      (slurp-string result:buffer-address escapes:integer-buffer-address)
+      (slurp-string result:buffer-address escapes:integer-buffer-address abort:continuation)
       (jump next-key:offset)
     }
     ; color parens by depth, so they're easy to balance
@@ -145,16 +147,18 @@
   (reply s:string-address)
 ])
 
-; list of characters => whether a comment was consumed (can also return by backspacing past comment leader ';')
+; list of characters, list of indices of escaped characters, abort continuation
+; -> whether a comment was consumed (can also return by backspacing past comment leader ';')
 (function slurp-comment [
   (default-space:space-address <- new space:literal 30:literal)
   (in:buffer-address <- next-input)
   (escapes:integer-buffer-address <- next-input)
+  (abort:continuation <- next-input)
   ; test: ; abc<enter>
   { begin
     next-key-in-comment
     (c:character <- $wait-for-key-from-host)
-    (check-abort c:character)  ; test: check needs to come before print
+    (maybe-cancel-this-sexp c:character abort:continuation)  ; 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>
@@ -181,11 +185,12 @@
   (default-space:space-address <- new space:literal 30:literal)
   (in:buffer-address <- next-input)
   (escapes:integer-buffer-address <- next-input)
+  (abort:continuation <- next-input)
   ; test: "abc"
   { begin
     next-key-in-string
     (c:character <- $wait-for-key-from-host)
-    (check-abort c:character)  ; test: check needs to come before print
+    (maybe-cancel-this-sexp c:character abort:continuation)  ; test: check needs to come before print
     ($print-key-to-host c:character 6:literal/fg/cyan)
     ; handle backspace
     ;   test: "abc<backspace>d"
@@ -219,12 +224,14 @@
   end
 ])
 
+; buffer to add character to, color to print it in to the screen, abort continuation
 (function slurp-escaped-character [
   (default-space:space-address <- new space:literal 30:literal)
   (in:buffer-address <- next-input)
   (color-code:integer <- next-input)
+  (abort:continuation <- next-input)
   (c:character <- $wait-for-key-from-host)
-  (check-abort c:character)  ; test: check needs to come before print
+  (maybe-cancel-this-sexp c:character abort:continuation)  ; 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)
@@ -289,16 +296,17 @@
   (reply result:character)
 ])
 
-(function check-abort [
+(function maybe-cancel-this-sexp [
   ; check for ctrl-g and abort
   (default-space:space-address <- new space:literal 30:literal)
   (c:character <- next-input)
+  (abort:continuation <- 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)
+    (continue-from abort:continuation)
   }
 ])
 
@@ -307,8 +315,9 @@
   (cursor-mode)
   (print-primitive-to-host (("connected to anarki! type in an expression, then hit enter. ctrl-d exits. ctrl-g clears the current expression." literal)))
   (print-character nil:literal/terminal ((#\newline literal)))
+  (abort:continuation <- current-continuation)
   { begin
-    (s:string-address <- read-sexp)
+    (s:string-address <- read-sexp abort:continuation)
     (break-unless s:string-address)
     (retro-mode)  ; print errors cleanly
       (t:string-address <- $eval s:string-address)
diff --git a/mu.arc b/mu.arc
index 56e3f7e3..a89929f9 100644
--- a/mu.arc
+++ b/mu.arc
@@ -129,10 +129,12 @@
   (= type* (table))  ; name -> type info
   (= memory* (table))  ; address -> value
   (= function* (table))  ; name -> [instructions]
+  ; transforming mu programs
   (= location* (table))  ; function -> {name -> index into default-space}
   (= next-space-generator* (table))  ; function -> name of function generating next space
   ; each function's next space will usually always come from a single function
   (= next-routine-id* 0)
+  (= continuation* (table))
   )
 
 (on-init
@@ -195,6 +197,9 @@
               channel (obj size 3  and-record t  elems '((integer) (integer) (tagged-value-array-address))  fields '(first-full first-free circular-buffer))
               ; be careful of accidental copies to channels
               channel-address (obj size 1  address t  elem '(channel))
+              ; opaque pointer to a call stack
+              ; todo: save properly in allocated memory
+              continuation (obj size 1)
               ; editor
               line (obj array t  elem '(character))
               line-address (obj size 1  address t  elem '(line))
@@ -825,13 +830,21 @@
 ;?                     (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
-                      )
-                    ((abort-routine*)))
+                ; first-class continuations
+                current-continuation
+                  (w/uniq continuation-name
+                    (trace "continuation" "saving @(repr rep.routine*!call-stack) to @continuation-name")
+                    (= continuation*.continuation-name (copy rep.routine*!call-stack))
+                    continuation-name)
+                continue-from
+                  (let continuation-name (m arg.0)
+                    (trace "continuation" "restoring @continuation-name")
+                    (trace "continuation" continuation*.continuation-name)
+                    (= rep.routine*!call-stack continuation*.continuation-name)
+                    (trace "continuation" "call stack is now @(repr rep.routine*!call-stack)")
+;?                     (++ pc.routine*) ;? 1
+                    (continue))
+;?                     ((abort-routine*))) ;? 1
 
                 ; user-defined functions
                 next-input
@@ -2523,6 +2536,7 @@
   (map add-code:readfile (cut argv (+ it 1)))
 ;?   (= dump-trace* (obj whitelist '("run")))
 ;?   (= dump-trace* (obj whitelist '("schedule")))
+;?   (= dump-trace* (obj whitelist '("run" "continuation"))) ;? 1
 ;?   (= dump-trace* (obj whitelist '("cn0" "cn1")))
 ;?   (set dump-trace*) ;? 1
 ;?   (freeze function*)