Added function trampolines.

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)))))))
+           )))