From 2b551329f9f622bfa3e2c0cbf4d223bcfa8496f7 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 8 Apr 2017 19:51:06 -0400 Subject: - Improved the implementation of continuations. --- stdlib/source/lux/data/coll/stream.lux | 20 +++---- stdlib/source/lux/function/cont.lux | 106 +++++++++++++++++---------------- stdlib/test/test/lux/function/cont.lux | 30 +++++++--- 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]) 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) (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 (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 (All [o] (Applicative (All [i] (Cont i o)))) (def: functor Functor) - (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 (All [o] (Monad (All [i] (Cont i o)))) (def: applicative Applicative) - (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 + [#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]] ($_ 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 - ## [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 + [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 + [[restart [output idx]] (&;portal [sample +0])] + (if (n.< +10 idx) + (restart [(n.+ +10 output) (n.inc idx)]) + (wrap output)))))) )) -- cgit v1.2.3