Array machinery for the JavaScript compiler.

1 files changed, 146 insertions, 0 deletions

diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis/js.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis/js.lux
new file mode 100644
index 000000000..d8285532b
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/js.lux
@@ -0,0 +1,146 @@
+(.module:
+  [lux #*
+   [abstract
+    ["." monad (#+ do)]]
+   [control
+    ["<>" parser
+     ["<c>" code (#+ Parser)]]
+    pipe]
+   [data
+    [collection
+     ["." array (#+ Array)]
+     ["." dictionary]]]
+   [type
+    ["." check]]
+   [target
+    ["_" js]]]
+  ["." // #_
+   ["#." lux (#+ custom)]
+   ["/#" //
+    ["#." bundle]
+    ["/#" // ("#@." monad)
+     [analysis
+      [".A" type]]
+     ["/#" // #_
+      ["#." analysis (#+ Analysis Operation Phase Handler Bundle)]]]]])
+
+(def: array::new
+  Handler
+  (custom
+   [<c>.any
+    (function (_ extension phase lengthC)
+      (do ////.monad
+        [lengthA (typeA.with-type Nat
+                   (phase lengthC))
+         [var-id varT] (typeA.with-env check.var)
+         _ (typeA.infer (type (Array varT)))]
+        (wrap (#/////analysis.Extension extension (list lengthA)))))]))
+
+(def: array::length
+  Handler
+  (custom
+   [<c>.any
+    (function (_ extension phase arrayC)
+      (do ////.monad
+        [[var-id varT] (typeA.with-env check.var)
+         arrayA (typeA.with-type (type (Array varT))
+                  (phase arrayC))
+         _ (typeA.infer Nat)]
+        (wrap (#/////analysis.Extension extension (list arrayA)))))]))
+
+(def: array::read
+  Handler
+  (custom
+   [(<>.and <c>.any <c>.any)
+    (function (_ extension phase [indexC arrayC])
+      (do ////.monad
+        [indexA (typeA.with-type Nat
+                  (phase indexC))
+         [var-id varT] (typeA.with-env check.var)
+         arrayA (typeA.with-type (type (Array varT))
+                  (phase arrayC))
+         _ (typeA.infer varT)]
+        (wrap (#/////analysis.Extension extension (list indexA arrayA)))))]))
+
+(def: array::write
+  Handler
+  (custom
+   [($_ <>.and <c>.any <c>.any <c>.any)
+    (function (_ extension phase [indexC valueC arrayC])
+      (do ////.monad
+        [indexA (typeA.with-type Nat
+                  (phase indexC))
+         [var-id varT] (typeA.with-env check.var)
+         valueA (typeA.with-type varT
+                  (phase valueC))
+         arrayA (typeA.with-type (type (Array varT))
+                  (phase arrayC))
+         _ (typeA.infer (type (Array varT)))]
+        (wrap (#/////analysis.Extension extension (list indexA valueA arrayA)))))]))
+
+(def: array::delete
+  Handler
+  (custom
+   [($_ <>.and <c>.any <c>.any)
+    (function (_ extension phase [indexC arrayC])
+      (do ////.monad
+        [indexA (typeA.with-type Nat
+                  (phase indexC))
+         [var-id varT] (typeA.with-env check.var)
+         arrayA (typeA.with-type (type (Array varT))
+                  (phase arrayC))
+         _ (typeA.infer (type (Array varT)))]
+        (wrap (#/////analysis.Extension extension (list indexA arrayA)))))]))
+
+(def: bundle::array
+  Bundle
+  (<| (///bundle.prefix "array")
+      (|> ///bundle.empty
+          (///bundle.install "new" array::new)
+          (///bundle.install "length" array::length)
+          (///bundle.install "read" array::read)
+          (///bundle.install "write" array::write)
+          (///bundle.install "delete" array::delete)
+          )))
+
+(def: js::constant
+  Handler
+  (custom
+   [<c>.text
+    (function (_ extension phase name)
+      (do ////.monad
+        [_ (typeA.infer Any)]
+        (wrap (#/////analysis.Extension extension (list (/////analysis.text name))))))]))
+
+(def: js::apply
+  Handler
+  (custom
+   [($_ <>.and <c>.any (<>.some <c>.any))
+    (function (_ extension phase [abstractionC inputsC])
+      (do ////.monad
+        [abstractionA (typeA.with-type Any
+                        (phase abstractionC))
+         inputsA (monad.map @ (|>> phase (typeA.with-type Any)) inputsC)
+         _ (typeA.infer Any)]
+        (wrap (#/////analysis.Extension extension (list& abstractionA inputsA)))))]))
+
+(def: js::undefined?
+  Handler
+  (custom
+   [<c>.any
+    (function (_ extension phase [valueC])
+      (do ////.monad
+        [valueA (typeA.with-type Any
+                  (phase valueC))
+         _ (typeA.infer Bit)]
+        (wrap (#/////analysis.Extension extension (list valueA)))))]))
+
+(def: #export bundle
+  Bundle
+  (<| (///bundle.prefix "js")
+      (|> ///bundle.empty
+          (///bundle.install "constant" js::constant)
+          (///bundle.install "apply" js::apply)
+          (///bundle.install "undefined?" js::undefined?)
+          (dictionary.merge bundle::array)
+          )))