aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
authorEduardo Julian2017-04-09 19:41:15 -0400
committerEduardo Julian2017-04-09 19:41:15 -0400
commitd4c23b4cce91ae8cfcf1bda6b577ff50c55abe3c (patch)
tree077028003e74b1eda56348b886be13f063fad36b /stdlib
parent2b551329f9f622bfa3e2c0cbf4d223bcfa8496f7 (diff)
- Added delimited continuations, with static shifting.
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux/function/cont.lux34
-rw-r--r--stdlib/test/test/lux/function/cont.lux108
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>
+ )))