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/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 ++++++++++++++++++++++
 5 files changed, 118 insertions(+), 3 deletions(-)
 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/source/test')

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)))))))
+           )))
-- 
cgit v1.2.3