diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/library/lux/abstract/monad/free.lux | 22 | ||||
| -rw-r--r-- | stdlib/source/library/lux/control/function/trampoline.lux | 57 |
2 files changed, 68 insertions, 11 deletions
diff --git a/stdlib/source/library/lux/abstract/monad/free.lux b/stdlib/source/library/lux/abstract/monad/free.lux index f0d5aabf8..081343130 100644 --- a/stdlib/source/library/lux/abstract/monad/free.lux +++ b/stdlib/source/library/lux/abstract/monad/free.lux @@ -9,7 +9,7 @@ (type .public (Free F a) (Variant {#Pure a} - {#Effect (F (Free F a))})) + {#Impure (F (Free F a))})) (def .public (functor dsl) (All (_ F) (-> (Functor F) (Functor (Free F)))) @@ -19,8 +19,8 @@ {#Pure a} {#Pure (f a)} - {#Effect value} - {#Effect (at dsl each (each f) value)})))) + {#Impure value} + {#Impure (at dsl each (each f) value)})))) (def .public (apply dsl) (All (_ F) (-> (Functor F) (Apply (Free F)))) @@ -33,13 +33,13 @@ [{#Pure f} {#Pure a}] {#Pure (f a)} - [{#Pure f} {#Effect fa}] - {#Effect (at dsl each + [{#Pure f} {#Impure fa}] + {#Impure (at dsl each (at (..functor dsl) each f) fa)} - [{#Effect ff} _] - {#Effect (at dsl each (on ea) ff)} + [{#Impure ff} _] + {#Impure (at dsl each (on ea) ff)} )))) (def .public (monad dsl) @@ -57,11 +57,11 @@ {#Pure a} {#Pure a} - {#Effect fa} - {#Effect fa}) + {#Impure fa} + {#Impure fa}) - {#Effect fefa} - {#Effect (at dsl each + {#Impure fefa} + {#Impure (at dsl each (at (monad dsl) conjoint) fefa)} )))) diff --git a/stdlib/source/library/lux/control/function/trampoline.lux b/stdlib/source/library/lux/control/function/trampoline.lux new file mode 100644 index 000000000..d12bc5a79 --- /dev/null +++ b/stdlib/source/library/lux/control/function/trampoline.lux @@ -0,0 +1,57 @@ +(.require + [library + [lux (.except) + [abstract + [functor (.only Functor)] + [monad (.only Monad)]] + [meta + ["[0]" code + ["?[1]" \\parser]] + [macro (.only with_symbols) + [syntax (.only syntax)]]]]]) + +(type .public (Trampoline a) + (Variant + {#Return a} + {#Jump (-> Any (Trampoline a))})) + +(def .public return + (All (_ value) + (-> value + (Trampoline value))) + (|>> {#Return})) + +(def .public jump + (syntax (_ [thunk ?code.any]) + (with_symbols [g!_] + (in (list (` {#Jump (function ((, g!_) (, g!_)) + (, thunk))})))))) + +(def .public (result it) + (All (_ value) + (-> (Trampoline value) + value)) + (when it + {#Return it} + it + + {#Jump next} + (result (next [])))) + +(def .public functor + (Functor Trampoline) + (implementation + (def (each $ it) + (when it + {#Return it} + {#Return ($ it)} + + {#Jump next} + (each $ (next [])))))) + +(def .public monad + (Monad Trampoline) + (implementation + (def functor ..functor) + (def in ..return) + (def conjoint ..result))) |