diff options
Diffstat (limited to 'stdlib/source')
-rw-r--r-- | stdlib/source/lux/control/algebra.lux | 16 | ||||
-rw-r--r-- | stdlib/source/lux/control/comonad.lux | 13 | ||||
-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.lux | 3 | ||||
-rw-r--r-- | stdlib/source/lux/control/monad.lux | 6 | ||||
-rw-r--r-- | stdlib/source/lux/data/product.lux | 6 | ||||
-rw-r--r-- | stdlib/source/lux/data/sum.lux | 12 |
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) |