Moved function machinery over.

2 files changed, 136 insertions, 21 deletions

diff --git a/stdlib/source/lux/tool/compiler/phase/translation/js/function.lux b/stdlib/source/lux/tool/compiler/phase/translation/js/function.lux
new file mode 100644
index 000000000..741e66573
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/translation/js/function.lux
@@ -0,0 +1,109 @@
+(.module:
+  [lux (#- function)
+   [control
+    ["." monad (#+ do)]
+    pipe]
+   [data
+    ["." product]
+    [text
+     format]
+    [collection
+     ["." list ("#/." functor fold)]]]
+   [host
+    ["_" js (#+ Expression Computation Var)]]]
+  [//
+   ["." runtime (#+ Operation Phase)]
+   ["." reference]
+   ["//." case]
+   ["/." //
+    [common
+     ["common-." reference]]
+    ["//." // ("#/." monad)
+     [analysis (#+ Variant Tuple Environment Arity Abstraction Application Analysis)]
+     [synthesis (#+ Synthesis)]
+     [//
+      [reference (#+ Register Variable)]
+      ["." name]]]]])
+
+(def: #export (apply translate [functionS argsS+])
+  (-> Phase (Application Synthesis) (Operation Computation))
+  (do ////.monad
+    [functionO (translate functionS)
+     argsO+ (monad.map @ translate argsS+)]
+    (wrap (_.apply/* functionO argsO+))))
+
+(def: #export capture
+  (common-reference.foreign _.var))
+
+(def: (with-closure inits function-definition)
+  (-> (List Expression) Computation (Operation Computation))
+  (/////wrap
+   (case inits
+     #.Nil
+     function-definition
+
+     _
+     (let [closure (_.closure (|> (list.enumerate inits)
+                                  (list/map (|>> product.left ..capture)))
+                              (_.return function-definition))]
+       (_.apply/* closure inits)))))
+
+(def: @curried (_.var "curried"))
+
+(def: input
+  (|>> inc //case.register))
+
+(def: @@arguments (_.var "arguments"))
+
+(def: #export (function translate [environment arity bodyS])
+  (-> Phase (Abstraction Synthesis) (Operation Computation))
+  (do ////.monad
+    [[function-name bodyO] (///.with-context
+                             (do @
+                               [function-name ///.context]
+                               (///.with-anchor (_.var function-name)
+                                 (translate bodyS))))
+     closureO+ (: (Operation (List Expression))
+                  (monad.map @ (:: reference.system variable) environment))
+     #let [arityO (|> arity .int _.i32)
+           @num-args (_.var "num_args")
+           @self (_.var function-name)
+           apply-poly (.function (_ args func)
+                        (|> func (_.do "apply" (list _.null args))))
+           initialize-self! (_.define (//case.register 0) @self)
+           initialize! (list/fold (.function (_ post pre!)
+                                    ($_ _.then
+                                        pre!
+                                        (_.define (..input post) (_.at (_.i32 (.int post)) @@arguments))))
+                                  initialize-self!
+                                  (list.indices arity))]]
+    (with-closure closureO+
+      (_.function @self (list)
+        ($_ _.then
+            (_.define @num-args (_.the "length" @@arguments))
+            (_.cond (list [(|> @num-args (_.= arityO))
+                           ($_ _.then
+                               initialize!
+                               (_.return bodyO))]
+                          [(|> @num-args (_.> arityO))
+                           (let [arity-inputs (|> (_.array (list))
+                                                  (_.the "slice")
+                                                  (_.do "call" (list @@arguments (_.i32 +0) arityO)))
+                                 extra-inputs (|> (_.array (list))
+                                                  (_.the "slice")
+                                                  (_.do "call" (list @@arguments arityO)))]
+                             (_.return (|> @self
+                                           (apply-poly arity-inputs)
+                                           (apply-poly extra-inputs))))])
+                    ## (|> @num-args (_.< arityO))
+                    (let [all-inputs (|> (_.array (list))
+                                         (_.the "slice")
+                                         (_.do "call" (list @@arguments)))]
+                      ($_ _.then
+                          (_.define @curried all-inputs)
+                          (_.return (_.closure (list)
+                                               (let [@missing all-inputs]
+                                                 (_.return (apply-poly (_.do ".concat" (list @missing) @curried)
+                                                                       @self))))))))
+            )))
+    ))
diff --git a/stdlib/source/lux/tool/compiler/phase/translation/scheme/function.jvm.lux b/stdlib/source/lux/tool/compiler/phase/translation/scheme/function.jvm.lux
index fe08b6a50..cc2caf056 100644
--- a/stdlib/source/lux/tool/compiler/phase/translation/scheme/function.jvm.lux
+++ b/stdlib/source/lux/tool/compiler/phase/translation/scheme/function.jvm.lux
@@ -8,20 +8,22 @@
     [text
      format]
     [collection
-     ["." list ("#/." functor)]]]]
+     ["." list ("#/." functor)]]]
+   [host
+    ["_" scheme (#+ Expression Computation Var)]]]
   [//
    ["." runtime (#+ Operation Phase)]
    ["." reference]
+   ["//." case]
    ["/." //
+    [common
+     ["common-." reference]]
     ["//." // ("#/." monad)
      [analysis (#+ Variant Tuple Environment Arity Abstraction Application Analysis)]
      [synthesis (#+ Synthesis)]
      [//
       [reference (#+ Register Variable)]
-      ["." name]
-      [//
-       [host
-        ["_" scheme (#+ Expression Computation Var)]]]]]]])
+      ["." name]]]]])
 
 (def: #export (apply translate [functionS argsS+])
   (-> Phase (Application Synthesis) (Operation Computation))
@@ -30,18 +32,21 @@
      argsO+ (monad.map @ translate argsS+)]
     (wrap (_.apply/* functionO argsO+))))
 
+(def: #export capture
+  (common-reference.foreign _.var))
+
 (def: (with-closure function-name inits function-definition)
   (-> Text (List Expression) Computation (Operation Computation))
-  (let [@closure (_.var (format function-name "___CLOSURE"))]
-    (/////wrap
-     (case inits
-       #.Nil
-       function-definition
+  (/////wrap
+   (case inits
+     #.Nil
+     function-definition
 
-       _
+     _
+     (let [@closure (_.var (format function-name "___CLOSURE"))]
        (_.letrec (list [@closure
                         (_.lambda [(|> (list.enumerate inits)
-                                  (list/map (|>> product.left reference.foreign')))
+                                  (list/map (|>> product.left ..capture)))
                               #.None]
                              function-definition)])
                  (_.apply/* @closure inits))))))
@@ -50,7 +55,7 @@
 (def: @missing (_.var "missing"))
 
 (def: input
-  (|>> inc reference.local'))
+  (|>> inc //case.register))
 
 (def: #export (function translate [environment arity bodyS])
   (-> Phase (Abstraction Synthesis) (Operation Computation))
@@ -60,17 +65,18 @@
                                [function-name ///.context]
                                (///.with-anchor (_.var function-name)
                                  (translate bodyS))))
-     closureO+ (monad.map @ reference.variable environment)
+     closureO+ (: (Operation (List Expression))
+                  (monad.map @ (:: reference.system variable) environment))
      #let [arityO (|> arity .int _.int)
-           @num-args (_.var "num_args")
-           @function (_.var function-name)
            apply-poly (.function (_ args func)
-                        (_.apply/2 (_.global "apply") func args))]]
+                        (_.apply/2 (_.global "apply") func args))
+           @num-args (_.var "num_args")
+           @function (_.var function-name)]]
     (with-closure function-name closureO+
       (_.letrec (list [@function (_.lambda [(list) (#.Some @curried)]
                                       (_.let (list [@num-args (_.length/1 @curried)])
                                         (<| (_.if (|> @num-args (_.=/2 arityO))
-                                              (<| (_.let (list [(reference.local' 0) @function]))
+                                              (<| (_.let (list [(//case.register 0) @function]))
                                                   (_.let-values (list [[(|> (list.indices arity)
                                                                             (list/map ..input))
                                                                         #.None]
@@ -87,6 +93,6 @@
                                             ## (|> @num-args (_.</2 arityO))
                                             (_.lambda [(list) (#.Some @missing)]
                                                  (|> @function
-                                                     (apply-poly (_.append/2 @curried @missing)))))))])
-                @function))
-    ))
+                                                     (apply-poly (_.append/2 @curried @missing)))))
+                                        ))])
+                @function))))