From d5ecf2657e9e9c6fb8d0daee675e1a72627d3014 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 10 Apr 2017 23:31:07 -0400 Subject: - Move the structures for the Free monad into lux/control/monad. --- stdlib/source/lux/control/effect.lux | 53 ----------------------------- 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 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 dsl) - (All [F] (-> (F;Functor F) (Applicative (Free F)))) - (def: functor (Functor 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 dsl) map f) - fa)) - - [(#M;Effect ff) _] - (#M;Effect (:: dsl map - (function [f] (apply f ea)) - ff)) - ))) - -(struct: #export (Monad dsl) - (All [F] (-> (F;Functor F) (Monad (Free F)))) - (def: applicative (Applicative 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 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 [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 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 dsl) + (All [F] (-> (F;Functor F) (A;Applicative (Free F)))) + (def: functor (Functor 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 dsl) map f) + fa)) + + [(#Effect ff) _] + (#Effect (:: dsl map + (function [f] (apply f ea)) + ff)) + ))) + +(struct: #export (Monad dsl) + (All [F] (-> (F;Functor F) (Monad (Free F)))) + (def: applicative (Applicative dsl)) + + (def: (join efefa) + (case efefa + (#Pure efa) + (case efa + (#Pure a) + (#Pure a) + + (#Effect fa) + (#Effect fa)) + + (#Effect fefa) + (#Effect (:: dsl map + (:: (Monad dsl) join) + fefa)) + ))) -- cgit v1.2.3