diff options
| -rw-r--r-- | callcc.mu | 20 | ||||
| -rw-r--r-- | color-repl.mu | 33 | ||||
| -rw-r--r-- | mu.arc | 28 |
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*) |