aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/library/lux/abstract/monad/free.lux22
-rw-r--r--stdlib/source/library/lux/control/function/trampoline.lux57
-rw-r--r--stdlib/source/test/lux/abstract/monad/free.lux2
-rw-r--r--stdlib/source/test/lux/control/function.lux4
-rw-r--r--stdlib/source/test/lux/control/function/trampoline.lux50
-rw-r--r--stdlib/source/test/lux/meta/macro.lux4
-rw-r--r--stdlib/source/test/lux/meta/macro/vocabulary.lux61
7 files changed, 186 insertions, 14 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)))
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 [<expected> (n.+ left right)]
+ (|> (/.jump (/.return <expected>))
+ /.result
+ (n.= <expected>))))
+ )))
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 (_ <pattern> <value>)
@@ -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)))))))
+ )))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 00:29:51 +0000