aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/control/algebra.lux16
-rw-r--r--stdlib/source/lux/control/comonad.lux13
-rw-r--r--stdlib/source/lux/control/effect.lux (renamed from stdlib/source/lux/effect.lux)91
-rw-r--r--stdlib/source/lux/control/functor.lux3
-rw-r--r--stdlib/source/lux/control/monad.lux6
-rw-r--r--stdlib/source/lux/data/product.lux6
-rw-r--r--stdlib/source/lux/data/sum.lux12
7 files changed, 90 insertions, 57 deletions
diff --git a/stdlib/source/lux/control/algebra.lux b/stdlib/source/lux/control/algebra.lux
new file mode 100644
index 000000000..e743f4497
--- /dev/null
+++ b/stdlib/source/lux/control/algebra.lux
@@ -0,0 +1,16 @@
+(;module:
+ lux
+ (lux (control functor)))
+
+## Types
+(type: #export (Algebra f a)
+ (-> (f a) a))
+
+(type: #export (CoAlgebra f a)
+ (-> a (f a)))
+
+(type: #export (RAlgebra f a)
+ (-> (f (& (Fix f) a)) a))
+
+(type: #export (RCoAlgebra f a)
+ (-> a (f (| (Fix f) a))))
diff --git a/stdlib/source/lux/control/comonad.lux b/stdlib/source/lux/control/comonad.lux
index 5ed443040..428bb484f 100644
--- a/stdlib/source/lux/control/comonad.lux
+++ b/stdlib/source/lux/control/comonad.lux
@@ -17,6 +17,11 @@
(-> (w a) (w (w a))))
split))
+## [Types]
+(type: #export (CoFree F a)
+ {#;doc "The CoFree CoMonad."}
+ [a (F (CoFree F a))])
+
## [Syntax]
(def: _cursor Cursor ["" +0 +0])
@@ -43,10 +48,10 @@
body
(reverse (as-pairs bindings)))]
(#;Right [state (#;Cons (` (;_lux_case (~ comonad)
- (~' @)
- (;_lux_case (~' @)
- {#functor {#F;map (~ g!map)} #unwrap (~' unwrap) #split (~ g!split)}
- (~ body'))))
+ (~' @)
+ (;_lux_case (~' @)
+ {#functor {#F;map (~ g!map)} #unwrap (~' unwrap) #split (~ g!split)}
+ (~ body'))))
#;Nil)]))
_
diff --git a/stdlib/source/lux/effect.lux b/stdlib/source/lux/control/effect.lux
index 2540effb8..d0e2e0576 100644
--- a/stdlib/source/lux/effect.lux
+++ b/stdlib/source/lux/control/effect.lux
@@ -2,7 +2,7 @@
lux
(lux (control ["F" functor]
applicative
- monad)
+ ["M" monad #*])
[io #- run]
(data (coll [list "List/" Monad<List> Monoid<List>])
[number "Nat/" Codec<Text,Nat>]
@@ -18,11 +18,6 @@
[type]))
## [Type]
-(type: #export (Eff F a)
- {#;doc "A Free Monad implementation for algebraic effects."}
- (#Pure a)
- (#Effect (F (Eff F a))))
-
(sig: #export (Handler E M)
{#;doc "A way to interpret effects into arbitrary monads."}
(: (Monad M)
@@ -31,57 +26,57 @@
handle))
## [Values]
-(struct: #export (Functor<Eff> dsl)
- (All [F] (-> (F;Functor F) (F;Functor (Eff F))))
+(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))
+ (#M;Pure a)
+ (#M;Pure (f a))
- (#Effect value)
- (#Effect (:: dsl map (map f) value)))))
+ (#M;Effect value)
+ (#M;Effect (:: dsl map (map f) value)))))
-(struct: #export (Applicative<Eff> dsl)
- (All [F] (-> (F;Functor F) (Applicative (Eff F))))
- (def: functor (Functor<Eff> dsl))
+(struct: #export (Applicative<Free> dsl)
+ (All [F] (-> (F;Functor F) (Applicative (Free F))))
+ (def: functor (Functor<Free> dsl))
(def: (wrap a)
- (#Pure a))
+ (#M;Pure a))
(def: (apply ef ea)
(case [ef ea]
- [(#Pure f) (#Pure a)]
- (#Pure (f a))
-
- [(#Pure f) (#Effect fa)]
- (#Effect (:: dsl map
- (:: (Functor<Eff> dsl) map f)
- fa))
-
- [(#Effect ff) _]
- (#Effect (:: dsl map
- (lambda [f] (apply f ea))
- ff))
+ [(#M;Pure f) (#M;Pure a)]
+ (#M;Pure (f a))
+
+ [(#M;Pure f) (#M;Effect fa)]
+ (#M;Effect (:: dsl map
+ (:: (Functor<Free> dsl) map f)
+ fa))
+
+ [(#M;Effect ff) _]
+ (#M;Effect (:: dsl map
+ (lambda [f] (apply f ea))
+ ff))
)))
-(struct: #export (Monad<Eff> dsl)
- (All [F] (-> (F;Functor F) (Monad (Eff F))))
- (def: applicative (Applicative<Eff> dsl))
+(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)
+ (#M;Pure efa)
(case efa
- (#Pure a)
- (#Pure a)
+ (#M;Pure a)
+ (#M;Pure a)
- (#Effect fa)
- (#Effect fa))
+ (#M;Effect fa)
+ (#M;Effect fa))
- (#Effect fefa)
- (#Effect (:: dsl map
- (:: (Monad<Eff> dsl) join)
- fefa))
+ (#M;Effect fefa)
+ (#M;Effect (:: dsl map
+ (:: (Monad<Free> dsl) join)
+ fefa))
)))
(type: #hidden (|@ L R)
@@ -272,12 +267,12 @@
(def: #export (with-handler handler body)
{#;doc "Handles an effectful computation with the given handler to produce a monadic value."}
- (All [E M a] (-> (Handler E M) (Eff E a) (M a)))
+ (All [E M a] (-> (Handler E M) (Free E a) (M a)))
(case body
- (#Pure value)
+ (#M;Pure value)
(:: handler wrap value)
- (#Effect effect)
+ (#M;Effect effect)
(do (get@ #monad handler)
[result (:: handler handle effect)]
(with-handler handler result))
@@ -314,10 +309,10 @@
(do @
[g!output (compiler;gensym "")]
(wrap (list (` (let [(~ g!functor) (~ functor)]
- (do (Monad<Eff> (~ g!functor))
+ (do (Monad<Free> (~ g!functor))
[(~@ bindings)
(~ g!output) (~ body)]
- (#;;Pure (~ g!output)))))))))
+ (#M;Pure (~ g!output)))))))))
(def: (flatten-effect-stack stack)
(-> Type (List Type))
@@ -334,7 +329,7 @@
right))
(#;Cons left (flatten-effect-stack right))
- (^ (#;AppT (#;AppT (#;NamedT (ident-for ;;Eff) _)
+ (^ (#;AppT (#;AppT (#;NamedT (ident-for M;Free) _)
effect)
param))
(list effect)
@@ -380,7 +375,7 @@
(case [input output]
(^=> [(#;AppT eff0 _) (#;AppT stackT0 recT0)]
[(type;apply-type stackT0 recT0) (#;Some unfoldT0)]
- [stackT0 (^ (#;AppT (#;NamedT (ident-for ;;Eff) _)
+ [stackT0 (^ (#;AppT (#;NamedT (ident-for M;Free) _)
stackT1))]
[(type;apply-type stackT1 recT0) (#;Some unfoldT1)]
[(flatten-effect-stack unfoldT1) stack]
@@ -388,7 +383,7 @@
(list;find (lambda [[idx effect]]
(same-effect? effect eff0))))
(#;Some [idx _])])
- (wrap (list (` (#;;Effect (:: (~ g!functor) (~' map) (~' wrap)
+ (wrap (list (` (#M;Effect (:: (~ g!functor) (~' map) (~' wrap)
(~ (nest-effect idx (list;size stack) (ast;symbol var))))))))
_
diff --git a/stdlib/source/lux/control/functor.lux b/stdlib/source/lux/control/functor.lux
index 005050efd..3532e0633 100644
--- a/stdlib/source/lux/control/functor.lux
+++ b/stdlib/source/lux/control/functor.lux
@@ -5,6 +5,9 @@
(-> (-> a b) (f a) (f b)))
map))
+(type: #export (Fix f)
+ (f (Fix f)))
+
(struct: #export (compF Functor<F> Functor<G>)
{#;doc "Functor composition."}
(All [F G] (-> (Functor F) (Functor G) (Functor (All [a] (F (G a))))))
diff --git a/stdlib/source/lux/control/monad.lux b/stdlib/source/lux/control/monad.lux
index a6d0d5988..0563857f4 100644
--- a/stdlib/source/lux/control/monad.lux
+++ b/stdlib/source/lux/control/monad.lux
@@ -48,6 +48,12 @@
(-> (m (m a)) (m a)))
join))
+## [Types]
+(type: #export (Free F a)
+ {#;doc "The Free Monad."}
+ (#Pure a)
+ (#Effect (F (Free F a))))
+
## [Syntax]
(def: _cursor Cursor ["" +0 +0])
diff --git a/stdlib/source/lux/data/product.lux b/stdlib/source/lux/data/product.lux
index 8e8be3cd3..2a25e53a0 100644
--- a/stdlib/source/lux/data/product.lux
+++ b/stdlib/source/lux/data/product.lux
@@ -29,3 +29,9 @@
(All [a b] (-> [a b] [b a]))
(let [[x y] xy]
[y x]))
+
+(def: #export (both f g)
+ (All [a b c] (-> (-> a b) (-> a c)
+ (-> a [b c])))
+ (lambda [input]
+ [(f input) (g input)]))
diff --git a/stdlib/source/lux/data/sum.lux b/stdlib/source/lux/data/sum.lux
index 716b3908a..ade411e6b 100644
--- a/stdlib/source/lux/data/sum.lux
+++ b/stdlib/source/lux/data/sum.lux
@@ -10,11 +10,13 @@
[left a +0]
[right b +1])
-(def: #export (either f g s)
- (All [a b c] (-> (-> a c) (-> b c) (| a b) c))
- (case s
- (+0 x) (f x)
- (+1 x) (g x)))
+(def: #export (either f g)
+ (All [a b c] (-> (-> a c) (-> b c)
+ (-> (| a b) c)))
+ (lambda [input]
+ (case input
+ (+0 l) (f l)
+ (+1 r) (g r))))
(do-template [<name> <side> <tag>]
[(def: #export (<name> es)
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-27 08:47:11 +0000