From 367c56f33d72621120bcf00953f5fafffb028e97 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 3 Apr 2017 19:19:09 -0400 Subject: - Renamed lux/codata/* to lux/function/* and moved the lux/codata/coll/stream to lux/data/coll/stream. --- stdlib/source/lux/codata/coll/stream.lux | 142 ------------------------- stdlib/source/lux/codata/cont.lux | 69 ------------ stdlib/source/lux/codata/function.lux | 20 ---- stdlib/source/lux/codata/reader.lux | 63 ----------- stdlib/source/lux/codata/state.lux | 125 ---------------------- stdlib/source/lux/codata/thunk.lux | 33 ------ stdlib/source/lux/concurrency/actor.lux | 2 +- stdlib/source/lux/concurrency/frp.lux | 1 - stdlib/source/lux/concurrency/promise.lux | 2 +- stdlib/source/lux/control/order.lux | 4 +- stdlib/source/lux/data/bool.lux | 3 +- stdlib/source/lux/data/coll/list.lux | 3 +- stdlib/source/lux/data/coll/set.lux | 3 +- stdlib/source/lux/data/coll/stream.lux | 142 +++++++++++++++++++++++++ stdlib/source/lux/data/format/json.lux | 1 - stdlib/source/lux/function.lux | 20 ++++ stdlib/source/lux/function/cont.lux | 69 ++++++++++++ stdlib/source/lux/function/reader.lux | 63 +++++++++++ stdlib/source/lux/function/state.lux | 125 ++++++++++++++++++++++ stdlib/source/lux/function/thunk.lux | 33 ++++++ stdlib/source/lux/host.jvm.lux | 1 - stdlib/test/test/lux/cli.lux | 1 - stdlib/test/test/lux/codata/coll/stream.lux | 101 ------------------ stdlib/test/test/lux/codata/cont.lux | 40 ------- stdlib/test/test/lux/codata/reader.lux | 38 ------- stdlib/test/test/lux/codata/state.lux | 50 --------- stdlib/test/test/lux/codata/thunk.lux | 24 ----- stdlib/test/test/lux/concurrency/actor.lux | 3 +- stdlib/test/test/lux/concurrency/frp.lux | 3 +- stdlib/test/test/lux/concurrency/promise.lux | 1 - stdlib/test/test/lux/concurrency/stm.lux | 1 - stdlib/test/test/lux/data/coll/dict.lux | 1 - stdlib/test/test/lux/data/coll/stream.lux | 100 +++++++++++++++++ stdlib/test/test/lux/data/coll/tree/zipper.lux | 1 - stdlib/test/test/lux/data/coll/vector.lux | 1 - stdlib/test/test/lux/data/error/exception.lux | 1 - stdlib/test/test/lux/data/log.lux | 1 - stdlib/test/test/lux/data/number/complex.lux | 1 - stdlib/test/test/lux/data/number/ratio.lux | 1 - stdlib/test/test/lux/data/product.lux | 3 +- stdlib/test/test/lux/data/sum.lux | 1 - stdlib/test/test/lux/data/text.lux | 1 - stdlib/test/test/lux/data/text/format.lux | 3 +- stdlib/test/test/lux/function/cont.lux | 39 +++++++ stdlib/test/test/lux/function/reader.lux | 37 +++++++ stdlib/test/test/lux/function/state.lux | 49 +++++++++ stdlib/test/test/lux/function/thunk.lux | 24 +++++ stdlib/test/test/lux/host.jvm.lux | 1 - stdlib/test/test/lux/io.lux | 3 +- stdlib/test/test/lux/macro/ast.lux | 1 - stdlib/test/test/lux/macro/syntax.lux | 1 - stdlib/test/test/lux/math.lux | 1 - stdlib/test/test/lux/math/logic/continuous.lux | 1 - stdlib/test/test/lux/math/logic/fuzzy.lux | 4 +- stdlib/test/test/lux/math/simple.lux | 1 - stdlib/test/test/lux/pipe.lux | 1 - stdlib/test/tests.lux | 12 +-- 57 files changed, 722 insertions(+), 754 deletions(-) delete mode 100644 stdlib/source/lux/codata/coll/stream.lux delete mode 100644 stdlib/source/lux/codata/cont.lux delete mode 100644 stdlib/source/lux/codata/function.lux delete mode 100644 stdlib/source/lux/codata/reader.lux delete mode 100644 stdlib/source/lux/codata/state.lux delete mode 100644 stdlib/source/lux/codata/thunk.lux create mode 100644 stdlib/source/lux/data/coll/stream.lux create mode 100644 stdlib/source/lux/function.lux create mode 100644 stdlib/source/lux/function/cont.lux create mode 100644 stdlib/source/lux/function/reader.lux create mode 100644 stdlib/source/lux/function/state.lux create mode 100644 stdlib/source/lux/function/thunk.lux delete mode 100644 stdlib/test/test/lux/codata/coll/stream.lux delete mode 100644 stdlib/test/test/lux/codata/cont.lux delete mode 100644 stdlib/test/test/lux/codata/reader.lux delete mode 100644 stdlib/test/test/lux/codata/state.lux delete mode 100644 stdlib/test/test/lux/codata/thunk.lux create mode 100644 stdlib/test/test/lux/data/coll/stream.lux create mode 100644 stdlib/test/test/lux/function/cont.lux create mode 100644 stdlib/test/test/lux/function/reader.lux create mode 100644 stdlib/test/test/lux/function/state.lux create mode 100644 stdlib/test/test/lux/function/thunk.lux diff --git a/stdlib/source/lux/codata/coll/stream.lux b/stdlib/source/lux/codata/coll/stream.lux deleted file mode 100644 index 3089fe1b2..000000000 --- a/stdlib/source/lux/codata/coll/stream.lux +++ /dev/null @@ -1,142 +0,0 @@ -(;module: - lux - (lux (control functor - monad - comonad) - [compiler #+ with-gensyms] - (macro ["s" syntax #+ syntax: Syntax]) - (data (coll [list "List/" Monad]) - bool) - (codata [cont #+ @lazy Cont]))) - -## [Types] -(type: #export (Stream a) - {#;doc "An infinite stream of lazily-evaluated values."} - (Cont [a (Stream a)])) - -## [Utils] -(def: (cycle' x xs init full) - (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)]))) - -## [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))])) - -(def: #export (repeat x) - {#;doc "Repeat a value forever."} - (All [a] - (-> a (Stream a))) - (@lazy [x (repeat x)])) - -(def: #export (cycle xs) - {#;doc "Go over the elements of a list forever. - - The list shouldn't be empty."} - (All [a] - (-> (List a) (Maybe (Stream a)))) - (case xs - #;Nil #;None - (#;Cons x xs') (#;Some (cycle' x xs' x xs')))) - -(do-template [ ] - [(def: #export ( s) - (All [a] (-> (Stream a) )) - (let [[h t] (cont;run s)] - ))] - - [head a h] - [tail (Stream a) t]) - -(def: #export (nth idx s) - (All [a] (-> Nat (Stream a) a)) - (let [[h t] (cont;run s)] - (if (n.> +0 idx) - (nth (n.dec idx) t) - h))) - -(do-template [ ] - [(def: #export ( pred xs) - (All [a] - (-> (Stream a) (List a))) - (let [[x xs'] (cont;run xs)] - (if - (list& x ( xs')) - (list)))) - - (def: #export ( pred xs) - (All [a] - (-> (Stream a) (Stream a))) - (let [[x xs'] (cont;run xs)] - (if - ( xs') - xs))) - - (def: #export ( pred xs) - (All [a] - (-> (Stream a) [(List a) (Stream a)])) - (let [[x xs'] (cont;run xs)] - (if - (let [[tail next] ( xs')] - [(#;Cons [x tail]) next]) - [(list) xs])))] - - [take-while drop-while split-while (-> a Bool) (pred x) pred] - [take drop split Nat (n.> +0 pred) (n.dec pred)] - ) - -(def: #export (unfold step init) - {#;doc "A stateful way of infinitely calculating the values of a stream."} - (All [a b] - (-> (-> a [a b]) a (Stream b))) - (let [[next x] (step init)] - (@lazy [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')]) - (filter p xs')))) - -(def: #export (partition p xs) - {#;doc "Split a stream in two based on a predicate. - - The left side contains all entries for which the predicate is true. - - The right side contains all entries for which the predicate is false."} - (All [a] (-> (-> a Bool) (Stream a) [(Stream a) (Stream a)])) - [(filter p xs) (filter (complement p) xs)]) - -## [Structures] -(struct: #export _ (Functor Stream) - (def: (map f fa) - (let [[h t] (cont;run fa)] - (@lazy [(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)])))) - -## [Pattern-matching] -(syntax: #export (^stream& [patterns (s;form (s;many s;any))] body [branches (s;some s;any)]) - {#;doc (doc "Allows destructuring of streams in pattern-matching expressions." - "Caveat emptor: Only use it for destructuring, and not for testing values within the streams." - (let [(^stream& x y z _tail) (some-stream-func 1 2 3)] - (func x y z)))} - (with-gensyms [g!s] - (let [body+ (` (let [(~@ (List/join (List/map (lambda [pattern] - (list (` [(~ pattern) (~ g!s)]) - (` (cont;run (~ g!s))))) - patterns)))] - (~ body)))] - (wrap (list& g!s body+ branches))))) diff --git a/stdlib/source/lux/codata/cont.lux b/stdlib/source/lux/codata/cont.lux deleted file mode 100644 index 7f1b918f0..000000000 --- a/stdlib/source/lux/codata/cont.lux +++ /dev/null @@ -1,69 +0,0 @@ -(;module: - lux - (lux (macro [ast]) - (control functor - applicative - monad) - (data (coll list))) - (.. function)) - -## [Types] -(type: #export (Cont a) - {#;doc "Delimited continuations."} - (All [b] - (-> (-> a b) b))) - -## [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"))) - -## [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))) - (lambda [k] - (f (lambda [a _] - (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)) - -(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) - (def: functor Functor) - - (def: (wrap a) - (@lazy a)) - - (def: (apply ff fa) - (@lazy ((run ff) (run fa))))) - -(struct: #export _ (Monad Cont) - (def: applicative Applicative) - - (def: join run)) diff --git a/stdlib/source/lux/codata/function.lux b/stdlib/source/lux/codata/function.lux deleted file mode 100644 index cddf5d472..000000000 --- a/stdlib/source/lux/codata/function.lux +++ /dev/null @@ -1,20 +0,0 @@ -(;module: - lux - (lux (control monoid))) - -## [Functions] -(def: #export (const c) - {#;doc "Create constant functions."} - (All [a b] (-> a (-> b a))) - (lambda [_] c)) - -(def: #export (flip f) - {#;doc "Flips the order of the arguments of a function."} - (All [a b c] - (-> (-> a b c) (-> b a c))) - (lambda [x y] (f y x))) - -## [Structures] -(struct: #export Monoid (Monoid (All [a] (-> a a))) - (def: unit id) - (def: append .)) diff --git a/stdlib/source/lux/codata/reader.lux b/stdlib/source/lux/codata/reader.lux deleted file mode 100644 index 955b4bba3..000000000 --- a/stdlib/source/lux/codata/reader.lux +++ /dev/null @@ -1,63 +0,0 @@ -(;module: - lux - (lux (control functor - applicative - ["M" monad #*]))) - -## [Types] -(type: #export (Reader r a) - {#;doc "Computations that have access to some environmental value."} - (-> r a)) - -## [Structures] -(struct: #export Functor (All [r] (Functor (Reader r))) - (def: (map f fa) - (lambda [env] - (f (fa env))))) - -(struct: #export Applicative (All [r] (Applicative (Reader r))) - (def: functor Functor) - - (def: (wrap x) - (lambda [env] x)) - - (def: (apply ff fa) - (lambda [env] - ((ff env) (fa env))))) - -(struct: #export Monad (All [r] (Monad (Reader r))) - (def: applicative Applicative) - - (def: (join mma) - (lambda [env] - (mma env env)))) - -## [Values] -(def: #export ask - {#;doc "Get the environment."} - (All [r] (Reader r r)) - (lambda [env] env)) - -(def: #export (local change reader-proc) - {#;doc "Run computation with a locally-modified environment."} - (All [r a] (-> (-> r r) (Reader r a) (Reader r a))) - (|>. change reader-proc)) - -(def: #export (run env reader-proc) - (All [r a] (-> r (Reader r a) a)) - (reader-proc env)) - -(struct: #export (ReaderT Monad) - {#;doc "Monad transformer for Reader."} - (All [M] (-> (Monad M) (All [e] (Monad (All [a] (Reader e (M a))))))) - (def: applicative (compA Applicative (get@ #M;applicative Monad))) - (def: (join eMeMa) - (lambda [env] - (do Monad - [eMa (run env eMeMa)] - (run env eMa))))) - -(def: #export lift-reader - {#;doc "Lift monadic values to the Reader wrapper."} - (All [M e a] (-> (M a) (Reader e (M a)))) - (:: Monad wrap)) diff --git a/stdlib/source/lux/codata/state.lux b/stdlib/source/lux/codata/state.lux deleted file mode 100644 index 5f5b96e4b..000000000 --- a/stdlib/source/lux/codata/state.lux +++ /dev/null @@ -1,125 +0,0 @@ -(;module: - lux - (lux (control functor - ["A" applicative #*] - ["M" monad #*]))) - -## [Types] -(type: #export (State s a) - {#;doc "Stateful computations."} - (-> s [s a])) - -## [Structures] -(struct: #export Functor (All [s] (Functor (State s))) - (def: (map f ma) - (lambda [state] - (let [[state' a] (ma state)] - [state' (f a)])))) - -(struct: #export Applicative (All [s] (Applicative (State s))) - (def: functor Functor) - - (def: (wrap a) - (lambda [state] - [state a])) - - (def: (apply ff fa) - (lambda [state] - (let [[state' f] (ff state) - [state'' a] (fa state')] - [state'' (f a)])))) - -(struct: #export Monad (All [s] (Monad (State s))) - (def: applicative Applicative) - - (def: (join mma) - (lambda [state] - (let [[state' ma] (mma state)] - (ma state'))))) - -## [Values] -(def: #export get - {#;doc "Read the current state."} - (All [s] (State s s)) - (lambda [state] - [state state])) - -(def: #export (put new-state) - {#;doc "Set the new state."} - (All [s] (-> s (State s Unit))) - (lambda [state] - [new-state []])) - -(def: #export (update change) - {#;doc "Compute the new state."} - (All [s] (-> (-> s s) (State s Unit))) - (lambda [state] - [(change state) []])) - -(def: #export (use user) - {#;doc "Run function on current state."} - (All [s a] (-> (-> s a) (State s a))) - (lambda [state] - [state (user state)])) - -(def: #export (local change action) - {#;doc "Run computation with a locally-modified state."} - (All [s a] (-> (-> s s) (State s a) (State s a))) - (lambda [state] - (let [[state' output] (action (change state))] - [state output]))) - -(def: #export (run state action) - {#;doc "Run a stateful computation."} - (All [s a] (-> s (State s a) [s a])) - (action state)) - -(struct: (Functor Functor) - (All [M s] (-> (Functor M) (Functor (All [a] (-> s (M [s a])))))) - (def: (map f sfa) - (lambda [state] - (:: Functor map (lambda [[s a]] [s (f a)]) - (sfa state))))) - -(struct: (Applicative Monad) - (All [M s] (-> (Monad M) (Applicative (All [a] (-> s (M [s a])))))) - (def: functor (Functor (get@ [#M;applicative #A;functor] - Monad))) - - (def: (wrap a) - (lambda [state] - (:: Monad wrap [state a]))) - - (def: (apply sFf sFa) - (lambda [state] - (do Monad - [[state f] (sFf state) - [state a] (sFa state)] - (wrap [state (f a)]))))) - -(type: #export (State' M s a) - {#;doc "Stateful computations decorated by a monad."} - (-> s (M [s a]))) - -(def: #export (run' state action) - {#;doc "Run a stateful computation decorated by a monad."} - (All [M s a] (-> s (State' M s a) (M [s a]))) - (action state)) - -(struct: #export (StateT Monad) - {#;doc "A monad transformer to create composite stateful computations."} - (All [M s] (-> (Monad M) (Monad (State' M s)))) - (def: applicative (Applicative Monad)) - (def: (join sMsMa) - (lambda [state] - (do Monad - [[state' sMa] (sMsMa state)] - (sMa state'))))) - -(def: #export (lift-state Monad ma) - {#;doc "Lift monadic values to the State' wrapper."} - (All [M s a] (-> (Monad M) (M a) (State' M s a))) - (lambda [state] - (do Monad - [a ma] - (wrap [state a])))) diff --git a/stdlib/source/lux/codata/thunk.lux b/stdlib/source/lux/codata/thunk.lux deleted file mode 100644 index 12af1dfe2..000000000 --- a/stdlib/source/lux/codata/thunk.lux +++ /dev/null @@ -1,33 +0,0 @@ -(;module: - lux - (lux [io] - (control monad) - (concurrency ["A" atom]) - [compiler] - (macro ["s" syntax #+ syntax:]))) - -(type: #export (Thunk a) - (-> [] a)) - -(def: #hidden (freeze' generator) - (All [a] (-> (-> [] a) (-> [] a))) - (let [cache (: (A;Atom (Maybe ($ +0))) - (A;atom #;None))] - (lambda [_] - (case (io;run (A;get cache)) - (#;Some value) - value - - _ - (let [value (generator [])] - (exec (io;run (A;compare-and-swap _ (#;Some value) cache)) - value)))))) - -(syntax: #export (freeze expr) - (do @ - [g!arg (compiler;gensym "")] - (wrap (list (` (freeze' (lambda [(~ g!arg)] (~ expr)))))))) - -(def: #export (thaw thunk) - (All [a] (-> (Thunk a) a)) - (thunk [])) diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/concurrency/actor.lux index 97ce7dec3..56b40f41b 100644 --- a/stdlib/source/lux/concurrency/actor.lux +++ b/stdlib/source/lux/concurrency/actor.lux @@ -2,7 +2,7 @@ lux (lux (control monad) [io #- run] - (codata function) + function (data [error #- fail] text/format (coll [list "List/" Monoid Monad]) diff --git a/stdlib/source/lux/concurrency/frp.lux b/stdlib/source/lux/concurrency/frp.lux index f84103e3f..6d18a73bb 100644 --- a/stdlib/source/lux/concurrency/frp.lux +++ b/stdlib/source/lux/concurrency/frp.lux @@ -5,7 +5,6 @@ monad eq) [io #- run] - (codata function) (data (coll [list "L/" Monoid]) text/format) [compiler] diff --git a/stdlib/source/lux/concurrency/promise.lux b/stdlib/source/lux/concurrency/promise.lux index ef7efd923..e94aa68e5 100644 --- a/stdlib/source/lux/concurrency/promise.lux +++ b/stdlib/source/lux/concurrency/promise.lux @@ -5,7 +5,7 @@ text/format error) [io #- run] - (codata function) + function (control functor applicative monad) diff --git a/stdlib/source/lux/control/order.lux b/stdlib/source/lux/control/order.lux index 153100cff..eb2a6f81b 100644 --- a/stdlib/source/lux/control/order.lux +++ b/stdlib/source/lux/control/order.lux @@ -1,7 +1,7 @@ (;module: lux - (.. eq) - lux/codata/function) + (lux function) + (.. eq)) ## [Signatures] (sig: #export (Order a) diff --git a/stdlib/source/lux/data/bool.lux b/stdlib/source/lux/data/bool.lux index 0b8d207fc..2d89de635 100644 --- a/stdlib/source/lux/data/bool.lux +++ b/stdlib/source/lux/data/bool.lux @@ -2,8 +2,7 @@ lux (lux (control monoid eq - codec) - (codata function))) + codec))) ## [Structures] (struct: #export _ (Eq Bool) diff --git a/stdlib/source/lux/data/coll/list.lux b/stdlib/source/lux/data/coll/list.lux index 5f2ef3984..4f93bb541 100644 --- a/stdlib/source/lux/data/coll/list.lux +++ b/stdlib/source/lux/data/coll/list.lux @@ -8,8 +8,7 @@ [fold]) (data [number "Int/" Number Codec] bool - [product]) - codata/function)) + [product]))) ## [Types] ## (type: (List a) diff --git a/stdlib/source/lux/data/coll/set.lux b/stdlib/source/lux/data/coll/set.lux index 3ac6725c1..e10f20488 100644 --- a/stdlib/source/lux/data/coll/set.lux +++ b/stdlib/source/lux/data/coll/set.lux @@ -6,8 +6,7 @@ eq [hash #*]) (data (coll [dict] - [list "List/" Fold Functor])) - (codata function))) + [list "List/" Fold Functor])))) ## [Types] (type: #export (Set a) diff --git a/stdlib/source/lux/data/coll/stream.lux b/stdlib/source/lux/data/coll/stream.lux new file mode 100644 index 000000000..5cb0829e9 --- /dev/null +++ b/stdlib/source/lux/data/coll/stream.lux @@ -0,0 +1,142 @@ +(;module: + lux + (lux (control functor + monad + comonad) + [compiler #+ with-gensyms] + (macro ["s" syntax #+ syntax: Syntax]) + (data (coll [list "List/" Monad]) + bool) + (function [cont #+ @lazy Cont]))) + +## [Types] +(type: #export (Stream a) + {#;doc "An infinite stream of lazily-evaluated values."} + (Cont [a (Stream a)])) + +## [Utils] +(def: (cycle' x xs init full) + (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)]))) + +## [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))])) + +(def: #export (repeat x) + {#;doc "Repeat a value forever."} + (All [a] + (-> a (Stream a))) + (@lazy [x (repeat x)])) + +(def: #export (cycle xs) + {#;doc "Go over the elements of a list forever. + + The list shouldn't be empty."} + (All [a] + (-> (List a) (Maybe (Stream a)))) + (case xs + #;Nil #;None + (#;Cons x xs') (#;Some (cycle' x xs' x xs')))) + +(do-template [ ] + [(def: #export ( s) + (All [a] (-> (Stream a) )) + (let [[h t] (cont;run s)] + ))] + + [head a h] + [tail (Stream a) t]) + +(def: #export (nth idx s) + (All [a] (-> Nat (Stream a) a)) + (let [[h t] (cont;run s)] + (if (n.> +0 idx) + (nth (n.dec idx) t) + h))) + +(do-template [ ] + [(def: #export ( pred xs) + (All [a] + (-> (Stream a) (List a))) + (let [[x xs'] (cont;run xs)] + (if + (list& x ( xs')) + (list)))) + + (def: #export ( pred xs) + (All [a] + (-> (Stream a) (Stream a))) + (let [[x xs'] (cont;run xs)] + (if + ( xs') + xs))) + + (def: #export ( pred xs) + (All [a] + (-> (Stream a) [(List a) (Stream a)])) + (let [[x xs'] (cont;run xs)] + (if + (let [[tail next] ( xs')] + [(#;Cons [x tail]) next]) + [(list) xs])))] + + [take-while drop-while split-while (-> a Bool) (pred x) pred] + [take drop split Nat (n.> +0 pred) (n.dec pred)] + ) + +(def: #export (unfold step init) + {#;doc "A stateful way of infinitely calculating the values of a stream."} + (All [a b] + (-> (-> a [a b]) a (Stream b))) + (let [[next x] (step init)] + (@lazy [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')]) + (filter p xs')))) + +(def: #export (partition p xs) + {#;doc "Split a stream in two based on a predicate. + + The left side contains all entries for which the predicate is true. + + The right side contains all entries for which the predicate is false."} + (All [a] (-> (-> a Bool) (Stream a) [(Stream a) (Stream a)])) + [(filter p xs) (filter (complement p) xs)]) + +## [Structures] +(struct: #export _ (Functor Stream) + (def: (map f fa) + (let [[h t] (cont;run fa)] + (@lazy [(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)])))) + +## [Pattern-matching] +(syntax: #export (^stream& [patterns (s;form (s;many s;any))] body [branches (s;some s;any)]) + {#;doc (doc "Allows destructuring of streams in pattern-matching expressions." + "Caveat emptor: Only use it for destructuring, and not for testing values within the streams." + (let [(^stream& x y z _tail) (some-stream-func 1 2 3)] + (func x y z)))} + (with-gensyms [g!s] + (let [body+ (` (let [(~@ (List/join (List/map (lambda [pattern] + (list (` [(~ pattern) (~ g!s)]) + (` (cont;run (~ g!s))))) + patterns)))] + (~ body)))] + (wrap (list& g!s body+ branches))))) diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index 8565fb32f..066777fdf 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -19,7 +19,6 @@ (coll [list "" Fold "List/" Monad] [vector #+ Vector vector "Vector/" Monad] [dict #+ Dict])) - (codata [function]) [compiler #+ Monad with-gensyms] (macro [syntax #+ syntax:] [ast] diff --git a/stdlib/source/lux/function.lux b/stdlib/source/lux/function.lux new file mode 100644 index 000000000..cddf5d472 --- /dev/null +++ b/stdlib/source/lux/function.lux @@ -0,0 +1,20 @@ +(;module: + lux + (lux (control monoid))) + +## [Functions] +(def: #export (const c) + {#;doc "Create constant functions."} + (All [a b] (-> a (-> b a))) + (lambda [_] c)) + +(def: #export (flip f) + {#;doc "Flips the order of the arguments of a function."} + (All [a b c] + (-> (-> a b c) (-> b a c))) + (lambda [x y] (f y x))) + +## [Structures] +(struct: #export Monoid (Monoid (All [a] (-> a a))) + (def: unit id) + (def: append .)) diff --git a/stdlib/source/lux/function/cont.lux b/stdlib/source/lux/function/cont.lux new file mode 100644 index 000000000..f6330cbe4 --- /dev/null +++ b/stdlib/source/lux/function/cont.lux @@ -0,0 +1,69 @@ +(;module: + lux + (lux (macro [ast]) + (control functor + applicative + monad) + (data (coll list)) + function)) + +## [Types] +(type: #export (Cont a) + {#;doc "Delimited continuations."} + (All [b] + (-> (-> a b) b))) + +## [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"))) + +## [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))) + (lambda [k] + (f (lambda [a _] + (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)) + +(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) + (def: functor Functor) + + (def: (wrap a) + (@lazy a)) + + (def: (apply ff fa) + (@lazy ((run ff) (run fa))))) + +(struct: #export _ (Monad Cont) + (def: applicative Applicative) + + (def: join run)) diff --git a/stdlib/source/lux/function/reader.lux b/stdlib/source/lux/function/reader.lux new file mode 100644 index 000000000..955b4bba3 --- /dev/null +++ b/stdlib/source/lux/function/reader.lux @@ -0,0 +1,63 @@ +(;module: + lux + (lux (control functor + applicative + ["M" monad #*]))) + +## [Types] +(type: #export (Reader r a) + {#;doc "Computations that have access to some environmental value."} + (-> r a)) + +## [Structures] +(struct: #export Functor (All [r] (Functor (Reader r))) + (def: (map f fa) + (lambda [env] + (f (fa env))))) + +(struct: #export Applicative (All [r] (Applicative (Reader r))) + (def: functor Functor) + + (def: (wrap x) + (lambda [env] x)) + + (def: (apply ff fa) + (lambda [env] + ((ff env) (fa env))))) + +(struct: #export Monad (All [r] (Monad (Reader r))) + (def: applicative Applicative) + + (def: (join mma) + (lambda [env] + (mma env env)))) + +## [Values] +(def: #export ask + {#;doc "Get the environment."} + (All [r] (Reader r r)) + (lambda [env] env)) + +(def: #export (local change reader-proc) + {#;doc "Run computation with a locally-modified environment."} + (All [r a] (-> (-> r r) (Reader r a) (Reader r a))) + (|>. change reader-proc)) + +(def: #export (run env reader-proc) + (All [r a] (-> r (Reader r a) a)) + (reader-proc env)) + +(struct: #export (ReaderT Monad) + {#;doc "Monad transformer for Reader."} + (All [M] (-> (Monad M) (All [e] (Monad (All [a] (Reader e (M a))))))) + (def: applicative (compA Applicative (get@ #M;applicative Monad))) + (def: (join eMeMa) + (lambda [env] + (do Monad + [eMa (run env eMeMa)] + (run env eMa))))) + +(def: #export lift-reader + {#;doc "Lift monadic values to the Reader wrapper."} + (All [M e a] (-> (M a) (Reader e (M a)))) + (:: Monad wrap)) diff --git a/stdlib/source/lux/function/state.lux b/stdlib/source/lux/function/state.lux new file mode 100644 index 000000000..5f5b96e4b --- /dev/null +++ b/stdlib/source/lux/function/state.lux @@ -0,0 +1,125 @@ +(;module: + lux + (lux (control functor + ["A" applicative #*] + ["M" monad #*]))) + +## [Types] +(type: #export (State s a) + {#;doc "Stateful computations."} + (-> s [s a])) + +## [Structures] +(struct: #export Functor (All [s] (Functor (State s))) + (def: (map f ma) + (lambda [state] + (let [[state' a] (ma state)] + [state' (f a)])))) + +(struct: #export Applicative (All [s] (Applicative (State s))) + (def: functor Functor) + + (def: (wrap a) + (lambda [state] + [state a])) + + (def: (apply ff fa) + (lambda [state] + (let [[state' f] (ff state) + [state'' a] (fa state')] + [state'' (f a)])))) + +(struct: #export Monad (All [s] (Monad (State s))) + (def: applicative Applicative) + + (def: (join mma) + (lambda [state] + (let [[state' ma] (mma state)] + (ma state'))))) + +## [Values] +(def: #export get + {#;doc "Read the current state."} + (All [s] (State s s)) + (lambda [state] + [state state])) + +(def: #export (put new-state) + {#;doc "Set the new state."} + (All [s] (-> s (State s Unit))) + (lambda [state] + [new-state []])) + +(def: #export (update change) + {#;doc "Compute the new state."} + (All [s] (-> (-> s s) (State s Unit))) + (lambda [state] + [(change state) []])) + +(def: #export (use user) + {#;doc "Run function on current state."} + (All [s a] (-> (-> s a) (State s a))) + (lambda [state] + [state (user state)])) + +(def: #export (local change action) + {#;doc "Run computation with a locally-modified state."} + (All [s a] (-> (-> s s) (State s a) (State s a))) + (lambda [state] + (let [[state' output] (action (change state))] + [state output]))) + +(def: #export (run state action) + {#;doc "Run a stateful computation."} + (All [s a] (-> s (State s a) [s a])) + (action state)) + +(struct: (Functor Functor) + (All [M s] (-> (Functor M) (Functor (All [a] (-> s (M [s a])))))) + (def: (map f sfa) + (lambda [state] + (:: Functor map (lambda [[s a]] [s (f a)]) + (sfa state))))) + +(struct: (Applicative Monad) + (All [M s] (-> (Monad M) (Applicative (All [a] (-> s (M [s a])))))) + (def: functor (Functor (get@ [#M;applicative #A;functor] + Monad))) + + (def: (wrap a) + (lambda [state] + (:: Monad wrap [state a]))) + + (def: (apply sFf sFa) + (lambda [state] + (do Monad + [[state f] (sFf state) + [state a] (sFa state)] + (wrap [state (f a)]))))) + +(type: #export (State' M s a) + {#;doc "Stateful computations decorated by a monad."} + (-> s (M [s a]))) + +(def: #export (run' state action) + {#;doc "Run a stateful computation decorated by a monad."} + (All [M s a] (-> s (State' M s a) (M [s a]))) + (action state)) + +(struct: #export (StateT Monad) + {#;doc "A monad transformer to create composite stateful computations."} + (All [M s] (-> (Monad M) (Monad (State' M s)))) + (def: applicative (Applicative Monad)) + (def: (join sMsMa) + (lambda [state] + (do Monad + [[state' sMa] (sMsMa state)] + (sMa state'))))) + +(def: #export (lift-state Monad ma) + {#;doc "Lift monadic values to the State' wrapper."} + (All [M s a] (-> (Monad M) (M a) (State' M s a))) + (lambda [state] + (do Monad + [a ma] + (wrap [state a])))) diff --git a/stdlib/source/lux/function/thunk.lux b/stdlib/source/lux/function/thunk.lux new file mode 100644 index 000000000..12af1dfe2 --- /dev/null +++ b/stdlib/source/lux/function/thunk.lux @@ -0,0 +1,33 @@ +(;module: + lux + (lux [io] + (control monad) + (concurrency ["A" atom]) + [compiler] + (macro ["s" syntax #+ syntax:]))) + +(type: #export (Thunk a) + (-> [] a)) + +(def: #hidden (freeze' generator) + (All [a] (-> (-> [] a) (-> [] a))) + (let [cache (: (A;Atom (Maybe ($ +0))) + (A;atom #;None))] + (lambda [_] + (case (io;run (A;get cache)) + (#;Some value) + value + + _ + (let [value (generator [])] + (exec (io;run (A;compare-and-swap _ (#;Some value) cache)) + value)))))) + +(syntax: #export (freeze expr) + (do @ + [g!arg (compiler;gensym "")] + (wrap (list (` (freeze' (lambda [(~ g!arg)] (~ expr)))))))) + +(def: #export (thaw thunk) + (All [a] (-> (Thunk a) a)) + (thunk [])) diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index 002208fd2..a527a7dda 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -3,7 +3,6 @@ (lux (control monad [enum]) [io #+ IO Monad io] - (codata function) (data (coll [list #* "" Functor Fold "List/" Monad Monoid] [array #+ Array]) number diff --git a/stdlib/test/test/lux/cli.lux b/stdlib/test/test/lux/cli.lux index e8dbf1f82..8393d459b 100644 --- a/stdlib/test/test/lux/cli.lux +++ b/stdlib/test/test/lux/cli.lux @@ -8,7 +8,6 @@ [product] [sum] (coll [list])) - (codata function) ["&" cli] ["R" math/random] pipe) diff --git a/stdlib/test/test/lux/codata/coll/stream.lux b/stdlib/test/test/lux/codata/coll/stream.lux deleted file mode 100644 index 4c69f9f7b..000000000 --- a/stdlib/test/test/lux/codata/coll/stream.lux +++ /dev/null @@ -1,101 +0,0 @@ -(;module: - lux - (lux [io] - (control monad - comonad) - (data [text "Text/" Monoid] - text/format - (coll [list]) - [number "Nat/" Codec]) - (codata function - [cont] - (coll ["&" stream])) - ["R" math/random] - pipe) - lux/test) - -(test: "Streams" - [size (|> R;nat (:: @ map (|>. (n.% +100) (n.max +2)))) - offset (|> R;nat (:: @ map (n.% +100))) - factor (|> R;nat (:: @ map (|>. (n.% +100) (n.max +2)))) - elem R;nat - cycle-seed (R;list size R;nat) - cycle-sample-idx (|> R;nat (:: @ map (n.% +1000))) - #let [(^open "List/") (list;Eq number;Eq) - sample0 (&;iterate n.inc +0) - sample1 (&;iterate n.inc offset)]] - ($_ seq - (assert "Can move along a stream and take slices off it." - (and (and (List/= (list;n.range +0 (n.dec size)) - (&;take size sample0)) - (List/= (list;n.range offset (n.dec (n.+ offset size))) - (&;take size (&;drop offset sample0))) - (let [[drops takes...] (&;split size sample0)] - (and (List/= (list;n.range +0 (n.dec size)) - drops) - (List/= (list;n.range size (n.dec (n.* +2 size))) - (&;take size takes...))))) - (and (List/= (list;n.range +0 (n.dec size)) - (&;take-while (n.< size) sample0)) - (List/= (list;n.range offset (n.dec (n.+ offset size))) - (&;take-while (n.< (n.+ offset size)) - (&;drop-while (n.< offset) sample0))) - (let [[drops takes...] (&;split-while (n.< size) sample0)] - (and (List/= (list;n.range +0 (n.dec size)) - drops) - (List/= (list;n.range size (n.dec (n.* +2 size))) - (&;take-while (n.< (n.* +2 size)) takes...))))) - )) - - (assert "Can repeat any element and infinite number of times." - (n.= elem (&;nth offset (&;repeat elem)))) - - (assert "Can obtain the head & tail of a stream." - (and (n.= offset (&;head sample1)) - (List/= (list;n.range (n.inc offset) (n.+ offset size)) - (&;take size (&;tail sample1))))) - - (assert "Can filter streams." - (and (n.= (n.* +2 offset) - (&;nth offset - (&;filter n.even? sample0))) - (let [[evens odds] (&;partition n.even? (&;iterate n.inc +0))] - (and (n.= (n.* +2 offset) - (&;nth offset evens)) - (n.= (n.inc (n.* +2 offset)) - (&;nth offset odds)))))) - - (assert "Functor goes over 'all' elements in a stream." - (let [(^open "&/") &;Functor - there (&/map (n.* factor) sample0) - back-again (&/map (n./ factor) there)] - (and (not (List/= (&;take size sample0) - (&;take size there))) - (List/= (&;take size sample0) - (&;take size back-again))))) - - (assert "CoMonad produces a value for every element in a stream." - (let [(^open "&/") &;Functor] - (List/= (&;take size (&/map (n.* factor) sample1)) - (&;take size - (be &;CoMonad - [inputs sample1] - (n.* factor (&;head inputs))))))) - - (assert "'unfold' generalizes 'iterate'." - (let [(^open "&/") &;Functor - (^open "List/") (list;Eq text;Eq)] - (List/= (&;take size - (&/map Nat/encode (&;iterate n.inc offset))) - (&;take size - (&;unfold (lambda [n] [(n.inc n) (Nat/encode n)]) - offset))))) - - (assert "Can cycle over the same elements as an infinite stream." - (|> (&;cycle cycle-seed) - (default (undefined)) - (&;nth cycle-sample-idx) - (n.= (default (undefined) - (list;nth (n.% size cycle-sample-idx) - cycle-seed))))) - )) diff --git a/stdlib/test/test/lux/codata/cont.lux b/stdlib/test/test/lux/codata/cont.lux deleted file mode 100644 index cef7661b0..000000000 --- a/stdlib/test/test/lux/codata/cont.lux +++ /dev/null @@ -1,40 +0,0 @@ -(;module: - lux - (lux [io] - (control monad) - (data [text "Text/" Monoid] - text/format - [number] - [product]) - (codata function - ["&" cont]) - ["R" math/random] - pipe) - lux/test) - -(test: "Continuations" - [sample R;nat - #let [(^open "&/") &;Monad]] - ($_ seq - (assert "Can run continuations to compute their values." - (n.= sample (&;run (&;@lazy sample)))) - - (assert "Can use functor." - (n.= (n.inc sample) (&;run (&/map n.inc (&;@lazy 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 - [func (wrap n.inc) - 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)))))) - )) diff --git a/stdlib/test/test/lux/codata/reader.lux b/stdlib/test/test/lux/codata/reader.lux deleted file mode 100644 index 021ee1ab9..000000000 --- a/stdlib/test/test/lux/codata/reader.lux +++ /dev/null @@ -1,38 +0,0 @@ -(;module: - lux - (lux [io] - (control monad) - (data [text "Text/" Monoid] - text/format - [number]) - (codata function - ["&" reader]) - pipe) - lux/test) - -(test: "Readers" - ($_ seq - (assert "" (i.= 123 (&;run 123 &;ask))) - (assert "" (i.= 246 (&;run 123 (&;local (i.* 2) &;ask)))) - (assert "" (i.= 134 (&;run 123 (:: &;Functor map i.inc (i.+ 10))))) - (assert "" (i.= 10 (&;run 123 (:: &;Applicative wrap 10)))) - (assert "" (i.= 30 (&;run 123 (let [(^open "&/") &;Applicative] - (&/apply (&/wrap (i.+ 10)) (&/wrap 20)))))) - (assert "" (i.= 30 (&;run 123 (do &;Monad - [f (wrap i.+) - x (wrap 10) - y (wrap 20)] - (wrap (f x y)))))))) - -(test: "Monad transformer" - (let [(^open "io/") io;Monad] - (assert "Can add reader functionality to any monad." - (|> (do (&;ReaderT io;Monad) - [a (&;lift-reader (io/wrap 123)) - b (wrap 456)] - (wrap (i.+ a b))) - (&;run "") - io;run - (case> 579 true - _ false))) - )) diff --git a/stdlib/test/test/lux/codata/state.lux b/stdlib/test/test/lux/codata/state.lux deleted file mode 100644 index c6a6c7ee6..000000000 --- a/stdlib/test/test/lux/codata/state.lux +++ /dev/null @@ -1,50 +0,0 @@ -(;module: - lux - (lux [io] - (control monad) - (data [text "Text/" Monoid] - text/format - [number] - [product]) - (codata function - ["&" state]) - pipe) - lux/test) - -(test: "State" - ($_ seq - (assert "" (i.= 123 (product;right (&;run 123 &;get)))) - (assert "" (i.= 321 (product;right (&;run 123 (do &;Monad - [_ (&;put 321)] - &;get))))) - (assert "" (i.= 369 (product;right (&;run 123 (do &;Monad - [_ (&;update (i.* 3))] - &;get))))) - (assert "" (i.= 124 (product;right (&;run 123 (&;use i.inc))))) - (assert "" (i.= 246 (product;right (&;run 123 (&;local (i.* 2) &;get))))) - (assert "" (i.= 124 (product;right (&;run 123 (:: &;Functor map i.inc &;get))))) - (assert "" (i.= 10 (product;right (&;run 123 (:: &;Applicative wrap 10))))) - (assert "" (i.= 30 (product;right (&;run 123 (let [(^open "&/") &;Applicative] - (&/apply (&/wrap (i.+ 10)) (&/wrap 20))))))) - (assert "" (i.= 30 (product;right (&;run 123 (: (&;State Int Int) - (do &;Monad - [f (wrap i.+) - x (wrap 10) - y (wrap 20)] - (wrap (f x y)))))))) - )) - -(test: "Monad transformer" - (let [lift (&;lift-state io;Monad) - (^open "io/") io;Monad] - (assert "Can add state functionality to any monad." - (|> (: (&;State' io;IO Text Int) - (do (&;StateT io;Monad) - [a (lift (io/wrap 123)) - b (wrap 456)] - (wrap (i.+ a b)))) - (&;run' "") - io;run - (case> ["" 579] true - _ false))) - )) diff --git a/stdlib/test/test/lux/codata/thunk.lux b/stdlib/test/test/lux/codata/thunk.lux deleted file mode 100644 index eb6a24701..000000000 --- a/stdlib/test/test/lux/codata/thunk.lux +++ /dev/null @@ -1,24 +0,0 @@ -(;module: - lux - (lux [io] - (control monad) - (codata ["&" thunk]) - pipe - ["R" math/random]) - lux/test) - -(test: "Thunks" - [left R;nat - right R;nat - #let [thunk (&;freeze (n.* left right)) - expected (n.* left right)]] - ($_ seq - (assert "Thunking does not alter the expected value." - (n.= expected - (&;thaw thunk))) - (assert "Thunks only evaluate once." - (and (not (is expected - (&;thaw thunk))) - (is (&;thaw thunk) - (&;thaw thunk)))) - )) diff --git a/stdlib/test/test/lux/concurrency/actor.lux b/stdlib/test/test/lux/concurrency/actor.lux index e13a1ccc5..49100ef01 100644 --- a/stdlib/test/test/lux/concurrency/actor.lux +++ b/stdlib/test/test/lux/concurrency/actor.lux @@ -6,8 +6,7 @@ text/format [error #- fail]) (concurrency [promise #+ Promise Monad "Promise/" Monad] - ["&" actor #+ actor:]) - (codata function)) + ["&" actor #+ actor:])) lux/test) (actor: Adder diff --git a/stdlib/test/test/lux/concurrency/frp.lux b/stdlib/test/test/lux/concurrency/frp.lux index 80f15ad3d..6c2e9af99 100644 --- a/stdlib/test/test/lux/concurrency/frp.lux +++ b/stdlib/test/test/lux/concurrency/frp.lux @@ -6,8 +6,7 @@ text/format [error #- fail]) (concurrency [promise #+ Promise Monad "Promise/" Monad] - ["&" frp]) - (codata function)) + ["&" frp])) lux/test) (def: (List->Chan values) diff --git a/stdlib/test/test/lux/concurrency/promise.lux b/stdlib/test/test/lux/concurrency/promise.lux index d75d6d676..a054e5a96 100644 --- a/stdlib/test/test/lux/concurrency/promise.lux +++ b/stdlib/test/test/lux/concurrency/promise.lux @@ -6,7 +6,6 @@ text/format [error #- fail]) (concurrency ["&" promise]) - (codata function) ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/concurrency/stm.lux b/stdlib/test/test/lux/concurrency/stm.lux index f9e46b91d..d48d20a9d 100644 --- a/stdlib/test/test/lux/concurrency/stm.lux +++ b/stdlib/test/test/lux/concurrency/stm.lux @@ -7,7 +7,6 @@ text/format) (concurrency ["&" stm] [promise]) - (codata function) ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/data/coll/dict.lux b/stdlib/test/test/lux/data/coll/dict.lux index ff36cc362..3df06abcf 100644 --- a/stdlib/test/test/lux/data/coll/dict.lux +++ b/stdlib/test/test/lux/data/coll/dict.lux @@ -9,7 +9,6 @@ [char] (coll ["&" dict] [list "List/" Fold Functor])) - (codata function) ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/data/coll/stream.lux b/stdlib/test/test/lux/data/coll/stream.lux new file mode 100644 index 000000000..2be6aa054 --- /dev/null +++ b/stdlib/test/test/lux/data/coll/stream.lux @@ -0,0 +1,100 @@ +(;module: + lux + (lux [io] + (control monad + comonad) + (data [text "Text/" Monoid] + text/format + (coll [list] + ["&" stream]) + [number "Nat/" Codec]) + (function [cont]) + ["R" math/random] + pipe) + lux/test) + +(test: "Streams" + [size (|> R;nat (:: @ map (|>. (n.% +100) (n.max +2)))) + offset (|> R;nat (:: @ map (n.% +100))) + factor (|> R;nat (:: @ map (|>. (n.% +100) (n.max +2)))) + elem R;nat + cycle-seed (R;list size R;nat) + cycle-sample-idx (|> R;nat (:: @ map (n.% +1000))) + #let [(^open "List/") (list;Eq number;Eq) + sample0 (&;iterate n.inc +0) + sample1 (&;iterate n.inc offset)]] + ($_ seq + (assert "Can move along a stream and take slices off it." + (and (and (List/= (list;n.range +0 (n.dec size)) + (&;take size sample0)) + (List/= (list;n.range offset (n.dec (n.+ offset size))) + (&;take size (&;drop offset sample0))) + (let [[drops takes...] (&;split size sample0)] + (and (List/= (list;n.range +0 (n.dec size)) + drops) + (List/= (list;n.range size (n.dec (n.* +2 size))) + (&;take size takes...))))) + (and (List/= (list;n.range +0 (n.dec size)) + (&;take-while (n.< size) sample0)) + (List/= (list;n.range offset (n.dec (n.+ offset size))) + (&;take-while (n.< (n.+ offset size)) + (&;drop-while (n.< offset) sample0))) + (let [[drops takes...] (&;split-while (n.< size) sample0)] + (and (List/= (list;n.range +0 (n.dec size)) + drops) + (List/= (list;n.range size (n.dec (n.* +2 size))) + (&;take-while (n.< (n.* +2 size)) takes...))))) + )) + + (assert "Can repeat any element and infinite number of times." + (n.= elem (&;nth offset (&;repeat elem)))) + + (assert "Can obtain the head & tail of a stream." + (and (n.= offset (&;head sample1)) + (List/= (list;n.range (n.inc offset) (n.+ offset size)) + (&;take size (&;tail sample1))))) + + (assert "Can filter streams." + (and (n.= (n.* +2 offset) + (&;nth offset + (&;filter n.even? sample0))) + (let [[evens odds] (&;partition n.even? (&;iterate n.inc +0))] + (and (n.= (n.* +2 offset) + (&;nth offset evens)) + (n.= (n.inc (n.* +2 offset)) + (&;nth offset odds)))))) + + (assert "Functor goes over 'all' elements in a stream." + (let [(^open "&/") &;Functor + there (&/map (n.* factor) sample0) + back-again (&/map (n./ factor) there)] + (and (not (List/= (&;take size sample0) + (&;take size there))) + (List/= (&;take size sample0) + (&;take size back-again))))) + + (assert "CoMonad produces a value for every element in a stream." + (let [(^open "&/") &;Functor] + (List/= (&;take size (&/map (n.* factor) sample1)) + (&;take size + (be &;CoMonad + [inputs sample1] + (n.* factor (&;head inputs))))))) + + (assert "'unfold' generalizes 'iterate'." + (let [(^open "&/") &;Functor + (^open "List/") (list;Eq text;Eq)] + (List/= (&;take size + (&/map Nat/encode (&;iterate n.inc offset))) + (&;take size + (&;unfold (lambda [n] [(n.inc n) (Nat/encode n)]) + offset))))) + + (assert "Can cycle over the same elements as an infinite stream." + (|> (&;cycle cycle-seed) + (default (undefined)) + (&;nth cycle-sample-idx) + (n.= (default (undefined) + (list;nth (n.% size cycle-sample-idx) + cycle-seed))))) + )) diff --git a/stdlib/test/test/lux/data/coll/tree/zipper.lux b/stdlib/test/test/lux/data/coll/tree/zipper.lux index 888701bbe..ed0318cfe 100644 --- a/stdlib/test/test/lux/data/coll/tree/zipper.lux +++ b/stdlib/test/test/lux/data/coll/tree/zipper.lux @@ -8,7 +8,6 @@ [text "Text/" Monoid] text/format [number]) - (codata function) ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/data/coll/vector.lux b/stdlib/test/test/lux/data/coll/vector.lux index c82493df0..735374c5c 100644 --- a/stdlib/test/test/lux/data/coll/vector.lux +++ b/stdlib/test/test/lux/data/coll/vector.lux @@ -7,7 +7,6 @@ [text "Text/" Monoid] text/format [number]) - (codata function) ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/data/error/exception.lux b/stdlib/test/test/lux/data/error/exception.lux index 96108e448..41d01077e 100644 --- a/stdlib/test/test/lux/data/error/exception.lux +++ b/stdlib/test/test/lux/data/error/exception.lux @@ -7,7 +7,6 @@ [text] text/format [number]) - (codata function) ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/data/log.lux b/stdlib/test/test/lux/data/log.lux index 8854ec191..40a124490 100644 --- a/stdlib/test/test/lux/data/log.lux +++ b/stdlib/test/test/lux/data/log.lux @@ -6,7 +6,6 @@ [text "Text/" Monoid Eq] [number] [product]) - (codata function) pipe) lux/test) diff --git a/stdlib/test/test/lux/data/number/complex.lux b/stdlib/test/test/lux/data/number/complex.lux index f5c89d5ee..8ed27680c 100644 --- a/stdlib/test/test/lux/data/number/complex.lux +++ b/stdlib/test/test/lux/data/number/complex.lux @@ -9,7 +9,6 @@ ["&" number/complex] (coll [list "List/" Fold Functor]) [product]) - (codata function) [math] ["R" math/random] pipe) diff --git a/stdlib/test/test/lux/data/number/ratio.lux b/stdlib/test/test/lux/data/number/ratio.lux index a082050f8..c1f7e104f 100644 --- a/stdlib/test/test/lux/data/number/ratio.lux +++ b/stdlib/test/test/lux/data/number/ratio.lux @@ -9,7 +9,6 @@ ["&" number/ratio "&/" Number] (coll [list "List/" Fold Functor]) [product]) - (codata function) ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/data/product.lux b/stdlib/test/test/lux/data/product.lux index 3021f8b6d..00337ebfb 100644 --- a/stdlib/test/test/lux/data/product.lux +++ b/stdlib/test/test/lux/data/product.lux @@ -4,8 +4,7 @@ (control monad) (data product [text "Text/" Monoid] - [number]) - (codata function)) + [number])) lux/test) (test: "Products" diff --git a/stdlib/test/test/lux/data/sum.lux b/stdlib/test/test/lux/data/sum.lux index 907eacac0..8ab124c1b 100644 --- a/stdlib/test/test/lux/data/sum.lux +++ b/stdlib/test/test/lux/data/sum.lux @@ -6,7 +6,6 @@ [text "Text/" Monoid] [number] (coll [list])) - (codata function) pipe) lux/test) diff --git a/stdlib/test/test/lux/data/text.lux b/stdlib/test/test/lux/data/text.lux index ce72cd520..4563d9b12 100644 --- a/stdlib/test/test/lux/data/text.lux +++ b/stdlib/test/test/lux/data/text.lux @@ -7,7 +7,6 @@ text/format [number] (coll [list])) - (codata function) ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/test/lux/data/text/format.lux b/stdlib/test/test/lux/data/text/format.lux index ed05a013d..97b955e20 100644 --- a/stdlib/test/test/lux/data/text/format.lux +++ b/stdlib/test/test/lux/data/text/format.lux @@ -4,8 +4,7 @@ (control monad) (data text/format [text] - [number]) - (codata function)) + [number])) lux/test) (test: "Formatters" diff --git a/stdlib/test/test/lux/function/cont.lux b/stdlib/test/test/lux/function/cont.lux new file mode 100644 index 000000000..ba1224bb8 --- /dev/null +++ b/stdlib/test/test/lux/function/cont.lux @@ -0,0 +1,39 @@ +(;module: + lux + (lux [io] + (control monad) + (data [text "Text/" Monoid] + text/format + [number] + [product]) + (function ["&" cont]) + ["R" math/random] + pipe) + lux/test) + +(test: "Continuations" + [sample R;nat + #let [(^open "&/") &;Monad]] + ($_ seq + (assert "Can run continuations to compute their values." + (n.= sample (&;run (&;@lazy sample)))) + + (assert "Can use functor." + (n.= (n.inc sample) (&;run (&/map n.inc (&;@lazy 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 + [func (wrap n.inc) + 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)))))) + )) diff --git a/stdlib/test/test/lux/function/reader.lux b/stdlib/test/test/lux/function/reader.lux new file mode 100644 index 000000000..14b95af94 --- /dev/null +++ b/stdlib/test/test/lux/function/reader.lux @@ -0,0 +1,37 @@ +(;module: + lux + (lux [io] + (control monad) + (data [text "Text/" Monoid] + text/format + [number]) + (function ["&" reader]) + pipe) + lux/test) + +(test: "Readers" + ($_ seq + (assert "" (i.= 123 (&;run 123 &;ask))) + (assert "" (i.= 246 (&;run 123 (&;local (i.* 2) &;ask)))) + (assert "" (i.= 134 (&;run 123 (:: &;Functor map i.inc (i.+ 10))))) + (assert "" (i.= 10 (&;run 123 (:: &;Applicative wrap 10)))) + (assert "" (i.= 30 (&;run 123 (let [(^open "&/") &;Applicative] + (&/apply (&/wrap (i.+ 10)) (&/wrap 20)))))) + (assert "" (i.= 30 (&;run 123 (do &;Monad + [f (wrap i.+) + x (wrap 10) + y (wrap 20)] + (wrap (f x y)))))))) + +(test: "Monad transformer" + (let [(^open "io/") io;Monad] + (assert "Can add reader functionality to any monad." + (|> (do (&;ReaderT io;Monad) + [a (&;lift-reader (io/wrap 123)) + b (wrap 456)] + (wrap (i.+ a b))) + (&;run "") + io;run + (case> 579 true + _ false))) + )) diff --git a/stdlib/test/test/lux/function/state.lux b/stdlib/test/test/lux/function/state.lux new file mode 100644 index 000000000..186b786e0 --- /dev/null +++ b/stdlib/test/test/lux/function/state.lux @@ -0,0 +1,49 @@ +(;module: + lux + (lux [io] + (control monad) + (data [text "Text/" Monoid] + text/format + [number] + [product]) + (function ["&" state]) + pipe) + lux/test) + +(test: "State" + ($_ seq + (assert "" (i.= 123 (product;right (&;run 123 &;get)))) + (assert "" (i.= 321 (product;right (&;run 123 (do &;Monad + [_ (&;put 321)] + &;get))))) + (assert "" (i.= 369 (product;right (&;run 123 (do &;Monad + [_ (&;update (i.* 3))] + &;get))))) + (assert "" (i.= 124 (product;right (&;run 123 (&;use i.inc))))) + (assert "" (i.= 246 (product;right (&;run 123 (&;local (i.* 2) &;get))))) + (assert "" (i.= 124 (product;right (&;run 123 (:: &;Functor map i.inc &;get))))) + (assert "" (i.= 10 (product;right (&;run 123 (:: &;Applicative wrap 10))))) + (assert "" (i.= 30 (product;right (&;run 123 (let [(^open "&/") &;Applicative] + (&/apply (&/wrap (i.+ 10)) (&/wrap 20))))))) + (assert "" (i.= 30 (product;right (&;run 123 (: (&;State Int Int) + (do &;Monad + [f (wrap i.+) + x (wrap 10) + y (wrap 20)] + (wrap (f x y)))))))) + )) + +(test: "Monad transformer" + (let [lift (&;lift-state io;Monad) + (^open "io/") io;Monad] + (assert "Can add state functionality to any monad." + (|> (: (&;State' io;IO Text Int) + (do (&;StateT io;Monad) + [a (lift (io/wrap 123)) + b (wrap 456)] + (wrap (i.+ a b)))) + (&;run' "") + io;run + (case> ["" 579] true + _ false))) + )) diff --git a/stdlib/test/test/lux/function/thunk.lux b/stdlib/test/test/lux/function/thunk.lux new file mode 100644 index 000000000..e3e9aca1b --- /dev/null +++ b/stdlib/test/test/lux/function/thunk.lux @@ -0,0 +1,24 @@ +(;module: + lux + (lux [io] + (control monad) + (function ["&" thunk]) + pipe + ["R" math/random]) + lux/test) + +(test: "Thunks" + [left R;nat + right R;nat + #let [thunk (&;freeze (n.* left right)) + expected (n.* left right)]] + ($_ seq + (assert "Thunking does not alter the expected value." + (n.= expected + (&;thaw thunk))) + (assert "Thunks only evaluate once." + (and (not (is expected + (&;thaw thunk))) + (is (&;thaw thunk) + (&;thaw thunk)))) + )) diff --git a/stdlib/test/test/lux/host.jvm.lux b/stdlib/test/test/lux/host.jvm.lux index ff875ec2a..f58b706d5 100644 --- a/stdlib/test/test/lux/host.jvm.lux +++ b/stdlib/test/test/lux/host.jvm.lux @@ -6,7 +6,6 @@ [number] [product] [text "Text/" Eq]) - (codata function) ["&" host #+ jvm-import class: interface: object] ["R" math/random] pipe) diff --git a/stdlib/test/test/lux/io.lux b/stdlib/test/test/lux/io.lux index e7238aef1..839996e81 100644 --- a/stdlib/test/test/lux/io.lux +++ b/stdlib/test/test/lux/io.lux @@ -4,8 +4,7 @@ (control monad) (data [text "Text/" Monoid Eq] text/format - [number]) - (codata function)) + [number])) lux/test) (test: "I/O" diff --git a/stdlib/test/test/lux/macro/ast.lux b/stdlib/test/test/lux/macro/ast.lux index 58efc1b83..768dafbf8 100644 --- a/stdlib/test/test/lux/macro/ast.lux +++ b/stdlib/test/test/lux/macro/ast.lux @@ -1,7 +1,6 @@ (;module: lux (lux [io] - (codata function) (control monad) (data [text "T/" Eq] text/format diff --git a/stdlib/test/test/lux/macro/syntax.lux b/stdlib/test/test/lux/macro/syntax.lux index 329e16a0f..b9dd304e1 100644 --- a/stdlib/test/test/lux/macro/syntax.lux +++ b/stdlib/test/test/lux/macro/syntax.lux @@ -10,7 +10,6 @@ [char] [ident] [error #- fail]) - (codata function) ["R" math/random] pipe [compiler] diff --git a/stdlib/test/test/lux/math.lux b/stdlib/test/test/lux/math.lux index b1c9b100e..4d8b8d12a 100644 --- a/stdlib/test/test/lux/math.lux +++ b/stdlib/test/test/lux/math.lux @@ -8,7 +8,6 @@ [number "r/" Number] (coll [list "List/" Fold Functor]) [product]) - (codata function) ["R" math/random] pipe ["&" math]) diff --git a/stdlib/test/test/lux/math/logic/continuous.lux b/stdlib/test/test/lux/math/logic/continuous.lux index ab907d6bd..fa08ec864 100644 --- a/stdlib/test/test/lux/math/logic/continuous.lux +++ b/stdlib/test/test/lux/math/logic/continuous.lux @@ -2,7 +2,6 @@ lux (lux [io] (control monad) - (codata function) ["R" math/random] pipe ["&" math/logic/continuous]) diff --git a/stdlib/test/test/lux/math/logic/fuzzy.lux b/stdlib/test/test/lux/math/logic/fuzzy.lux index 45c54bb44..afcd8b731 100644 --- a/stdlib/test/test/lux/math/logic/fuzzy.lux +++ b/stdlib/test/test/lux/math/logic/fuzzy.lux @@ -2,7 +2,6 @@ lux (lux [io] (control monad) - (codata function) (data (coll [list] [set]) [bool "B/" Eq] @@ -16,6 +15,7 @@ (do-template [ ] [(test: (format "[" "] " "Triangles") + #seed +1981055421923629192 [x y z @@ -52,6 +52,7 @@ (do-template [ ] [(test: (format "[" "] " "Trapezoids") + #seed +8418494856347027801 [w x y @@ -94,6 +95,7 @@ ) (test: "Gaussian" + #seed +1000679812414 [deviation R;real center R;real #let [gaussian (&;gaussian deviation center)]] diff --git a/stdlib/test/test/lux/math/simple.lux b/stdlib/test/test/lux/math/simple.lux index 7a70ec1a6..32f5fb20c 100644 --- a/stdlib/test/test/lux/math/simple.lux +++ b/stdlib/test/test/lux/math/simple.lux @@ -8,7 +8,6 @@ [number "r/" Number] (coll [list "List/" Fold Functor]) [product]) - (codata function) ["R" math/random] pipe ["&" math/simple]) diff --git a/stdlib/test/test/lux/pipe.lux b/stdlib/test/test/lux/pipe.lux index 383043ebb..08866a3f4 100644 --- a/stdlib/test/test/lux/pipe.lux +++ b/stdlib/test/test/lux/pipe.lux @@ -7,7 +7,6 @@ [product] identity [text "T/" Eq]) - (codata function) ["R" math/random] pipe) lux/test) diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index 53a003756..ca0079092 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -12,11 +12,10 @@ ["_;" pipe] ["_;" lexer] (lexer ["_;" regex]) - (codata ["_;" cont] - ["_;" reader] - ["_;" state] - ["_;" thunk] - (coll ["_;" stream])) + (function ["_;" cont] + ["_;" reader] + ["_;" state] + ["_;" thunk]) (concurrency ["_;" actor] ["_;" atom] ["_;" frp] @@ -51,7 +50,8 @@ (tree [rose] [zipper]) ["_;" seq] - ["_;" priority-queue]) + ["_;" priority-queue] + ["_;" stream]) (text [format]) ) ["_;" math] -- cgit v1.2.3