diff options
Diffstat (limited to 'lux-js')
| -rw-r--r-- | lux-js/source/program.lux | 1145 |
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)) |