diff options
author | Eduardo Julian | 2017-04-10 23:31:07 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-04-10 23:31:07 -0400 |
commit | d5ecf2657e9e9c6fb8d0daee675e1a72627d3014 (patch) | |
tree | 8f3d51b0e91509e75ed223b9685431903328e7f2 /stdlib | |
parent | a1b2a8120921ccca79e95b8bd35b475b34dd9780 (diff) |
- Move the structures for the Free monad into lux/control/monad.
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/lux/control/effect.lux | 53 | ||||
-rw-r--r-- | stdlib/source/lux/control/monad.lux | 65 |
2 files changed, 59 insertions, 59 deletions
diff --git a/stdlib/source/lux/control/effect.lux b/stdlib/source/lux/control/effect.lux index 1f0046fce..6c432c47b 100644 --- a/stdlib/source/lux/control/effect.lux +++ b/stdlib/source/lux/control/effect.lux @@ -26,59 +26,6 @@ handle)) ## [Values] -(struct: #export (Functor<Free> dsl) - (All [F] (-> (F;Functor F) (F;Functor (Free F)))) - (def: (map f ea) - (case ea - (#M;Pure a) - (#M;Pure (f a)) - - (#M;Effect value) - (#M;Effect (:: dsl map (map f) value))))) - -(struct: #export (Applicative<Free> dsl) - (All [F] (-> (F;Functor F) (Applicative (Free F)))) - (def: functor (Functor<Free> dsl)) - - (def: (wrap a) - (#M;Pure a)) - - (def: (apply ef ea) - (case [ef ea] - [(#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 - (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 - (#M;Pure efa) - (case efa - (#M;Pure a) - (#M;Pure a) - - (#M;Effect fa) - (#M;Effect fa)) - - (#M;Effect fefa) - (#M;Effect (:: dsl map - (:: (Monad<Free> dsl) join) - fefa)) - ))) - (type: #hidden (|@ L R) (All [a] (| (L a) (R a)))) diff --git a/stdlib/source/lux/control/monad.lux b/stdlib/source/lux/control/monad.lux index bfbe55c77..22be3fcd5 100644 --- a/stdlib/source/lux/control/monad.lux +++ b/stdlib/source/lux/control/monad.lux @@ -48,12 +48,6 @@ (-> (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]) @@ -146,3 +140,62 @@ (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)) + ))) |