aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/data/coll/stream.lux20
-rw-r--r--stdlib/source/lux/function/cont.lux106
-rw-r--r--stdlib/test/test/lux/function/cont.lux30
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))))))
))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-09 20:12:13 +0000