diff options
-rw-r--r-- | stdlib/source/lux/function/cont.lux | 2 | ||||
-rw-r--r-- | stdlib/test/test/lux/function/cont.lux | 109 |
2 files changed, 52 insertions, 59 deletions
diff --git a/stdlib/source/lux/function/cont.lux b/stdlib/source/lux/function/cont.lux index 911e66995..7635d7129 100644 --- a/stdlib/source/lux/function/cont.lux +++ b/stdlib/source/lux/function/cont.lux @@ -79,7 +79,7 @@ (lambda [k] (k (run scope)))) -(def: #export (static f) +(def: #export (shift f) (All [a] (-> (-> (-> a (Cont a a)) (Cont a a)) diff --git a/stdlib/test/test/lux/function/cont.lux b/stdlib/test/test/lux/function/cont.lux index 6404ed2ac..eda75833e 100644 --- a/stdlib/test/test/lux/function/cont.lux +++ b/stdlib/test/test/lux/function/cont.lux @@ -15,68 +15,61 @@ [sample R;nat #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) + ($_ seq + (assert "Can run continuations to compute their values." + (n.= sample (&;run (&/wrap sample)))) - (#;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)))) - ))] + (assert "Can use functor." + (n.= (n.inc sample) (&;run (&/map n.inc (&/wrap sample))))) - ["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 applicative." + (n.= (n.inc sample) (&;run (&/apply (&/wrap n.inc) (&/wrap sample))))) - (assert "Can use functor." - (n.= (n.inc sample) (&;run (&/map 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 applicative." - (n.= (n.inc sample) (&;run (&/apply (&/wrap n.inc) (&/wrap sample))))) + (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 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 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)))))) - (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 delimited continuations with shifting." + (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) - (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> - ))) + (#;Cons x xs') + (do &;Monad<Cont> + [output (&;shift (lambda [k] + (do @ + [tail (k xs')] + (wrap (#;Cons x tail)))))] + (visit output)))))] + (L/= elems + (&;run (&;reset (visit elems)))) + )) + )) |