Some fixes.

5 files changed, 64 insertions, 27 deletions

diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux
index f4bae0122..38f1d3bd3 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/inference.lux
@@ -3,7 +3,7 @@
    [abstract
     [monad (#+ do)]]
    [control
-    ["ex" exception (#+ exception:)]]
+    ["." exception (#+ exception:)]]
    [data
     ["." maybe]
     [number
@@ -27,25 +27,25 @@
        [archive (#+ Archive)]]]]]])
 
 (exception: #export (variant-tag-out-of-bounds {size Nat} {tag Tag} {type Type})
-  (ex.report ["Tag" (%.nat tag)]
-             ["Variant size" (%.int (.int size))]
-             ["Variant type" (%.type type)]))
+  (exception.report
+   ["Tag" (%.nat tag)]
+   ["Variant size" (%.int (.int size))]
+   ["Variant type" (%.type type)]))
 
 (exception: #export (cannot-infer {type Type} {args (List Code)})
-  (ex.report ["Type" (%.type type)]
-             ["Arguments" (|> args
-                              list.enumerate
-                              (list@map (function (_ [idx argC])
-                                          (format text.new-line "  " (%.nat idx) " " (%.code argC))))
-                              (text.join-with ""))]))
+  (exception.report
+   ["Type" (%.type type)]
+   ["Arguments" (exception.enumerate %.code args)]))
 
 (exception: #export (cannot-infer-argument {inferred Type} {argument Code})
-  (ex.report ["Inferred Type" (%.type inferred)]
-             ["Argument" (%.code argument)]))
+  (exception.report
+   ["Inferred Type" (%.type inferred)]
+   ["Argument" (%.code argument)]))
 
 (exception: #export (smaller-variant-than-expected {expected Nat} {actual Nat})
-  (ex.report ["Expected" (%.int (.int expected))]
-             ["Actual" (%.int (.int actual))]))
+  (exception.report
+   ["Expected" (%.int (.int expected))]
+   ["Actual" (%.int (.int actual))]))
 
 (template [<name>]
   [(exception: #export (<name> {type Type})
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux
index 4ec689361..b195a11a2 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux
@@ -1,5 +1,6 @@
 (.module:
   [lux #*
+   ["." host]
    [abstract
     ["." monad (#+ do)]]
    [control
@@ -8,10 +9,11 @@
    [data
     [collection
      ["." array (#+ Array)]
-     ["." dictionary]]]
-   [type
+     ["." dictionary]
+     ["." list]]]
+   [type (#+ tuple)
     ["." check]]
-   [target
+   ["@" target
     ["_" js]]]
   [//
    ["/" lux (#+ custom)]
@@ -187,6 +189,20 @@
          _ (type.infer .Text)]
         (wrap (#analysis.Extension extension (list objectA)))))]))
 
+(def: js::function
+  Handler
+  (custom
+   [($_ <>.and <c>.nat <c>.any)
+    (function (_ extension phase archive [arity abstractionC])
+      (do phase.monad
+        [#let [inputT (tuple (list.repeat arity Any))]
+         abstractionA (type.with-type (-> inputT Any)
+                        (phase archive abstractionC))
+         _ (type.infer (for {@.js host.Function}
+                            Any))]
+        (wrap (#analysis.Extension extension (list (analysis.nat arity)
+                                                   abstractionA)))))]))
+
 (def: #export bundle
   Bundle
   (<| (bundle.prefix "js")
@@ -194,6 +210,7 @@
           (bundle.install "constant" js::constant)
           (bundle.install "apply" js::apply)
           (bundle.install "type-of" js::type-of)
+          (bundle.install "function" js::function)
           (dictionary.merge bundle::array)
           (dictionary.merge bundle::object)
           )))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux
index 514df447c..d9b52e450 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux
@@ -8,9 +8,10 @@
      ["<s>" synthesis (#+ Parser)]]]
    [data
     [collection
-     ["." dictionary]]]
+     ["." dictionary]
+     ["." list]]]
    [target
-    ["_" js (#+ Expression)]]]
+    ["_" js (#+ Var Expression)]]]
   ["." // #_
    ["#." common (#+ custom)]
    ["//#" /// #_
@@ -23,8 +24,10 @@
       ["//" js #_
        ["#." runtime (#+ Operation Phase Handler Bundle
                          with-vars)]]]
-     ["///#" //// #_
-      ["#." phase]]]]])
+     ["/#" // #_
+      ["." generation]
+      ["//#" /// #_
+       ["#." phase]]]]]])
 
 (def: array::new
   (Unary Expression)
@@ -124,6 +127,26 @@
          inputsG (monad.map @ (phase archive) inputsS)]
         (wrap (_.apply/* abstractionG inputsG))))]))
 
+(def: js::function
+  (custom
+   [($_ <>.and <s>.i64 <s>.any)
+    (function (_ extension phase archive [arity abstractionS])
+      (do {@ ////////phase.monad}
+        [abstractionG (phase archive abstractionS)
+         #let [variable (: (-> Text (Operation Var))
+                           (|>> generation.gensym
+                                (:: @ map _.var)))]
+         g!inputs (monad.map @ (function (_ _) (variable "input"))
+                             (list.repeat (.nat arity) []))
+         g!abstraction (variable "abstraction")]
+        (wrap (_.closure g!inputs
+                         ($_ _.then
+                             (_.define g!abstraction abstractionG)
+                             (_.return (case (.nat arity)
+                                         0 (_.apply/1 g!abstraction //runtime.unit)
+                                         1 (_.apply/* g!abstraction g!inputs)
+                                         _ (_.apply/1 g!abstraction (_.array g!inputs)))))))))]))
+
 (def: #export bundle
   Bundle
   (<| (/.prefix "js")
@@ -131,6 +154,7 @@
           (/.install "constant" js::constant)
           (/.install "apply" js::apply)
           (/.install "type-of" (unary _.type-of))
+          (/.install "function" js::function)
           (dictionary.merge ..array)
           (dictionary.merge ..object)
           )))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/structure.lux
index 07fc172a6..dee0aa051 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/structure.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/structure.lux
@@ -13,13 +13,11 @@
     ["//#" ///
      ["#." phase ("#@." monad)]]]])
 
-(def: unit Expression (//primitive.text /////synthesis.unit))
-
 (def: #export (tuple generate archive elemsS+)
   (Generator (Tuple Synthesis))
   (case elemsS+
     #.Nil
-    (///////phase@wrap ..unit)
+    (///////phase@wrap //runtime.unit)
 
     (#.Cons singletonS #.Nil)
     (generate archive singletonS)
diff --git a/stdlib/source/lux/tool/compiler/meta/archive.lux b/stdlib/source/lux/tool/compiler/meta/archive.lux
index 1aea7327f..ffd6e65ea 100644
--- a/stdlib/source/lux/tool/compiler/meta/archive.lux
+++ b/stdlib/source/lux/tool/compiler/meta/archive.lux
@@ -24,9 +24,7 @@
      ["." dictionary (#+ Dictionary)]
      ["." set]]]
    [type
-    abstract]
-   [world
-    [file (#+ File)]]]
+    abstract]]
   [/
    ["." signature (#+ Signature)]
    ["." key (#+ Key)]