- Improved the implementation of continuations.

3 files changed, 88 insertions, 68 deletions

diff --git a/stdlib/source/lux/data/coll/stream.lux b/stdlib/source/lux/data/coll/stream.lux
index 5cb0829e9..c86ab5b61 100644
--- a/stdlib/source/lux/data/coll/stream.lux
+++ b/stdlib/source/lux/data/coll/stream.lux
@@ -7,11 +7,11 @@
        (macro ["s" syntax #+ syntax: Syntax])
        (data (coll [list "List/" Monad<List>])
              bool)
-       (function [cont #+ @lazy Cont])))
+       (function [cont #+ pending Cont])))
 
 ## [Types]
 (type: #export (Stream a)
-  {#;doc "An infinite stream of lazily-evaluated values."}
+  {#;doc "An infinite stream of values."}
   (Cont [a (Stream a)]))
 
 ## [Utils]
@@ -19,21 +19,21 @@
   (All [a]
     (-> a (List a) a (List a) (Stream a)))
   (case xs
-    #;Nil           (@lazy [x (cycle' init full init full)])
-    (#;Cons x' xs') (@lazy [x (cycle' x' xs' init full)])))
+    #;Nil           (pending [x (cycle' init full init full)])
+    (#;Cons x' xs') (pending [x (cycle' x' xs' init full)])))
 
 ## [Functions]
 (def: #export (iterate f x)
   {#;doc "Create a stream by applying a function to a value, and to its result, on and on..."}
   (All [a]
     (-> (-> a a) a (Stream a)))
-  (@lazy [x (iterate f (f x))]))
+  (pending [x (iterate f (f x))]))
 
 (def: #export (repeat x)
   {#;doc "Repeat a value forever."}
   (All [a]
     (-> a (Stream a)))
-  (@lazy [x (repeat x)]))
+  (pending [x (repeat x)]))
 
 (def: #export (cycle xs)
   {#;doc "Go over the elements of a list forever.
@@ -96,13 +96,13 @@
   (All [a b]
     (-> (-> a [a b]) a (Stream b)))
   (let [[next x] (step init)]
-    (@lazy [x (unfold step next)])))
+    (pending [x (unfold step next)])))
 
 (def: #export (filter p xs)
   (All [a] (-> (-> a Bool) (Stream a) (Stream a)))
   (let [[x xs'] (cont;run xs)]
     (if (p x)
-      (@lazy [x (filter p xs')])
+      (pending [x (filter p xs')])
       (filter p xs'))))
 
 (def: #export (partition p xs)
@@ -118,14 +118,14 @@
 (struct: #export _ (Functor Stream)
   (def: (map f fa)
     (let [[h t] (cont;run fa)]
-      (@lazy [(f h) (map f t)]))))
+      (pending [(f h) (map f t)]))))
 
 (struct: #export _ (CoMonad Stream)
   (def: functor Functor<Stream>)
   (def: unwrap head)
   (def: (split wa)
     (let [[head tail] (cont;run wa)]
-      (@lazy [wa (split tail)]))))
+      (pending [wa (split tail)]))))
 
 ## [Pattern-matching]
 (syntax: #export (^stream& [patterns (s;form (s;many s;any))] body [branches (s;some s;any)])
diff --git a/stdlib/source/lux/function/cont.lux b/stdlib/source/lux/function/cont.lux
index f6330cbe4..9074f59f0 100644
--- a/stdlib/source/lux/function/cont.lux
+++ b/stdlib/source/lux/function/cont.lux
@@ -1,69 +1,75 @@
 (;module:
   lux
-  (lux (macro [ast])
-       (control functor
+  (lux (control functor
                 applicative
                 monad)
-       (data (coll list))
-       function))
+       function
+       [compiler #+ with-gensyms]
+       (macro [ast]
+              [syntax #+ syntax:])))
 
-## [Types]
-(type: #export (Cont a)
-  {#;doc "Delimited continuations."}
-  (All [b]
-    (-> (-> a b) b)))
+(type: #export (Cont i o)
+  {#;doc "Continuations."}
+  (-> (-> i o) o))
 
-## [Syntax]
-(macro: #export (@lazy tokens state)
-  {#;doc (doc "Delays the evaluation of an expression, by wrapping it in a continuation 'thunk'."
-              (@lazy (some-computation some-input)))}
-  (case tokens
-    (^ (list value))
-    (let [blank (ast;symbol ["" ""])]
-      (#;Right [state (list (` (;lambda [(~ blank)] ((~ blank) (~ value)))))]))
-    
-    _
-    (#;Left "Wrong syntax for @lazy")))
+(def: #export (continue k cont)
+  {#;doc "Forces a continuation thunk to be evaluated."}
+  (All [i o] (-> (-> i o) (Cont i o) o))
+  (cont k))
+
+(def: #export (run cont)
+  {#;doc "Forces a continuation thunk to be evaluated."}
+  (All [a] (-> (Cont a a) a))
+  (cont id))
 
-## [Functions]
 (def: #export (call/cc f)
   {#;doc "Call with current continuation."}
-  (All [a b c]
-    (-> (-> (-> a (Cont b c))
-            (Cont a c))
-        (Cont a c)))
+  (All [a b z]
+    (-> (-> (-> a (Cont b z))
+            (Cont a z))
+        (Cont a z)))
   (lambda [k]
-    (f (lambda [a _]
-         (k a))
+    (f (lambda [a] (lambda [_] (k a)))
        k)))
 
-(def: #export (continue f thunk)
-  {#;doc "Forces a continuation thunk to be evaluated."}
-  (All [i o]
-    (-> (-> i o) (Cont i o) o))
-  (thunk f))
+(struct: #export Functor<Cont> (All [o] (Functor (All [i] (Cont i o))))
+  (def: (map f fv)
+    (lambda [k] (fv (. k f)))))
 
-(def: #export (run thunk)
-  {#;doc "Forces a continuation thunk to be evaluated."}
-  (All [a]
-    (-> (Cont a) a))
-  (continue id thunk))
-
-## [Structs]
-(struct: #export _ (Functor Cont)
-  (def: (map f ma)
-    (lambda [k] (ma (. k f)))))
-
-(struct: #export _ (Applicative Cont)
+(struct: #export Applicative<Cont> (All [o] (Applicative (All [i] (Cont i o))))
   (def: functor Functor<Cont>)
 
-  (def: (wrap a)
-    (@lazy a))
+  (def: (wrap value)
+    (lambda [k] (k value)))
 
-  (def: (apply ff fa)
-    (@lazy ((run ff) (run fa)))))
+  (def: (apply ff fv)
+    (lambda [k]
+      (|> (k (f v))
+          (lambda [v]) fv
+          (lambda [f]) ff))))
 
-(struct: #export _ (Monad Cont)
+(struct: #export Monad<Cont> (All [o] (Monad (All [i] (Cont i o))))
   (def: applicative Applicative<Cont>)
 
-  (def: join run))
+  (def: (join ffa)
+    (lambda [k]
+      (ffa (continue k)))))
+
+(syntax: #export (pending expr)
+  {#;doc (doc "Turns any expression into a function that is pending a continuation."
+              (pending (some-computation some-input)))}
+  (with-gensyms [g!k]
+    (wrap (list (` (;lambda [(~ g!k)] ((~ g!k) (~ expr))))))))
+
+(def: #export (portal init)
+  (All [i o z]
+    (-> i
+        (Cont [(-> i (Cont o z))
+               i]
+              z)))
+  (call/cc (lambda [k]
+             (do Monad<Cont>
+               [#let [nexus (lambda nexus [val]
+                              (k [nexus val]))]
+                _ (k [nexus init])]
+               (wrap (undefined))))))
diff --git a/stdlib/test/test/lux/function/cont.lux b/stdlib/test/test/lux/function/cont.lux
index c2e36a06b..97058c22f 100644
--- a/stdlib/test/test/lux/function/cont.lux
+++ b/stdlib/test/test/lux/function/cont.lux
@@ -15,10 +15,10 @@
    #let [(^open "&/") &;Monad<Cont>]]
   ($_ seq
       (assert "Can run continuations to compute their values."
-              (n.= sample (&;run (&;@lazy sample))))
+              (n.= sample (&;run (&/wrap sample))))
 
       (assert "Can use functor."
-              (n.= (n.inc sample) (&;run (&/map n.inc (&;@lazy sample)))))
+              (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)))))
@@ -29,10 +29,24 @@
                                             arg (wrap sample)]
                                            (wrap (func arg))))))
 
-      ## (assert "Can access current continuation."
-      ##         (n.= (n.dec sample) (&;run (do &;Monad<Cont>
-      ##                                      [func (wrap n.inc)
-      ##                                       _ (&;call/cc (lambda [k] (k (n.dec sample))))
-      ##                                       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))))))
       ))