(.using [library [lux "*" [program {"+" program:}] ["[0]" ffi {"+" import:}] ["[0]" debug] [abstract [monad {"+" do}]] [control ["[0]" maybe ("[1]#[0]" monad)] ["[0]" try {"+" Try}] ["[0]" exception {"+" exception:}] ["[0]" io {"+" IO io}] ["[0]" function] [concurrency ["[0]" async {"+" Async}]]] [data ["[0]" product] [text ["%" format {"+" format}] [encoding ["[0]" utf8]]] [collection ["[0]" array {"+" Array}]]] [macro ["[0]" template]] [math [number ["n" nat] ["i" int] ["[0]" i64]]] ["[0]" world "_" ["[0]" file] ["[1]/[0]" program]] ["@" target ["_" js]] [tool [compiler ["[0]" phase {"+" Operation Phase}] [reference [variable {"+" Register}]] [language [lux [program {"+" Program}] [generation {"+" Host}] [analysis [macro {"+" Expander}]] [phase ["[0]" extension {"+" Extender Handler} ["[1]/[0]" bundle] ["[0]" analysis "_" ["[1]" js]] ["[0]" generation "_" ["[1]" js]]] [generation ["[0]" reference] ["[0]" js ["[0]" runtime]]]]]] [default ["[0]" platform {"+" Platform}]] [meta ["[0]" cli] ["[0]" context] [archive {"+" Archive} ["[0]" unit]] ["[0]" packager "_" ["[1]" script]]]]]]] [program ["/" compositor]]) (exception: (null_has_no_lux_representation [code (Maybe _.Expression)]) (case code {.#Some code} (_.code code) {.#None} "???")) (for @.jvm (as_is (import: java/lang/String "[1]::[0]") (import: (java/lang/Class a) "[1]::[0]") (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 "[1]::[0]") (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 "[1]::[0]") (template [] [(ffi.interface: (getValue [] java/lang/Object)) (import: "[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})) {.#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 [] [(case (ffi.check js_object) {.#Some js_object} {try.#Success js_object} {.#None})] [java/lang/Boolean] [java/lang/String])) (~~ (template [ ] [(case (ffi.check js_object) {.#Some js_object} {try.#Success ( 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 @.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)) platform.#host host platform.#phase js.generate platform.#runtime runtime.generate platform.#phase_wrapper ..phase_wrapper platform.#write (|>> _.code (# utf8.codec encoded))]))) (def: (program context program) (Program _.Expression _.Statement) (let [@process (_.var "process") on_node_js? (|> @process _.type_of (_.= (_.string "undefined")) _.not (_.and (_.the "argv" @process))) node_js_inputs (|> @process (_.the "argv") (_.do "slice" (list (_.int +2)))) no_inputs (_.array (list))] (_.statement (_.apply/1 (_.apply/1 program (runtime.lux//program_args (_.? on_node_js? node_js_inputs 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))) (def: (declare_success! _) (-> Any (Async Any)) (async.future (# world/program.default exit +0))) (def: (scope body) (-> _.Statement _.Statement) (_.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 ..lux_compiler context ..expander analysis.bundle (io.io platform) generation.bundle (function.constant extension/bundle.empty) ..program [(And Register Text) _.Expression _.Statement] ..extender service [(packager.package _.use_strict _.code _.then ..scope) (format (cli.target service) (# (the platform.#&file_system platform) separator) "program" (the context.#artifact_extension context))])] (..declare_success! [])) (io.io []))))