aboutsummaryrefslogtreecommitdiff
path: root/lux-js
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--lux-js/source/program.lux1145
1 files changed, 574 insertions, 571 deletions
diff --git a/lux-js/source/program.lux b/lux-js/source/program.lux
index b4b82d9ce..487415185 100644
--- a/lux-js/source/program.lux
+++ b/lux-js/source/program.lux
@@ -76,558 +76,561 @@
{.#None}
"???"))
-(for [@.jvm
- (as_is (import: java/lang/String)
-
- (import: (java/lang/Class a))
-
- (import: java/lang/Object
- ["[1]::[0]"
- (toString [] java/lang/String)
- (getClass [] (java/lang/Class java/lang/Object))])
-
- (import: java/lang/Long
- ["[1]::[0]"
- (intValue [] int)])
-
- (import: java/lang/Integer
- ["[1]::[0]"
- (longValue [] long)])
-
- (import: java/lang/Number
- ["[1]::[0]"
- (intValue [] int)
- (longValue [] long)
- (doubleValue [] double)])
-
- (import: java/util/Arrays
- ["[1]::[0]"
- ("static" [t] copyOfRange [[t] int int] [t])])
-
- (import: javax/script/ScriptEngine
- ["[1]::[0]"
- (eval [java/lang/String] "try" "?" java/lang/Object)])
-
- (import: javax/script/ScriptEngineFactory
- ["[1]::[0]"
- (getScriptEngine [] javax/script/ScriptEngine)])
-
- (import: org/openjdk/nashorn/api/scripting/NashornScriptEngineFactory
- ["[1]::[0]"
- (new [])])
-
- (import: org/openjdk/nashorn/api/scripting/JSObject
- ["[1]::[0]"
- (isArray [] boolean)
- (isFunction [] boolean)
- (getSlot [int] "?" java/lang/Object)
- (getMember [java/lang/String] "?" java/lang/Object)
- (hasMember [java/lang/String] boolean)
- (call ["?" java/lang/Object [java/lang/Object]] "try" java/lang/Object)])
-
- (import: org/openjdk/nashorn/api/scripting/AbstractJSObject)
-
- (import: org/openjdk/nashorn/api/scripting/ScriptObjectMirror
- ["[1]::[0]"
- (size [] int)
- (toString [] java/lang/String)
- (getOwnKeys [boolean] [java/lang/String])])
-
- (import: org/openjdk/nashorn/internal/runtime/Undefined)
-
- (template [<name>]
- [(ffi.interface: <name>
- (getValue [] java/lang/Object))
-
- (import: <name>
- ["[1]::[0]"
- (getValue [] java/lang/Object)])]
-
- [IntValue]
- [StructureValue]
- )
-
- (exception: (unknown_member [member Text
- object java/lang/Object])
- (exception.report
- ["Member" member]
- ["Object" (debug.inspection object)]))
-
- (def: jvm_int
- (-> (I64 Any) java/lang/Integer)
- (|>> .int
- ffi.as_long
- java/lang/Long::intValue))
-
- (def: (js_int value)
- (-> Int org/openjdk/nashorn/api/scripting/JSObject)
- (<| (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.: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.: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)
- (let [js_object (: (-> java/lang/Object org/openjdk/nashorn/api/scripting/JSObject)
- (function (_ sub_value)
- (<| (case (ffi.check [java/lang/Object] sub_value)
- {.#Some sub_value}
- (|> sub_value (:as (Array java/lang/Object)) js_structure)
-
- {.#None})
- (case (ffi.check java/lang/Long sub_value)
- {.#Some sub_value}
- (|> sub_value ffi.of_long js_int)
-
- {.#None})
- ... else
- (:as org/openjdk/nashorn/api/scripting/JSObject sub_value))))]
- (<| (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
- (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" (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)
- (array.list {.#None})
- (%.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 [(..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))
- (.nat low))))}
-
- _
- {.#None}))
-
- (def: (check_variant lux_object js_object)
- (-> (-> java/lang/Object (Try Any))
- org/openjdk/nashorn/api/scripting/ScriptObjectMirror
- (Maybe Any))
- (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) (lux_object value)]
- [{.#Some tag} {try.#Success value}]])
- {.#Some [(java/lang/Number::intValue (:as java/lang/Number tag))
- (maybe.else (ffi.null) ?flag)
- value]}
-
- _
- {.#None}))
-
- (def: (check_tuple lux_object js_object)
- (-> (-> java/lang/Object (Try Any))
- org/openjdk/nashorn/api/scripting/ScriptObjectMirror
- (Maybe (Array java/lang/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 (ffi.as_string (%.nat idx)) js_object)
- {.#Some member}
- (case (ffi.check org/openjdk/nashorn/internal/runtime/Undefined member)
- {.#Some _}
- (again (++ idx) output)
-
- {.#None}
- (case (lux_object member)
- {try.#Success parsed_member}
- (again (++ idx) (array.write! idx (:as java/lang/Object parsed_member) output))
-
- {try.#Failure error}
- {.#None}))
+(for @.jvm
+ (as_is (import: java/lang/String)
+
+ (import: (java/lang/Class a))
+
+ (import: java/lang/Object
+ ["[1]::[0]"
+ (toString [] java/lang/String)
+ (getClass [] (java/lang/Class java/lang/Object))])
+
+ (import: java/lang/Long
+ ["[1]::[0]"
+ (intValue [] int)])
+
+ (import: java/lang/Integer
+ ["[1]::[0]"
+ (longValue [] long)])
+
+ (import: java/lang/Number
+ ["[1]::[0]"
+ (intValue [] int)
+ (longValue [] long)
+ (doubleValue [] double)])
+
+ (import: java/util/Arrays
+ ["[1]::[0]"
+ ("static" [t] copyOfRange [[t] int int] [t])])
+
+ (import: javax/script/ScriptEngine
+ ["[1]::[0]"
+ (eval [java/lang/String] "try" "?" java/lang/Object)])
+
+ (import: javax/script/ScriptEngineFactory
+ ["[1]::[0]"
+ (getScriptEngine [] javax/script/ScriptEngine)])
+
+ (import: org/openjdk/nashorn/api/scripting/NashornScriptEngineFactory
+ ["[1]::[0]"
+ (new [])])
+
+ (import: org/openjdk/nashorn/api/scripting/JSObject
+ ["[1]::[0]"
+ (isArray [] boolean)
+ (isFunction [] boolean)
+ (getSlot [int] "?" java/lang/Object)
+ (getMember [java/lang/String] "?" java/lang/Object)
+ (hasMember [java/lang/String] boolean)
+ (call ["?" java/lang/Object [java/lang/Object]] "try" java/lang/Object)])
+
+ (import: org/openjdk/nashorn/api/scripting/AbstractJSObject)
+
+ (import: org/openjdk/nashorn/api/scripting/ScriptObjectMirror
+ ["[1]::[0]"
+ (size [] int)
+ (toString [] java/lang/String)
+ (getOwnKeys [boolean] [java/lang/String])])
+
+ (import: org/openjdk/nashorn/internal/runtime/Undefined)
+
+ (template [<name>]
+ [(ffi.interface: <name>
+ (getValue [] java/lang/Object))
+
+ (import: <name>
+ ["[1]::[0]"
+ (getValue [] java/lang/Object)])]
+
+ [IntValue]
+ [StructureValue]
+ )
+
+ (exception: (unknown_member [member Text
+ object java/lang/Object])
+ (exception.report
+ ["Member" member]
+ ["Object" (debug.inspection object)]))
+
+ (def: jvm_int
+ (-> (I64 Any) java/lang/Integer)
+ (|>> .int
+ ffi.as_long
+ java/lang/Long::intValue))
+
+ (def: (js_int value)
+ (-> Int org/openjdk/nashorn/api/scripting/JSObject)
+ (<| (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.: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.: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)
+ (let [js_object (: (-> java/lang/Object org/openjdk/nashorn/api/scripting/JSObject)
+ (function (_ sub_value)
+ (<| (case (ffi.check [java/lang/Object] sub_value)
+ {.#Some sub_value}
+ (|> sub_value (:as (Array java/lang/Object)) js_structure)
+
+ {.#None})
+ (case (ffi.check java/lang/Long sub_value)
+ {.#Some sub_value}
+ (|> sub_value ffi.of_long js_int)
+
+ {.#None})
+ ... else
+ (:as org/openjdk/nashorn/api/scripting/JSObject sub_value))))]
+ (<| (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
+ (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" (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)
+ (array.list {.#None})
+ (%.list (|>> ffi.of_string %.text)))
+
{.#None}
- (again (++ idx) output))
- {.#Some output})))
- {.#None}))
-
- (def: (lux_object js_object)
- (-> java/lang/Object (Try Any))
- (`` (<| (if (ffi.null? js_object)
- (exception.except ..null_has_no_lux_representation [{.#None}]))
- (case (ffi.check org/openjdk/nashorn/internal/runtime/Undefined js_object)
- {.#Some _}
- (exception.except ..undefined_has_no_lux_representation [])
-
- {.#None})
- (~~ (template [<class>]
- [(case (ffi.check <class> js_object)
- {.#Some js_object}
- {try.#Success js_object}
+ "???")]))
+
+ (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 [(..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))
+ (.nat low))))}
+
+ _
+ {.#None}))
+
+ (def: (check_variant lux_object js_object)
+ (-> (-> java/lang/Object (Try Any))
+ org/openjdk/nashorn/api/scripting/ScriptObjectMirror
+ (Maybe Any))
+ (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) (lux_object value)]
+ [{.#Some tag} {try.#Success value}]])
+ {.#Some [(java/lang/Number::intValue (:as java/lang/Number tag))
+ (maybe.else (ffi.null) ?flag)
+ value]}
+
+ _
+ {.#None}))
+
+ (def: (check_tuple lux_object js_object)
+ (-> (-> java/lang/Object (Try Any))
+ org/openjdk/nashorn/api/scripting/ScriptObjectMirror
+ (Maybe (Array java/lang/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 (ffi.as_string (%.nat idx)) js_object)
+ {.#Some member}
+ (case (ffi.check org/openjdk/nashorn/internal/runtime/Undefined member)
+ {.#Some _}
+ (again (++ idx) output)
+
+ {.#None}
+ (case (lux_object member)
+ {try.#Success parsed_member}
+ (again (++ idx) (array.write! idx (:as java/lang/Object parsed_member) output))
+
+ {try.#Failure error}
+ {.#None}))
- {.#None})]
-
- [java/lang/Boolean] [java/lang/String]))
- (~~ (template [<class> <method>]
- [(case (ffi.check <class> js_object)
- {.#Some js_object}
- {try.#Success (<method> js_object)}
-
- {.#None})]
-
- [java/lang/Number java/lang/Number::doubleValue]
- [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)
- {.#Some value}
- {try.#Success value}
-
- {.#None}
- (case (check_variant lux_object js_object)
- {.#Some value}
- {try.#Success value}
-
- {.#None}
- (case (check_tuple lux_object js_object)
- {.#Some value}
- {try.#Success value}
-
- {.#None}
- (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}
- ))))
- {.#None})
- ... else
- ... (exception.except ..unknown_kind_of_host_object [(:as java/lang/Object js_object)])
- {try.#Success js_object}
- )))
-
- (def: (ensure_function function)
- (-> Any (Maybe org/openjdk/nashorn/api/scripting/JSObject))
- (do maybe.monad
- [function (|> function
- (:as java/lang/Object)
- (ffi.check org/openjdk/nashorn/api/scripting/JSObject))]
- (if (ffi.of_boolean (org/openjdk/nashorn/api/scripting/JSObject::isFunction function))
- {.#Some function}
- {.#None})))
- )
-
- @.js
- (as_is)])
-
-(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)
- (|>> (:as (Array java/lang/Object)) js_structure (:as java/lang/Object)))]
- (<| (:as (Try (Try [Lux (List Code)])))
- (org/openjdk/nashorn/api/scripting/JSObject::call {.#None}
- (|> (array.empty 2)
- (: (Array java/lang/Object))
- (array.write! 0 (to_js inputs))
- (array.write! 1 (to_js lux)))
- macro))))
-
- (exception: (cannot_apply_a_non_function [object java/lang/Object])
- (exception.report
- ["Object" (ffi.of_string (java/lang/Object::toString object))]))
-
- (def: (expander macro inputs lux)
- Expander
- (case (..ensure_function macro)
- {.#Some macro}
- (case (call_macro inputs lux macro)
- {try.#Success output}
- (|> output
- (:as java/lang/Object)
- lux_object
- (:as (Try (Try [Lux (List Code)]))))
-
- {try.#Failure error}
- {try.#Failure error})
-
- {.#None}
- (exception.except ..cannot_apply_a_non_function (:as java/lang/Object macro))))
- )
-
- @.js
- (def: (expander macro inputs lux)
- Expander
- {try.#Success ((:as Macro' macro) inputs lux)})
- ])
-
-(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 (ffi.as_string (_.code input)) interpreter)]
- (case ?output
- {.#Some output}
- (..lux_object output)
-
- {.#None}
- (exception.except ..null_has_no_lux_representation [{.#Some input}]))))
-
- (def: (execute! interpreter input)
- (-> javax/script/ScriptEngine _.Statement (Try Any))
- (do try.monad
- [?output (javax/script/ScriptEngine::eval (ffi.as_string (_.code input)) interpreter)]
- (in [])))
-
- (def: (define! interpreter context custom input)
- (-> javax/script/ScriptEngine unit.ID (Maybe Text) _.Expression (Try [Text Any _.Statement]))
- (let [global (maybe.else (reference.artifact context)
- custom)
- @global (_.var global)]
- (do try.monad
- [.let [definition (_.define @global input)]
- _ (execute! interpreter definition)
- value (evaluate! interpreter context @global)]
- (in [global value definition]))))
-
- (def: host
- (IO (Host _.Expression _.Statement))
- (io (let [interpreter (javax/script/ScriptEngineFactory::getScriptEngine
- (org/openjdk/nashorn/api/scripting/NashornScriptEngineFactory::new))]
- (: (Host _.Expression _.Statement)
- (implementation
- (def: (evaluate alias [_ input]) (..evaluate! interpreter alias input))
- (def: execute (..execute! interpreter))
- (def: (define context custom [_ input]) (..define! interpreter context custom input))
-
- (def: (ingest context content)
- (|> content (# utf8.codec decoded) try.trusted (:as _.Statement)))
-
- (def: (re_learn context custom content)
- (..execute! interpreter content))
-
- (def: (re_load context custom content)
- (do try.monad
- [_ (..execute! interpreter content)]
- (..evaluate! interpreter context (_.var (reference.artifact context))))))))))
- )
-
- @.js
- (as_is (def: (eval code)
- (-> Text (Try (Maybe Any)))
- ... Note: I have to call "eval" this way
- ... in order to avoid a quirk of calling eval in Node
- ... when the code is running under "use strict";.
- (try (let [return ("js apply" (function.identity ("js constant" "eval")) [code])]
- (if ("js object null?" return)
{.#None}
- {.#Some return}))))
-
- (def: (evaluate! alias input)
- (-> unit.ID _.Expression (Try Any))
- (do try.monad
- [?output (..eval (_.code input))]
- (case ?output
- {.#Some output}
- (in output)
-
- {.#None}
- (exception.except ..null_has_no_lux_representation [{.#Some input}]))))
-
- (def: (execute! input)
- (-> _.Statement (Try Any))
- (do try.monad
- [?output (..eval (_.code input))]
- (in [])))
-
- (def: (define! context custom input)
- (-> unit.ID (Maybe Text) _.Expression (Try [Text Any _.Statement]))
- (let [global (maybe.else (reference.artifact context)
- custom)
- @global (_.var global)]
- (do try.monad
- [.let [definition (_.define @global input)]
- _ (..execute! definition)
- value (..evaluate! context @global)]
- (in [global value definition]))))
-
- (def: host
- (IO (Host _.Expression _.Statement))
- (io (: (Host _.Expression _.Statement)
- (implementation
- (def: (evaluate alias [_ input]) (..evaluate! alias input))
- (def: execute ..execute!)
- (def: (define context custom [_ input]) (..define! context custom input))
-
- (def: (ingest context content)
- (|> content (# utf8.codec decoded) try.trusted (:as _.Statement)))
-
- (def: (re_learn context custom content)
- (..execute! content))
-
- (def: (re_load context custom content)
- (do try.monad
- [_ (..execute! content)]
- (..evaluate! context (_.var (reference.artifact context)))))))))
- )])
+ (again (++ idx) output))
+ {.#Some output})))
+ {.#None}))
+
+ (def: (lux_object js_object)
+ (-> java/lang/Object (Try Any))
+ (`` (<| (if (ffi.null? js_object)
+ (exception.except ..null_has_no_lux_representation [{.#None}]))
+ (case (ffi.check org/openjdk/nashorn/internal/runtime/Undefined js_object)
+ {.#Some _}
+ (exception.except ..undefined_has_no_lux_representation [])
+
+ {.#None})
+ (~~ (template [<class>]
+ [(case (ffi.check <class> js_object)
+ {.#Some js_object}
+ {try.#Success js_object}
+
+ {.#None})]
+
+ [java/lang/Boolean] [java/lang/String]))
+ (~~ (template [<class> <method>]
+ [(case (ffi.check <class> js_object)
+ {.#Some js_object}
+ {try.#Success (<method> js_object)}
+
+ {.#None})]
+
+ [java/lang/Number java/lang/Number::doubleValue]
+ [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)
+ {.#Some value}
+ {try.#Success value}
+
+ {.#None}
+ (case (check_variant lux_object js_object)
+ {.#Some value}
+ {try.#Success value}
+
+ {.#None}
+ (case (check_tuple lux_object js_object)
+ {.#Some value}
+ {try.#Success value}
+
+ {.#None}
+ (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}
+ ))))
+ {.#None})
+ ... else
+ ... (exception.except ..unknown_kind_of_host_object [(:as java/lang/Object js_object)])
+ {try.#Success js_object}
+ )))
+
+ (def: (ensure_function function)
+ (-> Any (Maybe org/openjdk/nashorn/api/scripting/JSObject))
+ (do maybe.monad
+ [function (|> function
+ (:as java/lang/Object)
+ (ffi.check org/openjdk/nashorn/api/scripting/JSObject))]
+ (if (ffi.of_boolean (org/openjdk/nashorn/api/scripting/JSObject::isFunction function))
+ {.#Some function}
+ {.#None})))
+ )
+
+ @.js
+ (as_is))
+
+(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)
+ (|>> (:as (Array java/lang/Object)) js_structure (:as java/lang/Object)))]
+ (<| (:as (Try (Try [Lux (List Code)])))
+ (org/openjdk/nashorn/api/scripting/JSObject::call {.#None}
+ (|> (array.empty 2)
+ (: (Array java/lang/Object))
+ (array.write! 0 (to_js inputs))
+ (array.write! 1 (to_js lux)))
+ macro))))
+
+ (exception: (cannot_apply_a_non_function [object java/lang/Object])
+ (exception.report
+ ["Object" (ffi.of_string (java/lang/Object::toString object))]))
+
+ (def: (expander macro inputs lux)
+ Expander
+ (case (..ensure_function macro)
+ {.#Some macro}
+ (case (call_macro inputs lux macro)
+ {try.#Success output}
+ (|> output
+ (:as java/lang/Object)
+ lux_object
+ (:as (Try (Try [Lux (List Code)]))))
+
+ {try.#Failure error}
+ {try.#Failure error})
+
+ {.#None}
+ (exception.except ..cannot_apply_a_non_function (:as java/lang/Object macro))))
+ )
+
+ @.js
+ (def: (expander macro inputs lux)
+ Expander
+ {try.#Success ((:as Macro' macro) inputs lux)})
+ )
+
+(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 (ffi.as_string (_.code input)) interpreter)]
+ (case ?output
+ {.#Some output}
+ (..lux_object output)
+
+ {.#None}
+ (exception.except ..null_has_no_lux_representation [{.#Some input}]))))
+
+ (def: (execute! interpreter input)
+ (-> javax/script/ScriptEngine _.Statement (Try Any))
+ (do try.monad
+ [?output (javax/script/ScriptEngine::eval (ffi.as_string (_.code input)) interpreter)]
+ (in [])))
+
+ (def: (define! interpreter context custom input)
+ (-> javax/script/ScriptEngine unit.ID (Maybe Text) _.Expression (Try [Text Any _.Statement]))
+ (let [global (maybe.else (reference.artifact context)
+ custom)
+ @global (_.var global)]
+ (do try.monad
+ [.let [definition (_.define @global input)]
+ _ (execute! interpreter definition)
+ value (evaluate! interpreter context @global)]
+ (in [global value definition]))))
+
+ (def: host
+ (IO (Host _.Expression _.Statement))
+ (io (let [interpreter (javax/script/ScriptEngineFactory::getScriptEngine
+ (org/openjdk/nashorn/api/scripting/NashornScriptEngineFactory::new))]
+ (: (Host _.Expression _.Statement)
+ (implementation
+ (def: (evaluate alias [_ input]) (..evaluate! interpreter alias input))
+ (def: execute (..execute! interpreter))
+ (def: (define context custom [_ input]) (..define! interpreter context custom input))
+
+ (def: (ingest context content)
+ (|> content (# utf8.codec decoded) try.trusted (:as _.Statement)))
+
+ (def: (re_learn context custom content)
+ (..execute! interpreter content))
+
+ (def: (re_load context custom content)
+ (do try.monad
+ [_ (..execute! interpreter content)]
+ (..evaluate! interpreter context (_.var (reference.artifact context))))))))))
+ )
+
+ @.js
+ (as_is (def: (eval code)
+ (-> Text (Try (Maybe Any)))
+ ... Note: I have to call "eval" this way
+ ... in order to avoid a quirk of calling eval in Node
+ ... when the code is running under "use strict";.
+ (try (let [return ("js apply" (function.identity ("js constant" "eval")) [code])]
+ (if ("js object null?" return)
+ {.#None}
+ {.#Some return}))))
+
+ (def: (evaluate! alias input)
+ (-> unit.ID _.Expression (Try Any))
+ (do try.monad
+ [?output (..eval (_.code input))]
+ (case ?output
+ {.#Some output}
+ (in output)
+
+ {.#None}
+ (exception.except ..null_has_no_lux_representation [{.#Some input}]))))
+
+ (def: (execute! input)
+ (-> _.Statement (Try Any))
+ (do try.monad
+ [?output (..eval (_.code input))]
+ (in [])))
+
+ (def: (define! context custom input)
+ (-> unit.ID (Maybe Text) _.Expression (Try [Text Any _.Statement]))
+ (let [global (maybe.else (reference.artifact context)
+ custom)
+ @global (_.var global)]
+ (do try.monad
+ [.let [definition (_.define @global input)]
+ _ (..execute! definition)
+ value (..evaluate! context @global)]
+ (in [global value definition]))))
+
+ (def: host
+ (IO (Host _.Expression _.Statement))
+ (io (: (Host _.Expression _.Statement)
+ (implementation
+ (def: (evaluate alias [_ input]) (..evaluate! alias input))
+ (def: execute ..execute!)
+ (def: (define context custom [_ input]) (..define! context custom input))
+
+ (def: (ingest context content)
+ (|> content (# utf8.codec decoded) try.trusted (:as _.Statement)))
+
+ (def: (re_learn context custom content)
+ (..execute! content))
+
+ (def: (re_load context custom content)
+ (do try.monad
+ [_ (..execute! content)]
+ (..evaluate! context (_.var (reference.artifact context)))))))))
+ ))
(def: (phase_wrapper archive)
(-> Archive (runtime.Operation phase.Wrapper))
(do phase.monad
[]
(in (:as phase.Wrapper
- (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.
- @.jvm (|>>)
- @.js (|>>)])))))
+ (for @.jvm
+ ... 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.
+ (|>>)
+
+ @.js
+ (|>>))))))
(def: platform
(IO (Platform [Register Text] _.Expression _.Statement))
(do io.monad
[host ..host]
- (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.
- @.js (maybe.trusted 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.
+ @.js (maybe.trusted file.default))
platform.#host host
platform.#phase js.generate
platform.#runtime runtime.generate
@@ -651,40 +654,40 @@
no_inputs)))
(_.string "")))))
-(for [@.jvm
- (def: (extender phase_wrapper)
- (-> phase.Wrapper Extender)
- ... TODO: Stop relying on coercions ASAP.
- (<| (:as Extender)
- (function (@self handler))
- (:as Handler)
- (function (@self name phase))
- (:as Phase)
- (function (@self archive parameters))
- (:as Operation)
- (function (@self state))
- (:as Try)
- try.trusted
- (:as Try)
- (do try.monad
- [handler (try.of_maybe (..ensure_function handler))
- .let [to_js (: (-> Any java/lang/Object)
- (|>> (:as (Array java/lang/Object)) js_structure (:as java/lang/Object)))]
- output (org/openjdk/nashorn/api/scripting/JSObject::call {.#None}
- (|> (array.empty 5)
- (: (Array java/lang/Object))
- (array.write! 0 name)
- (array.write! 1 (:as java/lang/Object (extender phase)))
- (array.write! 2 (to_js archive))
- (array.write! 3 (to_js parameters))
- (array.write! 4 (to_js state)))
- handler)]
- (lux_object (:as java/lang/Object output)))))
-
- @.js
- (def: (extender phase_wrapper handler)
- (-> phase.Wrapper Extender)
- (:expected handler))])
+(for @.jvm
+ (def: (extender phase_wrapper)
+ (-> phase.Wrapper Extender)
+ ... TODO: Stop relying on coercions ASAP.
+ (<| (:as Extender)
+ (function (@self handler))
+ (:as Handler)
+ (function (@self name phase))
+ (:as Phase)
+ (function (@self archive parameters))
+ (:as Operation)
+ (function (@self state))
+ (:as Try)
+ try.trusted
+ (:as Try)
+ (do try.monad
+ [handler (try.of_maybe (..ensure_function handler))
+ .let [to_js (: (-> Any java/lang/Object)
+ (|>> (:as (Array java/lang/Object)) js_structure (:as java/lang/Object)))]
+ output (org/openjdk/nashorn/api/scripting/JSObject::call {.#None}
+ (|> (array.empty 5)
+ (: (Array java/lang/Object))
+ (array.write! 0 name)
+ (array.write! 1 (:as java/lang/Object (extender phase)))
+ (array.write! 2 (to_js archive))
+ (array.write! 3 (to_js parameters))
+ (array.write! 4 (to_js state)))
+ handler)]
+ (lux_object (:as java/lang/Object output)))))
+
+ @.js
+ (def: (extender phase_wrapper handler)
+ (-> phase.Wrapper Extender)
+ (:expected handler)))
(def: (declare_success! _)
(-> Any (Async Any))