aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
authorEduardo Julian2018-05-02 00:09:35 -0400
committerEduardo Julian2018-05-02 00:09:35 -0400
commite4e67f0427d93b3686366ffe9f14a4751690101e (patch)
tree22857a6ea96f97925bacc5ea2ddf71ab55207569 /stdlib/source
parent9906f649d26adfed5126065082fb4a7d5e4696bb (diff)
- Moved the "wrap" function into Monad, and removed Applicative from Monad's family tree.
- Moved the Free monad to its own module.
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux/concurrency/frp.lux12
-rw-r--r--stdlib/source/lux/concurrency/promise.lux11
-rw-r--r--stdlib/source/lux/concurrency/stm.lux8
-rw-r--r--stdlib/source/lux/concurrency/task.lux12
-rw-r--r--stdlib/source/lux/control/applicative.lux18
-rw-r--r--stdlib/source/lux/control/codec.lux3
-rw-r--r--stdlib/source/lux/control/continuation.lux8
-rw-r--r--stdlib/source/lux/control/monad.lux77
-rw-r--r--stdlib/source/lux/control/monad/free.lux66
-rw-r--r--stdlib/source/lux/control/parser.lux10
-rw-r--r--stdlib/source/lux/control/reader.lux26
-rw-r--r--stdlib/source/lux/control/region.lux14
-rw-r--r--stdlib/source/lux/control/state.lux36
-rw-r--r--stdlib/source/lux/control/thread.lux10
-rw-r--r--stdlib/source/lux/control/writer.lux34
-rw-r--r--stdlib/source/lux/data/coll/list.lux15
-rw-r--r--stdlib/source/lux/data/coll/sequence.lux19
-rw-r--r--stdlib/source/lux/data/error.lux14
-rw-r--r--stdlib/source/lux/data/identity.lux7
-rw-r--r--stdlib/source/lux/data/lazy.lux8
-rw-r--r--stdlib/source/lux/data/maybe.lux14
-rw-r--r--stdlib/source/lux/io.lux16
-rw-r--r--stdlib/source/lux/lang/type/check.lux10
-rw-r--r--stdlib/source/lux/macro.lux10
-rw-r--r--stdlib/source/lux/math/random.lux10
25 files changed, 253 insertions, 215 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)