diff options
39 files changed, 321 insertions, 275 deletions
diff --git a/stdlib/source/lux/concurrency/frp.lux b/stdlib/source/lux/concurrency/frp.lux index a8c017a90..93d3498d4 100644 --- a/stdlib/source/lux/concurrency/frp.lux +++ b/stdlib/source/lux/concurrency/frp.lux @@ -106,11 +106,6 @@ (struct: #export _ (Applicative Channel) (def: functor Functor<Channel>) - (def: (wrap a) - (let [output (channel [])] - (exec (io.run (publish output a)) - output))) - (def: (apply ff fa) (let [output (channel [])] (exec (io.run (listen (function (_ f) @@ -120,7 +115,12 @@ output)))) (struct: #export _ (Monad Channel) - (def: applicative Applicative<Channel>) + (def: functor Functor<Channel>) + + (def: (wrap a) + (let [output (channel [])] + (exec (io.run (publish output a)) + output))) (def: (join mma) (let [output (channel [])] diff --git a/stdlib/source/lux/concurrency/promise.lux b/stdlib/source/lux/concurrency/promise.lux index 8b7849c93..30895098f 100644 --- a/stdlib/source/lux/concurrency/promise.lux +++ b/stdlib/source/lux/concurrency/promise.lux @@ -82,20 +82,19 @@ (struct: #export _ (Applicative Promise) (def: functor Functor<Promise>) - (def: (wrap a) - (promise (#.Some a))) - (def: (apply ff fa) (let [fb (promise #.None)] (exec (await (function (_ f) (io (await (function (_ a) (resolve (f a) fb)) fa))) ff) - fb)) - )) + fb)))) (struct: #export _ (Monad Promise) - (def: applicative Applicative<Promise>) + (def: functor Functor<Promise>) + + (def: (wrap a) + (promise (#.Some a))) (def: (join mma) (let [ma (promise #.None)] diff --git a/stdlib/source/lux/concurrency/stm.lux b/stdlib/source/lux/concurrency/stm.lux index cdafbc686..6c86af772 100644 --- a/stdlib/source/lux/concurrency/stm.lux +++ b/stdlib/source/lux/concurrency/stm.lux @@ -136,9 +136,6 @@ (struct: #export _ (Applicative STM) (def: functor Functor<STM>) - (def: (wrap a) - (function (_ tx) [tx a])) - (def: (apply ff fa) (function (_ tx) (let [[tx' f] (ff tx) @@ -146,7 +143,10 @@ [tx'' (f a)])))) (struct: #export _ (Monad STM) - (def: applicative Applicative<STM>) + (def: functor Functor<STM>) + + (def: (wrap a) + (function (_ tx) [tx a])) (def: (join mma) (function (_ tx) diff --git a/stdlib/source/lux/concurrency/task.lux b/stdlib/source/lux/concurrency/task.lux index edb72ca6f..1ebfa181c 100644 --- a/stdlib/source/lux/concurrency/task.lux +++ b/stdlib/source/lux/concurrency/task.lux @@ -15,16 +15,16 @@ (def: #export (fail error) (All [a] (-> Text (Task a))) - (:: P.Applicative<Promise> wrap (#E.Error error))) + (:: P.Monad<Promise> wrap (#E.Error error))) (def: #export (throw exception message) (All [e a] (-> (Exception e) e (Task a))) - (:: P.Applicative<Promise> wrap + (:: P.Monad<Promise> wrap (ex.throw exception message))) (def: #export (return value) (All [a] (-> a (Task a))) - (:: P.Applicative<Promise> wrap (#E.Success value))) + (:: P.Monad<Promise> wrap (#E.Success value))) (def: #export (try computation) (All [a] (-> (Task a) (Task (E.Error a)))) @@ -45,8 +45,6 @@ (struct: #export _ (A.Applicative Task) (def: functor Functor<Task>) - (def: wrap return) - (def: (apply ff fa) (do P.Monad<Promise> [ff' ff @@ -57,7 +55,9 @@ (wrap (f a))))))) (struct: #export _ (Monad Task) - (def: applicative Applicative<Task>) + (def: functor Functor<Task>) + + (def: wrap return) (def: (join mma) (do P.Monad<Promise> diff --git a/stdlib/source/lux/control/applicative.lux b/stdlib/source/lux/control/applicative.lux index a827a06d3..2a926cc20 100644 --- a/stdlib/source/lux/control/applicative.lux +++ b/stdlib/source/lux/control/applicative.lux @@ -1,36 +1,34 @@ (.module: lux - (// [functor #+ Functor])) + (// [functor #+ Functor] + [monad #+ Monad])) (sig: #export (Applicative f) {#.doc "Applicative functors."} (: (Functor f) functor) - (: (All [a] - (-> a (f a))) - wrap) (: (All [a b] (-> (f (-> a b)) (f a) (f b))) apply)) -(struct: #export (compose Applicative<F> Applicative<G>) +(struct: #export (compose Monad<F> Applicative<F> Applicative<G>) {#.doc "Applicative functor composition."} - (All [F G] (-> (Applicative F) (Applicative G) (Applicative (All [a] (F (G a)))))) + (All [F G] + (-> (Monad F) (Applicative F) (Applicative G) + (Applicative (All [a] (F (G a)))))) (def: functor (functor.compose (get@ #functor Applicative<F>) (get@ #functor Applicative<G>))) - (def: wrap - (|>> (:: Applicative<G> wrap) (:: Applicative<F> wrap))) (def: (apply fgf fgx) ## TODO: Switch from this version to the one below (in comments) ASAP. (let [fgf' (:: Applicative<F> apply - (:: Applicative<F> wrap (:: Applicative<G> apply)) + (:: Monad<F> wrap (:: Applicative<G> apply)) fgf)] (:: Applicative<F> apply fgf' fgx)) ## (let [applyF (:: Applicative<F> apply) ## applyG (:: Applicative<G> apply)] ## ($_ applyF - ## (:: Applicative<F> wrap applyG) + ## (:: Monad<F> wrap applyG) ## fgf ## fgx)) )) diff --git a/stdlib/source/lux/control/codec.lux b/stdlib/source/lux/control/codec.lux index b1b6df5d9..0630a11d1 100644 --- a/stdlib/source/lux/control/codec.lux +++ b/stdlib/source/lux/control/codec.lux @@ -24,5 +24,4 @@ (def: (decode cy) (do e.Monad<Error> [by (:: Codec<c,b> decode cy)] - (:: Codec<b,a> decode by))) - ) + (:: Codec<b,a> decode by)))) diff --git a/stdlib/source/lux/control/continuation.lux b/stdlib/source/lux/control/continuation.lux index 35f549ee7..2a145ae5a 100644 --- a/stdlib/source/lux/control/continuation.lux +++ b/stdlib/source/lux/control/continuation.lux @@ -29,9 +29,6 @@ (struct: #export Applicative<Cont> (All [o] (Applicative (All [i] (Cont i o)))) (def: functor Functor<Cont>) - (def: (wrap value) - (function (_ k) (k value))) - (def: (apply ff fv) (function (_ k) (|> (k (f v)) @@ -39,7 +36,10 @@ (function (_ f)) ff)))) (struct: #export Monad<Cont> (All [o] (Monad (All [i] (Cont i o)))) - (def: applicative Applicative<Cont>) + (def: functor Functor<Cont>) + + (def: (wrap value) + (function (_ k) (k value))) (def: (join ffa) (function (_ k) diff --git a/stdlib/source/lux/control/monad.lux b/stdlib/source/lux/control/monad.lux index 2e4045f3a..9a1ceb3b9 100644 --- a/stdlib/source/lux/control/monad.lux +++ b/stdlib/source/lux/control/monad.lux @@ -1,7 +1,6 @@ (.module: lux - (// (functor #as F) - (applicative #as A))) + (// [functor #+ Functor])) ## [Utils] (def: (list/fold f init xs) @@ -43,8 +42,11 @@ ## [Signatures] (sig: #export (Monad m) - (: (A.Applicative m) - applicative) + (: (Functor m) + functor) + (: (All [a] + (-> a (m a))) + wrap) (: (All [a] (-> (m (m a)) (m a))) join)) @@ -64,7 +66,6 @@ (let [g!_ (: Code [_cursor (#.Symbol ["" " _ "])]) g!map (: Code [_cursor (#.Symbol ["" " map "])]) g!join (: Code [_cursor (#.Symbol ["" " join "])]) - g!apply (: Code [_cursor (#.Symbol ["" " apply "])]) body' (list/fold (: (-> [Code Code] Code Code) (function (_ binding body') (let [[var value] binding] @@ -80,10 +81,9 @@ (#.Right [state (#.Cons (` ("lux case" (~ monad) {(~' @) ("lux case" (~' @) - {{#applicative {#A.functor {#F.map (~ g!map)} - #A.wrap (~' wrap) - #A.apply (~ g!apply)} - #join (~ g!join)} + {{#..functor {#functor.map (~ g!map)} + #..wrap (~' wrap) + #..join (~ g!join)} (~ body')})})) #.Nil)])) (#.Left "'do' bindings must have an even number of parts.")) @@ -144,62 +144,3 @@ (do Monad<M> [a ma] (wrap (f a))))) - -## [Free Monads] -(type: #export (Free F a) - {#.doc "The Free Monad."} - (#Pure a) - (#Effect (F (Free F a)))) - -(struct: #export (Functor<Free> dsl) - (All [F] (-> (F.Functor F) (F.Functor (Free F)))) - (def: (map f ea) - (case ea - (#Pure a) - (#Pure (f a)) - - (#Effect value) - (#Effect (:: dsl map (map f) value))))) - -(struct: #export (Applicative<Free> dsl) - (All [F] (-> (F.Functor F) (A.Applicative (Free F)))) - (def: functor (Functor<Free> dsl)) - - (def: (wrap a) - (#Pure a)) - - (def: (apply ef ea) - (case [ef ea] - [(#Pure f) (#Pure a)] - (#Pure (f a)) - - [(#Pure f) (#Effect fa)] - (#Effect (:: dsl map - (:: (Functor<Free> dsl) map f) - fa)) - - [(#Effect ff) _] - (#Effect (:: dsl map - (function (_ f) (apply f ea)) - ff)) - ))) - -(struct: #export (Monad<Free> dsl) - (All [F] (-> (F.Functor F) (Monad (Free F)))) - (def: applicative (Applicative<Free> dsl)) - - (def: (join efefa) - (case efefa - (#Pure efa) - (case efa - (#Pure a) - (#Pure a) - - (#Effect fa) - (#Effect fa)) - - (#Effect fefa) - (#Effect (:: dsl map - (:: (Monad<Free> dsl) join) - fefa)) - ))) diff --git a/stdlib/source/lux/control/monad/free.lux b/stdlib/source/lux/control/monad/free.lux new file mode 100644 index 000000000..7a41b3e9f --- /dev/null +++ b/stdlib/source/lux/control/monad/free.lux @@ -0,0 +1,66 @@ +(.module: + lux + (/// [functor #+ Functor] + [applicative #+ Applicative] + [monad #+ Monad])) + +(type: #export (Free F a) + {#.doc "The Free Monad."} + (#Pure a) + (#Effect (F (Free F a)))) + +(struct: #export (Functor<Free> dsl) + (All [F] (-> (Functor F) (Functor (Free F)))) + + (def: (map f ea) + (case ea + (#Pure a) + (#Pure (f a)) + + (#Effect value) + (#Effect (:: dsl map (map f) value))))) + +(struct: #export (Applicative<Free> dsl) + (All [F] (-> (Functor F) (Applicative (Free F)))) + + (def: functor (Functor<Free> dsl)) + + (def: (apply ef ea) + (case [ef ea] + [(#Pure f) (#Pure a)] + (#Pure (f a)) + + [(#Pure f) (#Effect fa)] + (#Effect (:: dsl map + (:: (Functor<Free> dsl) map f) + fa)) + + [(#Effect ff) _] + (#Effect (:: dsl map + (function (_ f) (apply f ea)) + ff)) + ))) + +(struct: #export (Monad<Free> dsl) + (All [F] (-> (Functor F) (Monad (Free F)))) + + (def: functor (Functor<Free> dsl)) + + (def: (wrap a) + (#Pure a)) + + (def: (join efefa) + (case efefa + (#Pure efa) + (case efa + (#Pure a) + (#Pure a) + + (#Effect fa) + (#Effect fa)) + + (#Effect fefa) + (#Effect (:: dsl map + (:: (Monad<Free> dsl) join) + fefa)) + ))) diff --git a/stdlib/source/lux/control/parser.lux b/stdlib/source/lux/control/parser.lux index c33c17d72..c4aaf35e3 100644 --- a/stdlib/source/lux/control/parser.lux +++ b/stdlib/source/lux/control/parser.lux @@ -26,10 +26,6 @@ (struct: #export Applicative<Parser> (All [s] (Applicative (Parser s))) (def: functor Functor<Parser>) - (def: (wrap x) - (function (_ input) - (#e.Success [input x]))) - (def: (apply ff fa) (function (_ input) (case (ff input) @@ -45,7 +41,11 @@ (#e.Error msg))))) (struct: #export Monad<Parser> (All [s] (Monad (Parser s))) - (def: applicative Applicative<Parser>) + (def: functor Functor<Parser>) + + (def: (wrap x) + (function (_ input) + (#e.Success [input x]))) (def: (join mma) (function (_ input) diff --git a/stdlib/source/lux/control/reader.lux b/stdlib/source/lux/control/reader.lux index ed974ee46..fc2d6540b 100644 --- a/stdlib/source/lux/control/reader.lux +++ b/stdlib/source/lux/control/reader.lux @@ -10,23 +10,29 @@ (-> r a)) ## [Structures] -(struct: #export Functor<Reader> (All [r] (F.Functor (Reader r))) +(struct: #export Functor<Reader> + (All [r] (F.Functor (Reader r))) + (def: (map f fa) (function (_ env) (f (fa env))))) -(struct: #export Applicative<Reader> (All [r] (A.Applicative (Reader r))) +(struct: #export Applicative<Reader> + (All [r] (A.Applicative (Reader r))) + (def: functor Functor<Reader>) - (def: (wrap x) - (function (_ env) x)) - (def: (apply ff fa) (function (_ env) ((ff env) (fa env))))) -(struct: #export Monad<Reader> (All [r] (Monad (Reader r))) - (def: applicative Applicative<Reader>) +(struct: #export Monad<Reader> + (All [r] (Monad (Reader r))) + + (def: functor Functor<Reader>) + + (def: (wrap x) + (function (_ env) x)) (def: (join mma) (function (_ env) @@ -50,7 +56,11 @@ (struct: #export (ReaderT Monad<M>) {#.doc "Monad transformer for Reader."} (All [M] (-> (Monad M) (All [e] (Monad (All [a] (Reader e (M a))))))) - (def: applicative (A.compose Applicative<Reader> (get@ #monad.applicative Monad<M>))) + + (def: functor (F.compose Functor<Reader> (get@ #monad.functor Monad<M>))) + + (def: wrap (|>> (:: Monad<M> wrap) (:: Monad<Reader> wrap))) + (def: (join eMeMa) (function (_ env) (do Monad<M> diff --git a/stdlib/source/lux/control/region.lux b/stdlib/source/lux/control/region.lux index 83afbbdc6..1e2b4a47b 100644 --- a/stdlib/source/lux/control/region.lux +++ b/stdlib/source/lux/control/region.lux @@ -86,12 +86,7 @@ (All [r] (Applicative (Region r m))))) (def: functor - (Functor<Region> (get@ [#monad.applicative #applicative.functor] - Monad<m>))) - - (def: (wrap value) - (function (_ [region cleaners]) - (:: Monad<m> wrap [cleaners (#e.Success value)]))) + (Functor<Region> (get@ #monad.functor Monad<m>))) (def: (apply ff fa) (function (_ [region cleaners]) @@ -111,7 +106,12 @@ (-> (Monad m) (All [r] (Monad (Region r m))))) - (def: applicative (Applicative<Region> Monad<m>)) + (def: functor + (Functor<Region> (get@ #monad.functor Monad<m>))) + + (def: (wrap value) + (function (_ [region cleaners]) + (:: Monad<m> wrap [cleaners (#e.Success value)]))) (def: (join ffa) (function (_ [region cleaners]) diff --git a/stdlib/source/lux/control/state.lux b/stdlib/source/lux/control/state.lux index cf65ae6a7..86813bf69 100644 --- a/stdlib/source/lux/control/state.lux +++ b/stdlib/source/lux/control/state.lux @@ -10,27 +10,33 @@ (-> s [s a])) ## [Structures] -(struct: #export Functor<State> (All [s] (F.Functor (State s))) +(struct: #export Functor<State> + (All [s] (F.Functor (State s))) + (def: (map f ma) (function (_ state) (let [[state' a] (ma state)] [state' (f a)])))) -(struct: #export Applicative<State> (All [s] (A.Applicative (State s))) +(struct: #export Applicative<State> + (All [s] (A.Applicative (State s))) + (def: functor Functor<State>) - (def: (wrap a) - (function (_ state) - [state a])) - (def: (apply ff fa) (function (_ state) (let [[state' f] (ff state) [state'' a] (fa state')] [state'' (f a)])))) -(struct: #export Monad<State> (All [s] (Monad (State s))) - (def: applicative Applicative<State>) +(struct: #export Monad<State> + (All [s] (Monad (State s))) + + (def: functor Functor<State>) + + (def: (wrap a) + (function (_ state) + [state a])) (def: (join mma) (function (_ state) @@ -76,6 +82,7 @@ (struct: (Functor<StateT> Functor<M>) (All [M s] (-> (F.Functor M) (F.Functor (All [a] (-> s (M [s a])))))) + (def: (map f sfa) (function (_ state) (:: Functor<M> map (function (_ [s a]) [s (f a)]) @@ -83,12 +90,9 @@ (struct: (Applicative<StateT> Monad<M>) (All [M s] (-> (Monad M) (A.Applicative (All [a] (-> s (M [s a])))))) + (def: functor (Functor<StateT> (:: Monad<M> functor))) - (def: (wrap a) - (function (_ state) - (:: Monad<M> wrap [state a]))) - (def: (apply sFf sFa) (function (_ state) (do Monad<M> @@ -108,7 +112,13 @@ (struct: #export (StateT Monad<M>) {#.doc "A monad transformer to create composite stateful computations."} (All [M s] (-> (Monad M) (Monad (State' M s)))) - (def: applicative (Applicative<StateT> Monad<M>)) + + (def: functor (Functor<StateT> (:: Monad<M> functor))) + + (def: (wrap a) + (function (_ state) + (:: Monad<M> wrap [state a]))) + (def: (join sMsMa) (function (_ state) (do Monad<M> diff --git a/stdlib/source/lux/control/thread.lux b/stdlib/source/lux/control/thread.lux index 84bc33501..9848ed5bc 100644 --- a/stdlib/source/lux/control/thread.lux +++ b/stdlib/source/lux/control/thread.lux @@ -46,10 +46,6 @@ (def: functor Functor<Thread>) - (def: (wrap value) - (function (_ !) - value)) - (def: (apply ff fa) (function (_ !) ((ff !) (fa !))))) @@ -57,7 +53,11 @@ (struct: #export Monad<Thread> (All [!] (Monad (Thread !))) - (def: applicative Applicative<Thread>) + (def: functor Functor<Thread>) + + (def: (wrap value) + (function (_ !) + value)) (def: (join ffa) (function (_ !) diff --git a/stdlib/source/lux/control/writer.lux b/stdlib/source/lux/control/writer.lux index 7f8299100..5022620c8 100644 --- a/stdlib/source/lux/control/writer.lux +++ b/stdlib/source/lux/control/writer.lux @@ -10,27 +10,33 @@ {#log l #value a}) -(struct: #export Functor<Writer> (All [l] - (F.Functor (Writer l))) +(struct: #export Functor<Writer> + (All [l] + (F.Functor (Writer l))) + (def: (map f fa) (let [[log datum] fa] [log (f datum)]))) -(struct: #export (Applicative<Writer> mon) (All [l] - (-> (Monoid l) (A.Applicative (Writer l)))) +(struct: #export (Applicative<Writer> mon) + (All [l] + (-> (Monoid l) (A.Applicative (Writer l)))) + (def: functor Functor<Writer>) - (def: (wrap x) - [(:: mon identity) x]) - (def: (apply ff fa) (let [[log1 f] ff [log2 a] fa] [(:: mon compose log1 log2) (f a)]))) -(struct: #export (Monad<Writer> mon) (All [l] - (-> (Monoid l) (Monad (Writer l)))) - (def: applicative (Applicative<Writer> mon)) +(struct: #export (Monad<Writer> mon) + (All [l] + (-> (Monoid l) (Monad (Writer l)))) + + (def: functor Functor<Writer>) + + (def: (wrap x) + [(:: mon identity) x]) (def: (join mma) (let [[log1 [log2 a]] mma] @@ -43,7 +49,13 @@ (struct: #export (WriterT Monoid<l> Monad<M>) (All [l M] (-> (Monoid l) (Monad M) (Monad (All [a] (M (Writer l a)))))) - (def: applicative (A.compose (get@ #monad.applicative Monad<M>) (Applicative<Writer> Monoid<l>))) + + (def: functor (F.compose (get@ #monad.functor Monad<M>) Functor<Writer>)) + + (def: wrap + (let [monad (Monad<Writer> Monoid<l>)] + (|>> (:: monad wrap) (:: Monad<M> wrap)))) + (def: (join MlMla) (do Monad<M> [## TODO: Remove once new-luxc is the standard compiler. diff --git a/stdlib/source/lux/data/coll/list.lux b/stdlib/source/lux/data/coll/list.lux index 943743018..e558c592e 100644 --- a/stdlib/source/lux/data/coll/list.lux +++ b/stdlib/source/lux/data/coll/list.lux @@ -271,9 +271,6 @@ (struct: #export _ (Applicative List) (def: functor Functor<List>) - (def: (wrap a) - (#.Cons a #.Nil)) - (def: (apply ff fa) (case ff #.Nil @@ -283,7 +280,10 @@ (compose (map f fa) (apply ff' fa))))) (struct: #export _ (Monad List) - (def: applicative Applicative<List>) + (def: functor Functor<List>) + + (def: (wrap a) + (#.Cons a #.Nil)) (def: join (|>> reverse (fold compose identity)))) @@ -478,10 +478,15 @@ (struct: #export (ListT Monad<M>) (All [M] (-> (Monad M) (Monad (All [a] (M (List a)))))) - (def: applicative (applicative.compose (get@ #monad.applicative Monad<M>) Applicative<List>)) + + (def: functor (functor.compose (get@ #monad.functor Monad<M>) Functor<List>)) + + (def: wrap (|>> (:: Monad<List> wrap) (:: Monad<M> wrap))) + (def: (join MlMla) (do Monad<M> [lMla MlMla + ## TODO: Remove this version ASAP and use one below. lla (: (($ +0) (List (List ($ +1)))) (monad.seq @ lMla)) ## lla (monad.seq @ lMla) diff --git a/stdlib/source/lux/data/coll/sequence.lux b/stdlib/source/lux/data/coll/sequence.lux index b109e460c..0c3156f7f 100644 --- a/stdlib/source/lux/data/coll/sequence.lux +++ b/stdlib/source/lux/data/coll/sequence.lux @@ -204,10 +204,10 @@ ## If so, a brand-new root must be established, that is ## 1-level taller. (|> vec - (set@ #root (|> ## (new-hierarchy []) - ## TODO: Remove once new-luxc becomes the standard compiler. - (: (Hierarchy ($ +0)) + (set@ #root (|> (: (Hierarchy ($ +0)) (new-hierarchy [])) + ## TODO: Remove version above once new-luxc becomes the standard compiler. + ## (new-hierarchy []) (array.write +0 (#Hierarchy (get@ #root vec))) (array.write +1 (new-path (get@ #level vec) (get@ #tail vec))))) (update@ #level level-up)) @@ -413,26 +413,23 @@ (struct: #export _ (Applicative Sequence) (def: functor Functor<Sequence>) - (def: (wrap x) - (sequence x)) - (def: (apply ff fa) (let [(^open) Functor<Sequence> (^open) Fold<Sequence> (^open) Monoid<Sequence> results (map (function (_ f) (map f fa)) ff)] - (fold compose identity results))) - ) + (fold compose identity results)))) (struct: #export _ (Monad Sequence) - (def: applicative Applicative<Sequence>) + (def: functor Functor<Sequence>) + + (def: wrap (|>> sequence)) (def: join (let [(^open) Fold<Sequence> (^open) Monoid<Sequence>] - (fold (function (_ post pre) (compose pre post)) identity))) - ) + (fold (function (_ post pre) (compose pre post)) identity)))) (def: #export (reverse xs) (All [a] (-> (Sequence a) (Sequence a))) diff --git a/stdlib/source/lux/data/error.lux b/stdlib/source/lux/data/error.lux index b619dc1ad..64cb5618e 100644 --- a/stdlib/source/lux/data/error.lux +++ b/stdlib/source/lux/data/error.lux @@ -19,9 +19,6 @@ (struct: #export _ (A.Applicative Error) (def: functor Functor<Error>) - (def: (wrap a) - (#Success a)) - (def: (apply ff fa) (case ff (#Success f) @@ -37,7 +34,10 @@ )) (struct: #export _ (Monad Error) - (def: applicative Applicative<Error>) + (def: functor Functor<Error>) + + (def: (wrap a) + (#Success a)) (def: (join mma) (case mma @@ -46,7 +46,11 @@ (struct: #export (ErrorT Monad<M>) (All [M] (-> (Monad M) (Monad (All [a] (M (Error a)))))) - (def: applicative (A.compose (get@ #M.applicative Monad<M>) Applicative<Error>)) + + (def: functor (F.compose (get@ #M.functor Monad<M>) Functor<Error>)) + + (def: wrap (|>> (:: Monad<Error> wrap) (:: Monad<M> wrap))) + (def: (join MeMea) (do Monad<M> [eMea MeMea] diff --git a/stdlib/source/lux/data/identity.lux b/stdlib/source/lux/data/identity.lux index 919c2385f..51198d11c 100644 --- a/stdlib/source/lux/data/identity.lux +++ b/stdlib/source/lux/data/identity.lux @@ -15,15 +15,12 @@ (struct: #export _ (A.Applicative Identity) (def: functor Functor<Identity>) - - (def: wrap id) - (def: (apply ff fa) (ff fa))) (struct: #export _ (Monad Identity) - (def: applicative Applicative<Identity>) - + (def: functor Functor<Identity>) + (def: wrap id) (def: join id)) (struct: #export _ (CoMonad Identity) diff --git a/stdlib/source/lux/data/lazy.lux b/stdlib/source/lux/data/lazy.lux index 8b4a75d1d..adcc1234e 100644 --- a/stdlib/source/lux/data/lazy.lux +++ b/stdlib/source/lux/data/lazy.lux @@ -39,14 +39,10 @@ (struct: #export _ (Applicative Lazy) (def: functor Functor<Lazy>) - - (def: (wrap a) - (freeze a)) - (def: (apply ff fa) (freeze ((thaw ff) (thaw fa))))) (struct: #export _ (Monad Lazy) - (def: applicative Applicative<Lazy>) - + (def: functor Functor<Lazy>) + (def: wrap (|>> freeze)) (def: join thaw)) diff --git a/stdlib/source/lux/data/maybe.lux b/stdlib/source/lux/data/maybe.lux index 02d109981..e42af460f 100644 --- a/stdlib/source/lux/data/maybe.lux +++ b/stdlib/source/lux/data/maybe.lux @@ -28,9 +28,6 @@ (struct: #export _ (A.Applicative Maybe) (def: functor Functor<Maybe>) - (def: (wrap x) - (#.Some x)) - (def: (apply ff fa) (case [ff fa] [(#.Some f) (#.Some a)] @@ -40,7 +37,10 @@ #.None))) (struct: #export _ (Monad Maybe) - (def: applicative Applicative<Maybe>) + (def: functor Functor<Maybe>) + + (def: (wrap x) + (#.Some x)) (def: (join mma) (case mma @@ -61,7 +61,11 @@ (struct: #export (MaybeT Monad<M>) (All [M] (-> (Monad M) (Monad (All [a] (M (Maybe a)))))) - (def: applicative (A.compose (get@ #monad.applicative Monad<M>) Applicative<Maybe>)) + + (def: functor (F.compose (get@ #monad.functor Monad<M>) Functor<Maybe>)) + + (def: wrap (|>> (:: Monad<Maybe> wrap) (:: Monad<M> wrap))) + (def: (join MmMma) (do Monad<M> [mMma MmMma] diff --git a/stdlib/source/lux/io.lux b/stdlib/source/lux/io.lux index ca9d7b608..6e038aa7c 100644 --- a/stdlib/source/lux/io.lux +++ b/stdlib/source/lux/io.lux @@ -32,14 +32,14 @@ (struct: #export _ (Applicative IO) (def: functor Functor<IO>) - (def: (wrap x) - (io x)) - (def: (apply ff fa) (io ((ff (:! Void [])) (fa (:! Void [])))))) (struct: #export _ (Monad IO) - (def: applicative Applicative<IO>) + (def: functor Functor<IO>) + + (def: (wrap x) + (io x)) (def: (join mma) (io ((mma (:! Void [])) (:! Void []))))) @@ -60,14 +60,14 @@ (struct: #export _ (Applicative Process) (def: functor Functor<Process>) - (def: (wrap x) - (io (:: e.Applicative<Error> wrap x))) - (def: (apply ff fa) (io (:: e.Applicative<Error> apply (run ff) (run fa))))) (struct: #export _ (Monad Process) - (def: applicative Applicative<Process>) + (def: functor Functor<Process>) + + (def: (wrap x) + (io (:: e.Monad<Error> wrap x))) (def: (join mma) (case (run mma) diff --git a/stdlib/source/lux/lang/type/check.lux b/stdlib/source/lux/lang/type/check.lux index 09af682ca..cea574d0c 100644 --- a/stdlib/source/lux/lang/type/check.lux +++ b/stdlib/source/lux/lang/type/check.lux @@ -60,10 +60,6 @@ (struct: #export _ (Applicative Check) (def: functor Functor<Check>) - (def: (wrap x) - (function (_ context) - (#e.Success [context x]))) - (def: (apply ff fa) (function (_ context) (case (ff context) @@ -81,7 +77,11 @@ ) (struct: #export _ (Monad Check) - (def: applicative Applicative<Check>) + (def: functor Functor<Check>) + + (def: (wrap x) + (function (_ context) + (#e.Success [context x]))) (def: (join ffa) (function (_ context) diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index 0e2c60959..4c56e9184 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -29,10 +29,6 @@ (struct: #export _ (Applicative Meta) (def: functor Functor<Meta>) - (def: (wrap x) - (function (_ compiler) - (#e.Success [compiler x]))) - (def: (apply ff fa) (function (_ compiler) (case (ff compiler) @@ -48,7 +44,11 @@ (#e.Error msg))))) (struct: #export _ (Monad Meta) - (def: applicative Applicative<Meta>) + (def: functor Functor<Meta>) + + (def: (wrap x) + (function (_ compiler) + (#e.Success [compiler x]))) (def: (join mma) (function (_ compiler) diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux index 60f9b729d..2b7c6598d 100644 --- a/stdlib/source/lux/math/random.lux +++ b/stdlib/source/lux/math/random.lux @@ -37,10 +37,6 @@ (struct: #export _ (Applicative Random) (def: functor Functor<Random>) - (def: (wrap a) - (function (_ state) - [state a])) - (def: (apply ff fa) (function (_ state) (let [[state' f] (ff state) @@ -48,7 +44,11 @@ [state'' (f a)])))) (struct: #export _ (Monad Random) - (def: applicative Applicative<Random>) + (def: functor Functor<Random>) + + (def: (wrap a) + (function (_ state) + [state a])) (def: (join ffa) (function (_ state) diff --git a/stdlib/test/test/lux/control/continuation.lux b/stdlib/test/test/lux/control/continuation.lux index db274189e..ad50a5515 100644 --- a/stdlib/test/test/lux/control/continuation.lux +++ b/stdlib/test/test/lux/control/continuation.lux @@ -15,7 +15,8 @@ (<| (times +100) (do @ [sample r.nat - #let [(^open "&/") &.Monad<Cont>] + #let [(^open "&/") &.Applicative<Cont> + (^open "&/") &.Monad<Cont>] elems (r.list +3 r.nat)] ($_ seq (test "Can run continuations to compute their values." diff --git a/stdlib/test/test/lux/control/reader.lux b/stdlib/test/test/lux/control/reader.lux index 38b4f2893..4eab1d6f3 100644 --- a/stdlib/test/test/lux/control/reader.lux +++ b/stdlib/test/test/lux/control/reader.lux @@ -10,26 +10,28 @@ lux/test) (context: "Readers" - ($_ seq - (test "" (i/= 123 (&.run 123 &.ask))) - (test "" (i/= 246 (&.run 123 (&.local (i/* 2) &.ask)))) - (test "" (i/= 134 (&.run 123 (:: &.Functor<Reader> map i/inc (i/+ 10))))) - (test "" (i/= 10 (&.run 123 (:: &.Applicative<Reader> wrap 10)))) - (test "" (i/= 30 (&.run 123 (let [(^open "&/") &.Applicative<Reader>] - (&/apply (&/wrap (i/+ 10)) (&/wrap 20)))))) - (test "" (i/= 30 (&.run 123 (do &.Monad<Reader> - [f (wrap i/+) - x (wrap 10) - y (wrap 20)] - (wrap (f x y)))))))) + (let [(^open "&/") &.Applicative<Reader> + (^open "&/") &.Monad<Reader>] + ($_ seq + (test "" (i/= 123 (&.run 123 &.ask))) + (test "" (i/= 246 (&.run 123 (&.local (i/* 2) &.ask)))) + (test "" (i/= 134 (&.run 123 (&/map i/inc (i/+ 10))))) + (test "" (i/= 10 (&.run 123 (&/wrap 10)))) + (test "" (i/= 30 (&.run 123 (&/apply (&/wrap (i/+ 10)) (&/wrap 20))))) + (test "" (i/= 30 (&.run 123 (do &.Monad<Reader> + [f (wrap i/+) + x (wrap 10) + y (wrap 20)] + (wrap (f x y))))))))) (context: "Monad transformer" (let [(^open "io/") io.Monad<IO>] (test "Can add reader functionality to any monad." - (|> (do (&.ReaderT io.Monad<IO>) - [a (&.lift (io/wrap 123)) - b (wrap 456)] - (wrap (i/+ a b))) + (|> (: (&.Reader Text (io.IO Int)) + (do (&.ReaderT io.Monad<IO>) + [a (&.lift (io/wrap 123)) + b (wrap 456)] + (wrap (i/+ a b)))) (&.run "") io.run (case> 579 true diff --git a/stdlib/test/test/lux/control/state.lux b/stdlib/test/test/lux/control/state.lux index 4457952a1..396b390e7 100644 --- a/stdlib/test/test/lux/control/state.lux +++ b/stdlib/test/test/lux/control/state.lux @@ -50,18 +50,20 @@ (<| (times +100) (do @ [state r.nat - value r.nat] + value r.nat + #let [(^open "&/") &.Functor<State> + (^open "&/") &.Applicative<State> + (^open "&/") &.Monad<State>]] ($_ seq (test "Can use functor." (with-conditions [state (n/inc state)] - (:: &.Functor<State> map n/inc &.get))) + (&/map n/inc &.get))) (test "Can use applicative." - (let [(^open "&/") &.Applicative<State>] - (and (with-conditions [state value] - (&/wrap value)) - (with-conditions [state (n/+ value value)] - (&/apply (&/wrap (n/+ value)) - (&/wrap value)))))) + (and (with-conditions [state value] + (&/wrap value)) + (with-conditions [state (n/+ value value)] + (&/apply (&/wrap (n/+ value)) + (&/wrap value))))) (test "Can use monad." (with-conditions [state (n/+ value value)] (: (&.State Nat Nat) diff --git a/stdlib/test/test/lux/control/writer.lux b/stdlib/test/test/lux/control/writer.lux index 42a5f9543..6139db20e 100644 --- a/stdlib/test/test/lux/control/writer.lux +++ b/stdlib/test/test/lux/control/writer.lux @@ -10,7 +10,8 @@ lux/test) (context: "Writer." - (let [(^open "&/") (&.Monad<Writer> text.Monoid<Text>)] + (let [(^open "&/") (&.Monad<Writer> text.Monoid<Text>) + (^open "&/") (&.Applicative<Writer> text.Monoid<Text>)] ($_ seq (test "Functor respects Writer." (i/= 11 (product.right (&/map i/inc ["" 10])))) diff --git a/stdlib/test/test/lux/data/coll/list.lux b/stdlib/test/test/lux/data/coll/list.lux index ebc650df6..f9e6e31b9 100644 --- a/stdlib/test/test/lux/data/coll/list.lux +++ b/stdlib/test/test/lux/data/coll/list.lux @@ -4,7 +4,6 @@ (control [monad #+ do Monad] pipe) (data (coll ["&" list]) - [text "Text/" Monoid<Text>] [number] [bool] [product] @@ -175,7 +174,8 @@ (= other-sample right)))))) (test "Applicative allows you to create singleton lists, and apply lists of functions to lists of values." - (let [(^open) &.Applicative<List>] + (let [(^open) &.Monad<List> + (^open) &.Applicative<List>] (and (= (list separator) (wrap separator)) (= (map n/inc sample) (apply (wrap n/inc) sample))))) diff --git a/stdlib/test/test/lux/data/coll/sequence.lux b/stdlib/test/test/lux/data/coll/sequence.lux index afeca6154..e64377f21 100644 --- a/stdlib/test/test/lux/data/coll/sequence.lux +++ b/stdlib/test/test/lux/data/coll/sequence.lux @@ -18,6 +18,7 @@ other-sample (r.sequence size r.nat) non-member (|> r.nat (r.filter (|>> (&.member? number.Eq<Nat> sample) not))) #let [(^open "&/") (&.Eq<Sequence> number.Eq<Nat>) + (^open "&/") &.Applicative<Sequence> (^open "&/") &.Monad<Sequence> (^open "&/") &.Fold<Sequence> (^open "&/") &.Monoid<Sequence>]] diff --git a/stdlib/test/test/lux/data/error.lux b/stdlib/test/test/lux/data/error.lux index f6c7d7a70..84556fde7 100644 --- a/stdlib/test/test/lux/data/error.lux +++ b/stdlib/test/test/lux/data/error.lux @@ -8,7 +8,8 @@ lux/test) (context: "Errors" - (let [(^open "&/") &.Monad<Error>] + (let [(^open "&/") &.Applicative<Error> + (^open "&/") &.Monad<Error>] ($_ seq (test "Functor correctly handles both cases." (and (|> (: (&.Error Int) (#&.Success 10)) diff --git a/stdlib/test/test/lux/data/identity.lux b/stdlib/test/test/lux/data/identity.lux index 7ab4a6399..9e36efda5 100644 --- a/stdlib/test/test/lux/data/identity.lux +++ b/stdlib/test/test/lux/data/identity.lux @@ -8,7 +8,8 @@ lux/test) (context: "Identity" - (let [(^open "&/") &.Monad<Identity> + (let [(^open "&/") &.Applicative<Identity> + (^open "&/") &.Monad<Identity> (^open "&/") &.CoMonad<Identity>] ($_ seq (test "Functor does not affect values." diff --git a/stdlib/test/test/lux/data/lazy.lux b/stdlib/test/test/lux/data/lazy.lux index 1b8a76730..b683abb0f 100644 --- a/stdlib/test/test/lux/data/lazy.lux +++ b/stdlib/test/test/lux/data/lazy.lux @@ -35,18 +35,6 @@ &.thaw (n/= (n/inc sample)))) - (test "Applicative wrap." - (|> sample - (:: &.Applicative<Lazy> wrap) - &.thaw - (n/= sample))) - - (test "Applicative apply." - (let [(^open "&/") &.Applicative<Lazy>] - (|> (&/apply (&/wrap n/inc) (&/wrap sample)) - &.thaw - (n/= (n/inc sample))))) - (test "Monad." (|> (do &.Monad<Lazy> [f (wrap n/inc) @@ -54,4 +42,11 @@ (wrap (f a))) &.thaw (n/= (n/inc sample)))) + + (test "Applicative apply." + (let [(^open "&/") &.Monad<Lazy> + (^open "&/") &.Applicative<Lazy>] + (|> (&/apply (&/wrap n/inc) (&/wrap sample)) + &.thaw + (n/= (n/inc sample))))) )))) diff --git a/stdlib/test/test/lux/data/maybe.lux b/stdlib/test/test/lux/data/maybe.lux index 4a2c98ab7..ca11da17f 100644 --- a/stdlib/test/test/lux/data/maybe.lux +++ b/stdlib/test/test/lux/data/maybe.lux @@ -4,12 +4,13 @@ (control ["M" monad #+ do Monad] pipe) (data ["&" maybe] - [text "Text/" Monoid<Text>] + [text "text/" Monoid<Text>] [number])) lux/test) (context: "Maybe" (let [(^open "&/") &.Monoid<Maybe> + (^open "&/") &.Applicative<Maybe> (^open "&/") &.Monad<Maybe> (^open "Maybe/") (&.Eq<Maybe> text.Eq<Text>)] ($_ seq @@ -27,18 +28,18 @@ (Maybe/= #.None (: (Maybe Text) (&/compose #.None #.None))))) (test "Functor respects Maybe." - (and (Maybe/= #.None (&/map (Text/compose "yolo") #.None)) - (Maybe/= (#.Some "yololol") (&/map (Text/compose "yolo") (#.Some "lol"))))) + (and (Maybe/= #.None (&/map (text/compose "yolo") #.None)) + (Maybe/= (#.Some "yololol") (&/map (text/compose "yolo") (#.Some "lol"))))) (test "Applicative respects Maybe." (and (Maybe/= (#.Some "yolo") (&/wrap "yolo")) (Maybe/= (#.Some "yololol") - (&/apply (&/wrap (Text/compose "yolo")) (&/wrap "lol"))))) + (&/apply (&/wrap (text/compose "yolo")) (&/wrap "lol"))))) (test "Monad respects Maybe." (Maybe/= (#.Some "yololol") (do &.Monad<Maybe> - [f (wrap Text/compose) + [f (wrap text/compose) a (wrap "yolo") b (wrap "lol")] (wrap (f a b))))) diff --git a/stdlib/test/test/lux/io.lux b/stdlib/test/test/lux/io.lux index 20b3be116..5836e5844 100644 --- a/stdlib/test/test/lux/io.lux +++ b/stdlib/test/test/lux/io.lux @@ -11,8 +11,9 @@ ($_ seq (test "" (Text/= "YOLO" (&.run (&.io "YOLO")))) (test "" (i/= 11 (&.run (:: &.Functor<IO> map i/inc (&.io 10))))) - (test "" (i/= 10 (&.run (:: &.Applicative<IO> wrap 10)))) - (test "" (i/= 30 (&.run (let [(^open "&/") &.Applicative<IO>] + (test "" (i/= 10 (&.run (:: &.Monad<IO> wrap 10)))) + (test "" (i/= 30 (&.run (let [(^open "&/") &.Applicative<IO> + (^open "&/") &.Monad<IO>] (&/apply (&/wrap (i/+ 10)) (&/wrap 20)))))) (test "" (i/= 30 (&.run (do &.Monad<IO> [f (wrap i/+) diff --git a/stdlib/test/test/lux/lang/syntax.lux b/stdlib/test/test/lux/lang/syntax.lux index 4e6bed9bc..9d1f18ae5 100644 --- a/stdlib/test/test/lux/lang/syntax.lux +++ b/stdlib/test/test/lux/lang/syntax.lux @@ -166,7 +166,8 @@ (wrap (format "#( " comment " )#"))))))) (context: "Multi-line text & comments." - (<| (times +100) + (<| (seed +12137892244981970631) + ## (times +100) (do @ [#let [char-gen (|> r.nat (r.filter (function (_ value) (not (or (text.space? value) diff --git a/stdlib/test/test/lux/time/date.lux b/stdlib/test/test/lux/time/date.lux index 8e8c77860..8dba5517a 100644 --- a/stdlib/test/test/lux/time/date.lux +++ b/stdlib/test/test/lux/time/date.lux @@ -126,7 +126,8 @@ (@/<= reference sample))))))) (context: "(Date) Codec" - (<| (times +100) + (<| (seed +6623983470548808292) + ## (times +100) (do @ [sample date #let [(^open "@/") @.Eq<Date> diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index 71317af18..d4a0c0a32 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -27,16 +27,16 @@ ["_." region]) (data ["_." bit] ["_." bool] + ["_." color] ["_." error] ["_." ident] ["_." identity] + ["_." lazy] ["_." maybe] - ["_." number] ["_." product] ["_." sum] ["_." text] - ["_." lazy] - ["_." color] + ["_." number] (number ["_." ratio] ["_." complex]) (format ["_." json] @@ -69,11 +69,11 @@ (poly ["poly_." eq] ["poly_." functor])) (type ["_." implicit] + ["_." resource] (object ["_." interface] - ["_." protocol]) - ["_." resource]) - (lang ["lang/_." syntax] + ["_." protocol])) + (lang ["_lang/." syntax] ["_." type] (type ["_." check])) (world ["_." blob] @@ -82,7 +82,8 @@ ["_." udp])))) (lux (control [contract] [concatenative] - [predicate]) + [predicate] + [monad/free]) (data [env] [trace] [store] @@ -97,8 +98,7 @@ [refinement] [quotient]) [world/env] - [world/console]) - ) + [world/console])) (program: args (test.run)) |