Added an easy way to export Lux functionality to host programs (everywhere else).

1 files changed, 172 insertions, 142 deletions

diff --git a/lux-js/source/program.lux b/lux-js/source/program.lux
index b670da4fa..8993c1192 100644
--- a/lux-js/source/program.lux
+++ b/lux-js/source/program.lux
@@ -7,7 +7,7 @@
    [abstract
     [monad {"+" do}]]
    [control
-    ["[0]" maybe]
+    ["[0]" maybe ("[1]#[0]" monad)]
     ["[0]" try {"+" Try}]
     ["[0]" exception {"+" exception:}]
     ["[0]" io {"+" IO io}]
@@ -76,7 +76,7 @@
     {.#None}
     "???"))
 
-(for [@.old
+(for [@.jvm
       (as_is (import: java/lang/String)
 
              (import: (java/lang/Class a))
@@ -88,7 +88,7 @@
 
              (import: java/lang/Long
                ["[1]::[0]"
-                (intValue [] java/lang/Integer)])
+                (intValue [] int)])
 
              (import: java/lang/Integer
                ["[1]::[0]"
@@ -96,7 +96,7 @@
 
              (import: java/lang/Number
                ["[1]::[0]"
-                (intValue [] java/lang/Integer)
+                (intValue [] int)
                 (longValue [] long)
                 (doubleValue [] double)])
 
@@ -139,9 +139,9 @@
                [(ffi.interface: <name>
                   (getValue [] java/lang/Object))
 
-                (`` (import: (~~ (template.symbol ["program/" <name>]))
-                      ["[1]::[0]"
-                       (getValue [] java/lang/Object)]))]
+                (import: <name>
+                  ["[1]::[0]"
+                   (getValue [] java/lang/Object)])]
 
                [IntValue]
                [StructureValue]
@@ -155,60 +155,76 @@
 
              (def: jvm_int
                (-> (I64 Any) java/lang/Integer)
-               (|>> (:as java/lang/Long) java/lang/Long::intValue))
+               (|>> .int
+                    ffi.as_long
+                    java/lang/Long::intValue))
 
              (def: (js_int value)
                (-> Int org/openjdk/nashorn/api/scripting/JSObject)
-               (ffi.object [] org/openjdk/nashorn/api/scripting/AbstractJSObject [program/IntValue]
-                 []
-                 ... Methods
-                 (program/IntValue
-                  [] (getValue self []) java/lang/Object
-                  (:as java/lang/Object value))
-                 (org/openjdk/nashorn/api/scripting/AbstractJSObject
-                  [] (getMember self [member java/lang/String]) java/lang/Object
-                  (case member
-                    (^ (static runtime.i64_high_field))
-                    (|> value .nat runtime.high jvm_int)
-
-                    (^ (static runtime.i64_low_field))
-                    (|> value .nat runtime.low jvm_int)
-
-                    _
-                    (panic! (exception.error ..unknown_member [member (:as java/lang/Object value)]))))
-                 ))
+               (<| (ffi.:as org/openjdk/nashorn/api/scripting/JSObject)
+                   (ffi.object [] org/openjdk/nashorn/api/scripting/AbstractJSObject [IntValue]
+                     []
+                     ... Methods
+                     (IntValue
+                      [] (getValue self []) java/lang/Object
+                      (ffi.:as java/lang/Object (ffi.as_long value)))
+                     (org/openjdk/nashorn/api/scripting/AbstractJSObject
+                      [] (getMember self [member java/lang/String]) java/lang/Object
+                      (case (ffi.of_string member)
+                        (^ (static runtime.i64_high_field))
+                        (|> value .nat runtime.high jvm_int
+                            (ffi.:as java/lang/Object))
+
+                        (^ (static runtime.i64_low_field))
+                        (|> value .nat runtime.low jvm_int
+                            (ffi.:as java/lang/Object))
+
+                        _
+                        (panic! (exception.error ..unknown_member [(ffi.of_string member)
+                                                                   (ffi.:as java/lang/Object (ffi.as_long value))]))))
+                     )))
 
              (def: (::toString js_object)
                (-> Any org/openjdk/nashorn/api/scripting/JSObject)
-               (ffi.object [] org/openjdk/nashorn/api/scripting/AbstractJSObject []
-                 []
-                 (org/openjdk/nashorn/api/scripting/AbstractJSObject
-                  [] (isFunction self []) boolean
-                  #1)
-                 (org/openjdk/nashorn/api/scripting/AbstractJSObject
-                  [] (call self [this java/lang/Object
-                                 args [java/lang/Object]])
-                  java/lang/Object
-                  (debug.inspection js_object))
-                 ))
+               (<| (ffi.:as org/openjdk/nashorn/api/scripting/JSObject)
+                   (ffi.object [] org/openjdk/nashorn/api/scripting/AbstractJSObject []
+                     []
+                     (org/openjdk/nashorn/api/scripting/AbstractJSObject
+                      [] (isFunction self []) boolean
+                      (ffi.as_boolean #1))
+                     (org/openjdk/nashorn/api/scripting/AbstractJSObject
+                      [] (call self [this java/lang/Object
+                                     args [java/lang/Object]])
+                      java/lang/Object
+                      (|> js_object
+                          debug.inspection
+                          ffi.as_string
+                          (ffi.:as java/lang/Object)))
+                     )))
 
              (def: (::slice js_object value)
                (-> (-> java/lang/Object org/openjdk/nashorn/api/scripting/JSObject) (Array java/lang/Object) org/openjdk/nashorn/api/scripting/JSObject)
-               (ffi.object [] org/openjdk/nashorn/api/scripting/AbstractJSObject []
-                 []
-                 (org/openjdk/nashorn/api/scripting/AbstractJSObject
-                  [] (isFunction self []) boolean
-                  #1)
-                 (org/openjdk/nashorn/api/scripting/AbstractJSObject
-                  [] (call self [this java/lang/Object
-                                 args [java/lang/Object]])
-                  java/lang/Object
-                  (|> (java/util/Arrays::copyOfRange value
-                                                     (|> args (array.read! 0) maybe.trusted (:as Int))
-                                                     (.int (array.size value)))
-                      js_object
-                      (:as java/lang/Object)))
-                 ))
+               (<| (ffi.:as org/openjdk/nashorn/api/scripting/JSObject)
+                   (ffi.object [] org/openjdk/nashorn/api/scripting/AbstractJSObject []
+                     []
+                     (org/openjdk/nashorn/api/scripting/AbstractJSObject
+                      [] (isFunction self []) boolean
+                      (ffi.as_boolean #1))
+                     (org/openjdk/nashorn/api/scripting/AbstractJSObject
+                      [] (call self [this java/lang/Object
+                                     args [java/lang/Object]])
+                      java/lang/Object
+                      (|> (java/util/Arrays::copyOfRange value
+                                                         (|> args
+                                                             (array.read! 0)
+                                                             maybe.trusted
+                                                             (:as Int)
+                                                             ffi.as_int)
+                                                         (ffi.as_int (.int (array.size value))))
+                          (:as java/lang/Object)
+                          js_object
+                          (ffi.:as java/lang/Object)))
+                     )))
 
              (def: (js_structure value)
                (-> (Array java/lang/Object) org/openjdk/nashorn/api/scripting/JSObject)
@@ -221,90 +237,101 @@
                                           {.#None})
                                         (case (ffi.check java/lang/Long sub_value)
                                           {.#Some sub_value}
-                                          (|> sub_value (:as Int) js_int)
+                                          (|> sub_value ffi.of_long js_int)
 
                                           {.#None})
                                         ... else
                                         (:as org/openjdk/nashorn/api/scripting/JSObject sub_value))))]
-                 (ffi.object [] org/openjdk/nashorn/api/scripting/AbstractJSObject [program/StructureValue]
-                   []
-                   ... Methods
-                   (program/StructureValue
-                    [] (getValue self []) java/lang/Object
-                    (:as (Array java/lang/Object) value))
-                   (org/openjdk/nashorn/api/scripting/AbstractJSObject
-                    [] (isArray self []) boolean
-                    #1)
-                   (org/openjdk/nashorn/api/scripting/AbstractJSObject
-                    [] (getMember self [member java/lang/String])
-                    java/lang/Object
-                    (case member
-                      (^or "toJSON" "toString")
-                      (:as java/lang/Object
-                           (::toString value))
-                      
-                      "length"
-                      (jvm_int (array.size value))
-                      
-                      "slice"
-                      (:as java/lang/Object
-                           (::slice js_object value))
-
-                      (^ (static runtime.variant_tag_field))
-                      (|> value (array.read! 0) maybe.trusted)
-                      
-                      (^ (static runtime.variant_flag_field))
-                      (case (array.read! 1 value)
-                        {.#Some set!}
-                        set!
+                 (<| (ffi.:as org/openjdk/nashorn/api/scripting/JSObject)
+                     (ffi.object [] org/openjdk/nashorn/api/scripting/AbstractJSObject [StructureValue]
+                       []
+                       ... Methods
+                       (StructureValue
+                        [] (getValue self []) java/lang/Object
+                        (ffi.:as java/lang/Object value))
+                       (org/openjdk/nashorn/api/scripting/AbstractJSObject
+                        [] (isArray self []) boolean
+                        (ffi.as_boolean #1))
+                       (org/openjdk/nashorn/api/scripting/AbstractJSObject
+                        [] (getMember self [member java/lang/String])
+                        java/lang/Object
+                        (case (ffi.of_string member)
+                          (^or "toJSON" "toString")
+                          (|> (::toString value)
+                              (ffi.:as java/lang/Object))
+                          
+                          "length"
+                          (|> value
+                              array.size
+                              jvm_int
+                              (ffi.:as java/lang/Object))
+                          
+                          "slice"
+                          (|> (::slice js_object value)
+                              (ffi.:as java/lang/Object))
+
+                          (^ (static runtime.variant_tag_field))
+                          (|> value
+                              (array.read! 0)
+                              maybe.trusted)
+                          
+                          (^ (static runtime.variant_flag_field))
+                          (case (array.read! 1 value)
+                            {.#Some set!}
+                            set!
 
-                        _
-                        (ffi.null))
-                      
-                      (^ (static runtime.variant_value_field))
-                      (|> value (array.read! 2) maybe.trusted js_object (:as java/lang/Object))
-                      
-                      _
-                      (panic! (exception.error ..unknown_member [(:as Text member) (:as java/lang/Object value)])))
-                    )
-                   (org/openjdk/nashorn/api/scripting/AbstractJSObject
-                    [] (getSlot self [idx int]) java/lang/Object
-                    (|> value
-                        (array.read! (|> idx java/lang/Integer::longValue (:as Nat)))
-                        maybe.trusted
-                        js_object
-                        (:as java/lang/Object)))
-                   )))
+                            _
+                            (ffi.null))
+                          
+                          (^ (static runtime.variant_value_field))
+                          (|> value
+                              (array.read! 2)
+                              maybe.trusted
+                              js_object
+                              (ffi.:as java/lang/Object))
+                          
+                          _
+                          (panic! (exception.error ..unknown_member [(:as Text member) (:as java/lang/Object value)])))
+                        )
+                       (org/openjdk/nashorn/api/scripting/AbstractJSObject
+                        [] (getSlot self [idx int]) java/lang/Object
+                        (|> value
+                            (array.read! (|> idx java/lang/Integer::longValue (:as Nat)))
+                            maybe.trusted
+                            js_object
+                            (:as java/lang/Object)))
+                       ))))
 
              (exception: undefined_has_no_lux_representation)
 
              (exception: (unknown_kind_of_host_object [object java/lang/Object])
                (exception.report
-                ["Class" (java/lang/Object::toString (java/lang/Object::getClass object))]
-                ["Object" (java/lang/Object::toString object)]
+                ["Class" (ffi.of_string (java/lang/Object::toString (java/lang/Object::getClass object)))]
+                ["Object" (ffi.of_string (java/lang/Object::toString object))]
                 ["Keys" (case (ffi.check org/openjdk/nashorn/api/scripting/ScriptObjectMirror object)
                           {.#Some object}
                           (|> object
                               (org/openjdk/nashorn/api/scripting/ScriptObjectMirror::getOwnKeys true)
-                              (:as (Array Text))
                               (array.list {.#None})
-                              (%.list %.text))
+                              (%.list (|>> ffi.of_string %.text)))
                           
                           {.#None}
                           "???")]))
 
+             (def: (i32 half i64)
+               (-> Text org/openjdk/nashorn/api/scripting/ScriptObjectMirror (Maybe Int))
+               (|> i64
+                   (org/openjdk/nashorn/api/scripting/JSObject::getMember [(ffi.as_string half)])
+                   (maybe#each (|>> (ffi.check java/lang/Number)))
+                   maybe#conjoint
+                   (maybe#each (|>> java/lang/Number::longValue ffi.of_long))))
+
              (def: (check_int js_object)
                (-> org/openjdk/nashorn/api/scripting/ScriptObjectMirror
                    (Maybe Int))
-               (case [(org/openjdk/nashorn/api/scripting/JSObject::getMember [runtime.i64_high_field] js_object)
-                      (org/openjdk/nashorn/api/scripting/JSObject::getMember [runtime.i64_low_field] js_object)]
-                 (^multi [{.#Some high} {.#Some low}]
-                         [[(ffi.check java/lang/Number high)
-                           (ffi.check java/lang/Number low)]
-                          [{.#Some high} {.#Some low}]]
-                         [[(java/lang/Number::longValue high)
-                           (java/lang/Number::longValue low)]
-                          [high low]])
+               (case [(..i32 runtime.i64_high_field js_object)
+                      (..i32 runtime.i64_low_field js_object)]
+                 [{.#Some high} {.#Some low}]
                  {.#Some (.int (n.+ (|> high .nat (i64.left_shifted 32))
                                     (if (i.< +0 (.int low))
                                       (|> low .nat (i64.left_shifted 32) (i64.right_shifted 32))
@@ -317,14 +344,12 @@
                (-> (-> java/lang/Object (Try Any))
                    org/openjdk/nashorn/api/scripting/ScriptObjectMirror
                    (Maybe Any))
-               (case [(org/openjdk/nashorn/api/scripting/JSObject::getMember [runtime.variant_tag_field] js_object)
-                      (org/openjdk/nashorn/api/scripting/JSObject::getMember [runtime.variant_flag_field] js_object)
-                      (org/openjdk/nashorn/api/scripting/JSObject::getMember [runtime.variant_value_field] js_object)]
+               (case [(org/openjdk/nashorn/api/scripting/JSObject::getMember [(ffi.as_string runtime.variant_tag_field)] js_object)
+                      (org/openjdk/nashorn/api/scripting/JSObject::getMember [(ffi.as_string runtime.variant_flag_field)] js_object)
+                      (org/openjdk/nashorn/api/scripting/JSObject::getMember [(ffi.as_string runtime.variant_value_field)] js_object)]
                  (^multi [{.#Some tag} ?flag {.#Some value}]
-                         [(ffi.check java/lang/Number tag)
-                          {.#Some tag}]
-                         [(lux_object value)
-                          {try.#Success value}])
+                         [[(ffi.check java/lang/Number tag) (lux_object value)]
+                          [{.#Some tag} {try.#Success value}]])
                  {.#Some [(java/lang/Number::intValue (:as java/lang/Number tag))
                           (maybe.else (ffi.null) ?flag)
                           value]}
@@ -336,13 +361,13 @@
                (-> (-> java/lang/Object (Try Any))
                    org/openjdk/nashorn/api/scripting/ScriptObjectMirror
                    (Maybe (Array java/lang/Object)))
-               (if (org/openjdk/nashorn/api/scripting/JSObject::isArray js_object)
-                 (let [num_keys (.nat (org/openjdk/nashorn/api/scripting/ScriptObjectMirror::size js_object))]
+               (if (ffi.of_boolean (org/openjdk/nashorn/api/scripting/JSObject::isArray js_object))
+                 (let [num_keys (.nat (ffi.of_int (org/openjdk/nashorn/api/scripting/ScriptObjectMirror::size js_object)))]
                    (loop [idx 0
                           output (: (Array java/lang/Object)
                                     (array.empty num_keys))]
                      (if (n.< num_keys idx)
-                       (case (org/openjdk/nashorn/api/scripting/JSObject::getMember (%.nat idx) js_object)
+                       (case (org/openjdk/nashorn/api/scripting/JSObject::getMember (ffi.as_string (%.nat idx)) js_object)
                          {.#Some member}
                          (case (ffi.check org/openjdk/nashorn/internal/runtime/Undefined member)
                            {.#Some _}
@@ -386,8 +411,8 @@
                                 {.#None})]
 
                              [java/lang/Number java/lang/Number::doubleValue]
-                             [program/StructureValue program/StructureValue::getValue]
-                             [program/IntValue program/IntValue::getValue]))
+                             [StructureValue StructureValue::getValue]
+                             [IntValue IntValue::getValue]))
                        (case (ffi.check org/openjdk/nashorn/api/scripting/ScriptObjectMirror js_object)
                          {.#Some js_object}
                          (case (check_int js_object)
@@ -405,7 +430,7 @@
                                {try.#Success value}
 
                                {.#None}
-                               (if (org/openjdk/nashorn/api/scripting/JSObject::isFunction js_object)
+                               (if (ffi.of_boolean (org/openjdk/nashorn/api/scripting/JSObject::isFunction js_object))
                                  {try.#Success js_object}
                                  ... (exception.except ..unknown_kind_of_host_object [(:as java/lang/Object js_object)])
                                  {try.#Success js_object}
@@ -422,7 +447,7 @@
                  [function (|> function
                                (:as java/lang/Object)
                                (ffi.check org/openjdk/nashorn/api/scripting/JSObject))]
-                 (if (org/openjdk/nashorn/api/scripting/JSObject::isFunction function)
+                 (if (ffi.of_boolean (org/openjdk/nashorn/api/scripting/JSObject::isFunction function))
                    {.#Some function}
                    {.#None})))
              )
@@ -430,7 +455,7 @@
       @.js
       (as_is)])
 
-(for [@.old
+(for [@.jvm
       (as_is (def: (call_macro inputs lux macro)
                (-> (List Code) Lux org/openjdk/nashorn/api/scripting/JSObject (Try (Try [Lux (List Code)])))
                (let [to_js (: (-> Any java/lang/Object)
@@ -445,7 +470,7 @@
 
              (exception: (cannot_apply_a_non_function [object java/lang/Object])
                (exception.report
-                ["Object" (java/lang/Object::toString object)]))
+                ["Object" (ffi.of_string (java/lang/Object::toString object))]))
 
              (def: (expander macro inputs lux)
                Expander
@@ -471,11 +496,11 @@
         {try.#Success ((:as Macro' macro) inputs lux)})
       ])
 
-(for [@.old
+(for [@.jvm
       (as_is (def: (evaluate! interpreter alias input)
                (-> javax/script/ScriptEngine unit.ID _.Expression (Try Any))
                (do try.monad
-                 [?output (javax/script/ScriptEngine::eval (_.code input) interpreter)]
+                 [?output (javax/script/ScriptEngine::eval (ffi.as_string (_.code input)) interpreter)]
                  (case ?output
                    {.#Some output}
                    (..lux_object output)
@@ -486,7 +511,7 @@
              (def: (execute! interpreter input)
                (-> javax/script/ScriptEngine _.Statement (Try Any))
                (do try.monad
-                 [?output (javax/script/ScriptEngine::eval (_.code input) interpreter)]
+                 [?output (javax/script/ScriptEngine::eval (ffi.as_string (_.code input)) interpreter)]
                  (in [])))
 
              (def: (define! interpreter context custom input)
@@ -506,9 +531,9 @@
                                       (org/openjdk/nashorn/api/scripting/NashornScriptEngineFactory::new))]
                      (: (Host _.Expression _.Statement)
                         (implementation
-                         (def: evaluate (..evaluate! interpreter))
+                         (def: (evaluate alias [_ input]) (..evaluate! interpreter alias input))
                          (def: execute (..execute! interpreter))
-                         (def: define (..define! interpreter))
+                         (def: (define context custom [_ input]) (..define! interpreter context custom input))
 
                          (def: (ingest context content)
                            (|> content (# utf8.codec decoded) try.trusted (:as _.Statement)))
@@ -565,9 +590,9 @@
                (IO (Host _.Expression _.Statement))
                (io (: (Host _.Expression _.Statement)
                       (implementation
-                       (def: evaluate ..evaluate!)
+                       (def: (evaluate alias [_ input]) (..evaluate! alias input))
                        (def: execute ..execute!)
-                       (def: define ..define!)
+                       (def: (define context custom [_ input]) (..define! context custom input))
 
                        (def: (ingest context content)
                          (|> content (# utf8.codec decoded) try.trusted (:as _.Statement)))
@@ -586,19 +611,19 @@
   (do phase.monad
     []
     (in (:as phase.Wrapper
-             (for [ ... The implementation for @.old is technically incorrect.
+             (for [ ... The implementation for @.jvm is technically incorrect.
                    ... However, the JS compiler runs fast enough on Node to be fully hosted there.
                    ... And running the JS compiler on the JVM (on top of Nashorn) is impractically slow.
                    ... This means that in practice, only the @.js implementation matters.
                    ... And since no cross-language boundary needs to be handled, it's a correct implementation.
-                   @.old (|>>)
+                   @.jvm (|>>)
                    @.js (|>>)])))))
 
 (def: platform
   (IO (Platform [Register Text] _.Expression _.Statement))
   (do io.monad
     [host ..host]
-    (in [platform.#&file_system (for [@.old (file.async file.default)
+    (in [platform.#&file_system (for [@.jvm (file.async file.default)
                                       @.jvm (file.async file.default)
                                       ... TODO: Handle this in a safer manner.
                                       ... This would crash if the compiler was run on a browser.
@@ -626,7 +651,7 @@
                                                                                no_inputs)))
                             (_.string "")))))
 
-(for [@.old
+(for [@.jvm
       (def: (extender phase_wrapper)
         (-> phase.Wrapper Extender)
         ... TODO: Stop relying on coercions ASAP.
@@ -670,12 +695,17 @@
   (_.statement (_.apply/* (_.closure (list) body)
                           (list))))
 
+(def: (lux_compiler it)
+  (-> Any platform.Custom)
+  (undefined))
+
 (program: [service cli.service]
   (let [context (context.js (cli.target service))]
     (exec
       (do async.monad
         [platform (async.future ..platform)
-         _ (/.compiler context
+         _ (/.compiler ..lux_compiler
+                       context
                        ..expander
                        analysis.bundle
                        (io.io platform)