diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/function/cont.lux | 34 | ||||
| -rw-r--r-- | stdlib/test/test/lux/function/cont.lux | 108 |
2 files changed, 93 insertions, 49 deletions
diff --git a/stdlib/source/lux/function/cont.lux b/stdlib/source/lux/function/cont.lux index 9074f59f0..911e66995 100644 --- a/stdlib/source/lux/function/cont.lux +++ b/stdlib/source/lux/function/cont.lux @@ -22,16 +22,6 @@ (All [a] (-> (Cont a a) a)) (cont id)) -(def: #export (call/cc f) - {#;doc "Call with current continuation."} - (All [a b z] - (-> (-> (-> a (Cont b z)) - (Cont a z)) - (Cont a z))) - (lambda [k] - (f (lambda [a] (lambda [_] (k a))) - k))) - (struct: #export Functor<Cont> (All [o] (Functor (All [i] (Cont i o)))) (def: (map f fv) (lambda [k] (fv (. k f))))) @@ -55,6 +45,16 @@ (lambda [k] (ffa (continue k))))) +(def: #export (call/cc f) + {#;doc "Call with current continuation."} + (All [a b z] + (-> (-> (-> a (Cont b z)) + (Cont a z)) + (Cont a z))) + (lambda [k] + (f (lambda [a] (lambda [_] (k a))) + k))) + (syntax: #export (pending expr) {#;doc (doc "Turns any expression into a function that is pending a continuation." (pending (some-computation some-input)))} @@ -73,3 +73,17 @@ (k [nexus val]))] _ (k [nexus init])] (wrap (undefined)))))) + +(def: #export (reset scope) + (All [i o] (-> (Cont i i) (Cont i o))) + (lambda [k] + (k (run scope)))) + +(def: #export (static f) + (All [a] + (-> (-> (-> a (Cont a a)) + (Cont a a)) + (Cont a a))) + (lambda [oc] + (f (lambda [a] (lambda [ic] (ic (oc a)))) + id))) diff --git a/stdlib/test/test/lux/function/cont.lux b/stdlib/test/test/lux/function/cont.lux index 97058c22f..6404ed2ac 100644 --- a/stdlib/test/test/lux/function/cont.lux +++ b/stdlib/test/test/lux/function/cont.lux @@ -5,48 +5,78 @@ (data [text "Text/" Monoid<Text>] text/format [number] - [product]) + [product] + (coll [list])) (function ["&" cont]) ["R" math/random]) lux/test) (test: "Continuations" [sample R;nat - #let [(^open "&/") &;Monad<Cont>]] - ($_ seq - (assert "Can run continuations to compute their values." - (n.= sample (&;run (&/wrap sample)))) - - (assert "Can use functor." - (n.= (n.inc sample) (&;run (&/map n.inc (&/wrap sample))))) - - (assert "Can use applicative." - (n.= (n.inc sample) (&;run (&/apply (&/wrap n.inc) (&/wrap sample))))) - - (assert "Can use monad." - (n.= (n.inc sample) (&;run (do &;Monad<Cont> - [func (wrap n.inc) - arg (wrap sample)] - (wrap (func arg)))))) - - (assert "Can use the current-continuation as a escape hatch." - (n.= (n.* +2 sample) - (&;run (do &;Monad<Cont> - [value (&;call/cc - (lambda [k] - (do @ - [temp (k sample)] - ## If this code where to run, - ## the output would be - ## (n.* +4 sample) - (k temp))))] - (wrap (n.* +2 value)))))) - - (assert "Can use the current-continuation to build a time machine." - (n.= (n.+ +100 sample) - (&;run (do &;Monad<Cont> - [[restart [output idx]] (&;portal [sample +0])] - (if (n.< +10 idx) - (restart [(n.+ +10 output) (n.inc idx)]) - (wrap output)))))) - )) + #let [(^open "&/") &;Monad<Cont>] + elems (R;list +3 R;nat)] + (let% [<delimited-tests> (do-template [<desc> <shift> <prepare>] + [(assert <desc> + (let [(^open "&/") &;Monad<Cont> + (^open "L/") (list;Eq<List> number;Eq<Nat>) + visit (: (-> (List Nat) (&;Cont (List Nat) (List Nat))) + (lambda visit [xs] + (case xs + #;Nil + (&/wrap #;Nil) + + (#;Cons x xs') + (do &;Monad<Cont> + [output (<shift> (lambda [k] + (do &;Monad<Cont> + [tail (k xs')] + (wrap (#;Cons x tail)))))] + (visit output)))))] + (L/= (<prepare> elems) + (&;run (&;reset (visit elems)))) + ))] + + ["Can use delimited continuations with static shifting." + &;static id] + ## ["Can use delimited continuations with dynamic shifting." + ## &;dynamic list;reverse] + )] + ($_ seq + (assert "Can run continuations to compute their values." + (n.= sample (&;run (&/wrap sample)))) + + (assert "Can use functor." + (n.= (n.inc sample) (&;run (&/map n.inc (&/wrap sample))))) + + (assert "Can use applicative." + (n.= (n.inc sample) (&;run (&/apply (&/wrap n.inc) (&/wrap sample))))) + + (assert "Can use monad." + (n.= (n.inc sample) (&;run (do &;Monad<Cont> + [func (wrap n.inc) + arg (wrap sample)] + (wrap (func arg)))))) + + (assert "Can use the current-continuation as a escape hatch." + (n.= (n.* +2 sample) + (&;run (do &;Monad<Cont> + [value (&;call/cc + (lambda [k] + (do @ + [temp (k sample)] + ## If this code where to run, + ## the output would be + ## (n.* +4 sample) + (k temp))))] + (wrap (n.* +2 value)))))) + + (assert "Can use the current-continuation to build a time machine." + (n.= (n.+ +100 sample) + (&;run (do &;Monad<Cont> + [[restart [output idx]] (&;portal [sample +0])] + (if (n.< +10 idx) + (restart [(n.+ +10 output) (n.inc idx)]) + (wrap output)))))) + + <delimited-tests> + ))) |