From 5e45337f2829376a552d4ff26121125c135aa2b7 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sun, 5 Jul 2020 18:55:19 -0400
Subject: Got the JS compiler code to build again.

---
 lux-js/source/program.lux | 206 +++++++++++++++++++++++++++++-----------------
 1 file changed, 132 insertions(+), 74 deletions(-)

(limited to 'lux-js')

diff --git a/lux-js/source/program.lux b/lux-js/source/program.lux
index f3b149e72..cebede1ab 100644
--- a/lux-js/source/program.lux
+++ b/lux-js/source/program.lux
@@ -5,17 +5,22 @@
    [abstract
     [monad (#+ do)]]
    [control
+    ["." try (#+ Try)]
     ["." exception (#+ exception:)]
     ["." io (#+ IO io)]
     [parser
-     [cli (#+ program:)]]]
+     [cli (#+ program:)]]
+    [concurrency
+     ["." promise (#+ Promise)]]]
    [data
     ["." maybe]
-    ["." error (#+ Error)]
     [number
-     ["." i64]]
-    ["." text ("#@." hash)
-     format]
+     ["." i64]
+     ["n" nat]
+     ["i" int]]
+    [text
+     ["%" format (#+ format)]
+     ["." encoding]]
     [collection
      ["." array (#+ Array)]]]
    [macro
@@ -26,22 +31,33 @@
     ["_" js]]
    [tool
     [compiler
-     ["." name]
-     [phase
-      [macro (#+ Expander)]
-      ["." extension #_
-       ["#/." bundle]
-       ["." analysis #_
-        ["#/." js]]]
-      ["." generation
-       ["." js
-        ["." runtime]
-        ["." extension]]]]
+     [phase (#+ Operation Phase)]
+     [language
+      [lux
+       [program (#+ Program)]
+       [generation (#+ Context Host)]
+       [analysis
+        [macro (#+ Expander)]]
+       [phase
+        ["." extension (#+ Extender Handler)
+         ["#/." bundle]
+         ["." analysis #_
+          ["#" js]]
+         ["." generation #_
+          ["#" js]]]
+        [generation
+         ["." reference]
+         ["." js
+          ["." runtime]]]]]]
      [default
-      ["." platform (#+ Platform)]]]]]
+      ["." platform (#+ Platform)]]
+     [meta
+      ["." packager #_
+       ["#" script]]]]]]
   [program
    ["/" compositor
-    ["/." cli]]])
+    ["/." cli]
+    ["/." static]]])
 
 (import: #long java/lang/String)
 
@@ -247,8 +263,8 @@
             [[(java/lang/Number::longValue high)
               (java/lang/Number::longValue low)]
              [high low]])
-    (#.Some (.int (n/+ (|> high .nat (i64.left-shift 32))
-                       (if (i/< +0 (.int low))
+    (#.Some (.int (n.+ (|> high .nat (i64.left-shift 32))
+                       (if (i.< +0 (.int low))
                          (|> low .nat (i64.left-shift 32) (i64.logic-right-shift 32))
                          (.nat low)))))
 
@@ -256,7 +272,7 @@
     #.None))
 
 (def: (check-variant lux-object js-object)
-  (-> (-> java/lang/Object (Error Any))
+  (-> (-> java/lang/Object (Try Any))
       jdk/nashorn/api/scripting/ScriptObjectMirror
       (Maybe Any))
   (case [(jdk/nashorn/api/scripting/JSObject::getMember [runtime.variant-tag-field] js-object)
@@ -275,7 +291,7 @@
     #.None))
 
 (def: (check-array lux-object js-object)
-  (-> (-> java/lang/Object (Error Any))
+  (-> (-> java/lang/Object (Try Any))
       jdk/nashorn/api/scripting/ScriptObjectMirror
       (Maybe (Array java/lang/Object)))
   (if (jdk/nashorn/api/scripting/JSObject::isArray js-object)
@@ -283,8 +299,8 @@
       (loop [idx 0
              output (: (Array java/lang/Object)
                        (array.new num-keys))]
-        (if (n/< num-keys idx)
-          (case (jdk/nashorn/api/scripting/JSObject::getMember (%n idx) js-object)
+        (if (n.< num-keys idx)
+          (case (jdk/nashorn/api/scripting/JSObject::getMember (%.nat idx) js-object)
             (#.Some member)
             (case (host.check jdk/nashorn/internal/runtime/Undefined member)
               (#.Some _)
@@ -292,10 +308,10 @@
 
               #.None
               (case (lux-object member)
-                (#error.Success parsed-member)
+                (#try.Success parsed-member)
                 (recur (inc idx) (array.write idx (:coerce java/lang/Object parsed-member) output))
 
-                (#error.Failure error)
+                (#try.Failure error)
                 #.None))
 
             #.None
@@ -304,12 +320,12 @@
     #.None))
 
 (def: (lux-object js-object)
-  (-> java/lang/Object (Error Any))
+  (-> java/lang/Object (Try Any))
   (`` (<| (if (host.null? js-object)
-            (exception.throw null-has-no-lux-representation []))
+            (exception.throw ..null-has-no-lux-representation []))
           (case (host.check jdk/nashorn/internal/runtime/Undefined js-object)
             (#.Some _)
-            (exception.throw undefined-has-no-lux-representation [])
+            (exception.throw ..undefined-has-no-lux-representation [])
             #.None)
           (~~ (template [<class>]
                 [(case (host.check <class> js-object)
@@ -362,10 +378,10 @@
         #.None))))
 
 (def: (call-macro inputs lux macro)
-  (-> (List Code) Lux jdk/nashorn/api/scripting/JSObject (Error (Error [Lux (List Code)])))
+  (-> (List Code) Lux jdk/nashorn/api/scripting/JSObject (Try (Try [Lux (List Code)])))
   (let [to-js (: (-> Any java/lang/Object)
                  (|>> (:coerce (Array java/lang/Object)) js-structure (:coerce java/lang/Object)))]
-    (<| (:coerce (Error (Error [Lux (List Code)])))
+    (<| (:coerce (Try (Try [Lux (List Code)])))
         (jdk/nashorn/api/scripting/JSObject::call #.None
                                                   (|> (array.new 2)
                                                       (: (Array java/lang/Object))
@@ -378,77 +394,79 @@
   (case (ensure-macro macro)
     (#.Some macro)
     (case (call-macro inputs lux macro)
-      (#error.Success output)
+      (#try.Success output)
       (|> output
           (:coerce java/lang/Object)
           lux-object
-          (:coerce (Error (Error [Lux (List Code)]))))
+          (:coerce (Try (Try [Lux (List Code)]))))
 
-      (#error.Failure error)
-      (#error.Failure error))
+      (#try.Failure error)
+      (#try.Failure error))
     
     #.None
-    (exception.throw cannot-apply-a-non-function (:coerce java/lang/Object macro))))
-
-(def: separator "$")
+    (exception.throw ..cannot-apply-a-non-function (:coerce java/lang/Object macro))))
 
 (def: (evaluate! interpreter alias input)
-  (-> javax/script/ScriptEngine Text _.Expression (Error Any))
-  (do error.monad
+  (-> javax/script/ScriptEngine Text _.Expression (Try Any))
+  (do try.monad
     [?output (javax/script/ScriptEngine::eval (_.code input) interpreter)
      output (case ?output
               (#.Some output)
               (wrap output)
 
               #.None
-              (exception.throw null-has-no-lux-representation []))
-     lux-output (..lux-object output)]
-    (wrap lux-output)))
+              (exception.throw ..null-has-no-lux-representation []))]
+    (..lux-object output)))
 
 (def: (execute! interpreter alias input)
-  (-> javax/script/ScriptEngine Text _.Statement (Error Any))
-  (do error.monad
+  (-> javax/script/ScriptEngine Text _.Statement (Try Any))
+  (do try.monad
     [?output (javax/script/ScriptEngine::eval (_.code input) interpreter)]
     (wrap [])))
 
-(def: (define! interpreter [module name] input)
-  (-> javax/script/ScriptEngine Name _.Expression (Error [Text Any _.Statement]))
-  (let [global (format (text.replace-all .module-separator ..separator module)
-                       ..separator (name.normalize name)
-                       "___" (%n (text@hash name)))
+(def: (define! interpreter context input)
+  (-> javax/script/ScriptEngine Context _.Expression (Try [Text Any _.Statement]))
+  (let [global (reference.artifact context)
         @global (_.var global)]
-    (do error.monad
+    (do try.monad
       [#let [definition (_.define @global input)]
        _ (execute! interpreter global definition)
        value (evaluate! interpreter global @global)]
       (wrap [global value definition]))))
 
-(type: Host
-  (generation.Host _.Expression _.Statement))
-
 (def: host
-  (IO Host)
+  (IO (Host _.Expression _.Statement))
   (io (let [interpreter (javax/script/ScriptEngineFactory::getScriptEngine
                          (jdk/nashorn/api/scripting/NashornScriptEngineFactory::new))]
-        (: Host
+        (: (Host _.Expression _.Statement)
            (structure
-            (def: (evaluate! alias input)
-              (..evaluate! interpreter (name.normalize alias) input))
+            (def: evaluate! (..evaluate! interpreter))
             (def: execute! (..execute! interpreter))
-            (def: define! (..define! interpreter)))))))
+            (def: define! (..define! interpreter))
+
+            (def: (ingest context content)
+              (|> content encoding.from-utf8 try.assume (:coerce _.Statement)))
+
+            (def: (re-learn context content)
+              (..execute! interpreter (reference.artifact context) content))
+            
+            (def: (re-load context content)
+              (do try.monad
+                [_ (..execute! interpreter "" content)]
+                (..evaluate! interpreter "" (_.var (reference.artifact context))))))))))
 
 (def: platform
-  (IO (Platform IO _.Var _.Expression _.Statement))
+  (IO (Platform _.Var _.Expression _.Statement))
   (do io.monad
     [host ..host]
-    (wrap {#platform.&monad io.monad
-           #platform.&file-system file.system
+    (wrap {#platform.&file-system (file.async file.system)
            #platform.host host
            #platform.phase js.generate
-           #platform.runtime runtime.generate})))
+           #platform.runtime runtime.generate
+           #platform.write (|>> _.code encoding.to-utf8)})))
 
-(def: (program program)
-  (-> _.Expression _.Statement)
+(def: (program namer context program)
+  (-> (-> Context Text) (Program _.Expression _.Statement))
   (let [@process (_.var "process")
         raw-inputs (_.? (|> (|> @process _.type-of (_.= (_.string "undefined")) _.not)
                             (_.and (|> @process (_.the "argv"))))
@@ -458,13 +476,53 @@
                             (runtime.lux//program-args raw-inputs)
                             _.null))))
 
+(def: extender
+  Extender
+  ## TODO: Stop relying on coercions ASAP.
+  (<| (:coerce Extender)
+      (function (@self handler))
+      (:coerce Handler)
+      (function (@self name phase))
+      (:coerce Phase)
+      (function (@self archive parameters))
+      (:coerce Operation)
+      (function (@self state))
+      (:coerce Try)
+      try.assume
+      (:coerce Try)
+      (do try.monad
+        [handler (try.from-maybe (..ensure-macro (:coerce Macro handler)))
+         #let [to-js (: (-> Any java/lang/Object)
+                        (|>> (:coerce (Array java/lang/Object)) js-structure (:coerce java/lang/Object)))]]
+        (jdk/nashorn/api/scripting/JSObject::call #.None
+                                                  (|> (array.new 2)
+                                                      (: (Array java/lang/Object))
+                                                      (array.write 0 (to-js name))
+                                                      (array.write 1 (to-js phase))
+                                                      (array.write 2 (to-js archive))
+                                                      (array.write 3 (to-js parameters))
+                                                      (array.write 4 (to-js state)))
+                                                  (:coerce jdk/nashorn/api/scripting/JSObject handler)))))
+
+(def: (declare-success! _)
+  (-> Any (Promise Any))
+  (promise.future (io.exit +0)))
+
 (program: [{service /cli.service}]
-  (/.compiler @.js
-              ".js"
-              ..expander
-              analysis/js.bundle
-              ..platform
-              extension.bundle
-              extension/bundle.empty
-              ..program
-              service))
+  (exec (do promise.monad
+          [_ (/.compiler {#/static.host @.js
+                          #/static.host-module-extension ".js"
+                          #/static.target (/cli.target service)
+                          #/static.artifact-extension ".js"}
+                         ..expander
+                         analysis.bundle
+                         ..platform
+                         generation.bundle
+                         extension/bundle.empty
+                         (..program reference.artifact)
+                         ..extender
+                         service
+                         [(packager.package _.use-strict _.code _.then)
+                          (format (/cli.target service) (:: file.system separator) "program.js")])]
+          (..declare-success! []))
+    (io.io [])))
-- 
cgit v1.2.3