diff options
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/lux/data/coll/stream.lux | 20 | ||||
-rw-r--r-- | stdlib/source/lux/function/cont.lux | 106 |
2 files changed, 66 insertions, 60 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)))))) |