From dc78af618f175ffc5e6a653256ca6b27a260fe83 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 23 Aug 2022 13:05:35 -0400 Subject: Added function trampolines. --- stdlib/source/library/lux/abstract/monad/free.lux | 22 ++++---- .../library/lux/control/function/trampoline.lux | 57 ++++++++++++++++++++ stdlib/source/test/lux/abstract/monad/free.lux | 2 +- stdlib/source/test/lux/control/function.lux | 4 +- .../test/lux/control/function/trampoline.lux | 50 ++++++++++++++++++ stdlib/source/test/lux/meta/macro.lux | 4 +- stdlib/source/test/lux/meta/macro/vocabulary.lux | 61 ++++++++++++++++++++++ 7 files changed, 186 insertions(+), 14 deletions(-) create mode 100644 stdlib/source/library/lux/control/function/trampoline.lux create mode 100644 stdlib/source/test/lux/control/function/trampoline.lux create mode 100644 stdlib/source/test/lux/meta/macro/vocabulary.lux (limited to 'stdlib') 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))) diff --git a/stdlib/source/test/lux/abstract/monad/free.lux b/stdlib/source/test/lux/abstract/monad/free.lux index eb67429b2..46fd74651 100644 --- a/stdlib/source/test/lux/abstract/monad/free.lux +++ b/stdlib/source/test/lux/abstract/monad/free.lux @@ -29,7 +29,7 @@ {/.#Pure value} (list value) - {/.#Effect effect} + {/.#Impure effect} (|> effect (list#each interpret) list.together))) diff --git a/stdlib/source/test/lux/control/function.lux b/stdlib/source/test/lux/control/function.lux index a2ac4a355..aad5f2ebf 100644 --- a/stdlib/source/test/lux/control/function.lux +++ b/stdlib/source/test/lux/control/function.lux @@ -22,7 +22,8 @@ ["[1][0]" inline] ["[1][0]" predicate] ["[1][0]" variadic] - ["[1][0]" named]]) + ["[1][0]" named] + ["[1][0]" trampoline]]) (def .public test Test @@ -71,4 +72,5 @@ /predicate.test /variadic.test /named.test + /trampoline.test )))) diff --git a/stdlib/source/test/lux/control/function/trampoline.lux b/stdlib/source/test/lux/control/function/trampoline.lux new file mode 100644 index 000000000..18d29110c --- /dev/null +++ b/stdlib/source/test/lux/control/function/trampoline.lux @@ -0,0 +1,50 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)] + [\\specification + ["$[0]" functor (.only Injection Comparison)] + ["$[0]" monad]]] + [math + ["[0]" random] + [number + ["n" nat]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" /]]) + +(def injection + (Injection /.Trampoline) + (|>> /.return)) + +(def comparison + (Comparison /.Trampoline) + (function (_ == left right) + (== (/.result left) (/.result right)))) + +(def .public test + Test + (<| (_.covering /._) + (_.for [/.Trampoline]) + (do [! random.monad] + [expected random.nat + left random.nat + right random.nat]) + (all _.and + (_.for [/.functor] + ($functor.spec ..injection ..comparison /.functor)) + (_.for [/.monad] + ($monad.spec ..injection ..comparison /.monad)) + + (_.coverage [/.return /.result] + (|> (/.return expected) + /.result + (same? expected))) + (_.coverage [/.jump] + (with_expansions [ (n.+ left right)] + (|> (/.jump (/.return )) + /.result + (n.= )))) + ))) diff --git a/stdlib/source/test/lux/meta/macro.lux b/stdlib/source/test/lux/meta/macro.lux index d3bc360d4..797c7fac6 100644 --- a/stdlib/source/test/lux/meta/macro.lux +++ b/stdlib/source/test/lux/meta/macro.lux @@ -35,7 +35,8 @@ ["[1][0]" local] ["[1][0]" syntax] ["[1][0]" template] - ["[1][0]" pattern]]) + ["[1][0]" pattern] + ["[1][0]" vocabulary]]) (def !expect (template (_ ) @@ -256,4 +257,5 @@ /syntax.test /template.test /pattern.test + /vocabulary.test ))) diff --git a/stdlib/source/test/lux/meta/macro/vocabulary.lux b/stdlib/source/test/lux/meta/macro/vocabulary.lux new file mode 100644 index 000000000..1a04215b3 --- /dev/null +++ b/stdlib/source/test/lux/meta/macro/vocabulary.lux @@ -0,0 +1,61 @@ +(.require + [library + [lux (.except macro) + [abstract + [monad (.only do)]] + [control + ["[0]" try] + ["[0]" exception]] + [data + ["[0]" text]] + [math + [number + ["n" nat]]] + ["[0]" meta (.only) + ["[0]" static] + ["[0]" code]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" /]]) + +(/.vocabulary + [.private Micro] + [.private micro] + [.private macro] + [.private by_name]) + +(def .public pass_through + (.macro (_ inputs lux) + {.#Right [lux inputs]})) + +(def .public pass_through' + (..micro pass_through)) + +(def .public test + Test + (<| (_.covering /._) + (all _.and + (_.coverage [/.vocabulary] + (exec + (|> pass_through + (is Macro) + ..micro + (is ..Micro) + ..macro + (is Macro)) + (<| static.expansion + (do meta.monad + [_ (by_name (symbol ..pass_through'))] + (in (list (code.bit true))))))) + (_.coverage [/.invalid_type] + (<| static.expansion + (do meta.monad + [? (meta.try (by_name (symbol ..pass_through)))] + (in (list (code.bit (when ? + {try.#Failure it} + (text.contains? (the exception.#label /.invalid_type) it) + + {try.#Success _} + false))))))) + ))) -- cgit v1.2.3