From 80c727065593a4cadcb1d72c38c8ad5c3bf85acc Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 16 Jul 2020 23:19:57 -0400 Subject: Can get the JS compiler to compile its own source-code. --- commands.md | 5 + lux-js/source/program.lux | 928 +++++++++++---------- stdlib/source/lux/host.js.lux | 34 +- .../lux/phase/extension/generation/js/common.lux | 45 +- .../tool/compiler/language/lux/phase/synthesis.lux | 3 +- .../lux/tool/compiler/meta/packager/script.lux | 33 +- stdlib/source/lux/world/file.lux | 2 +- stdlib/source/program/compositor.lux | 45 +- 8 files changed, 599 insertions(+), 496 deletions(-) diff --git a/commands.md b/commands.md index 2c2e6b4e8..a0dae0ac4 100644 --- a/commands.md +++ b/commands.md @@ -182,7 +182,12 @@ cd ~/lux/lux-js/ && lein clean && lein lux auto build ``` cd ~/lux/stdlib/ && lein clean && cd ~/lux/lux-js/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux +cd ~/lux/stdlib/target/ && node program.js + +cd ~/lux/lux-js/ && time java -jar program.jar build --source ~/lux/lux-js/source --target ~/lux/lux-js/target --module program +cd ~/lux/lux-js/target/ && node program.js +cd ~/lux/stdlib/ && lein clean && cd ~/lux/lux-js/ && node program.js build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux cd ~/lux/stdlib/target/ && node program.js ``` diff --git a/lux-js/source/program.lux b/lux-js/source/program.lux index 18b31c415..14e3b812e 100644 --- a/lux-js/source/program.lux +++ b/lux-js/source/program.lux @@ -1,6 +1,6 @@ (.module: [lux #* - ["." host (#+ import: interface: do-to object)] + ["." host (#+ import:)] ["." debug] [abstract [monad (#+ do)]] @@ -62,186 +62,6 @@ ["/." cli] ["/." static]]]) -(import: #long java/lang/String) - -(import: #long (java/lang/Class a)) - -(import: #long java/lang/Object - (toString [] java/lang/String) - (getClass [] (java/lang/Class java/lang/Object))) - -(import: #long java/lang/Long - (intValue [] java/lang/Integer)) - -(import: #long java/lang/Integer - (longValue [] long)) - -(import: #long java/lang/Number - (intValue [] java/lang/Integer) - (longValue [] long) - (doubleValue [] double)) - -(import: #long java/util/Arrays - (#static [t] copyOfRange [[t] int int] [t])) - -(import: #long javax/script/ScriptEngine - (eval [java/lang/String] #try #? java/lang/Object)) - -(import: #long javax/script/ScriptEngineFactory - (getScriptEngine [] javax/script/ScriptEngine)) - -(import: #long jdk/nashorn/api/scripting/NashornScriptEngineFactory - (new [])) - -(import: #long jdk/nashorn/api/scripting/JSObject - (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: #long jdk/nashorn/api/scripting/AbstractJSObject) - -(import: #long jdk/nashorn/api/scripting/ScriptObjectMirror - (size [] int) - (toString [] java/lang/String)) - -(import: #long jdk/nashorn/internal/runtime/Undefined) - -(template [] - [(interface: - (getValue [] java/lang/Object)) - - (`` (import: (~~ (template.identifier ["program/" ])) - (getValue [] java/lang/Object)))] - - [IntValue] - [StructureValue] - ) - -(exception: (unknown-member {member Text} - {object java/lang/Object}) - (exception.report - ["Member" member] - ["Object" (debug.inspect object)])) - -(def: jvm-int - (-> (I64 Any) java/lang/Integer) - (|>> (:coerce java/lang/Long) java/lang/Long::intValue)) - -(def: (js-int value) - (-> Int jdk/nashorn/api/scripting/JSObject) - (object [] jdk/nashorn/api/scripting/AbstractJSObject [program/IntValue] - [] - ## Methods - (program/IntValue - [] (getValue self) java/lang/Object - (:coerce java/lang/Object value)) - (jdk/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) - - _ - (error! (exception.construct ..unknown-member [member (:coerce java/lang/Object value)])))) - )) - -(def: (::toString js-object) - (-> Any jdk/nashorn/api/scripting/JSObject) - (object [] jdk/nashorn/api/scripting/AbstractJSObject [] - [] - (jdk/nashorn/api/scripting/AbstractJSObject - [] (isFunction self) boolean - #1) - (jdk/nashorn/api/scripting/AbstractJSObject - [] (call self {this java/lang/Object} {args [java/lang/Object]}) java/lang/Object - (debug.inspect js-object)) - )) - -(def: (::slice js-object value) - (-> (-> java/lang/Object jdk/nashorn/api/scripting/JSObject) (Array java/lang/Object) jdk/nashorn/api/scripting/JSObject) - (object [] jdk/nashorn/api/scripting/AbstractJSObject [] - [] - (jdk/nashorn/api/scripting/AbstractJSObject - [] (isFunction self) boolean - #1) - (jdk/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.assume (:coerce Int)) - (.int (array.size value))) - js-object - (:coerce java/lang/Object))) - )) - -(def: (js-structure value) - (-> (Array java/lang/Object) jdk/nashorn/api/scripting/JSObject) - (let [js-object (: (-> java/lang/Object jdk/nashorn/api/scripting/JSObject) - (function (_ sub-value) - (<| (case (host.check [java/lang/Object] sub-value) - (#.Some sub-value) - (|> sub-value (:coerce (Array java/lang/Object)) js-structure) - #.None) - (case (host.check java/lang/Long sub-value) - (#.Some sub-value) - (|> sub-value (:coerce Int) js-int) - #.None) - ## else - (:coerce jdk/nashorn/api/scripting/JSObject sub-value))))] - (object [] jdk/nashorn/api/scripting/AbstractJSObject [program/StructureValue] - [] - ## Methods - (program/StructureValue - [] (getValue self) java/lang/Object - (:coerce (Array java/lang/Object) value)) - (jdk/nashorn/api/scripting/AbstractJSObject - [] (isArray self) boolean - #1) - (jdk/nashorn/api/scripting/AbstractJSObject - [] (getMember self {member java/lang/String}) java/lang/Object - (case member - (^or "toJSON" "toString") - (:coerce java/lang/Object - (::toString value)) - - "length" - (jvm-int (array.size value)) - - "slice" - (:coerce java/lang/Object - (::slice js-object value)) - - (^ (static runtime.variant-tag-field)) - (|> value (array.read 0) maybe.assume) - - (^ (static runtime.variant-flag-field)) - (case (array.read 1 value) - (#.Some set!) - set! - - _ - (host.null)) - - (^ (static runtime.variant-value-field)) - (|> value (array.read 2) maybe.assume js-object (:coerce java/lang/Object)) - - _ - (error! (exception.construct ..unknown-member [(:coerce Text member) (:coerce java/lang/Object value)]))) - ) - (jdk/nashorn/api/scripting/AbstractJSObject - [] (getSlot self {idx int}) java/lang/Object - (|> value - (array.read (|> idx java/lang/Integer::longValue (:coerce Nat))) - maybe.assume - js-object - (:coerce java/lang/Object))) - ))) - (exception: (null-has-no-lux-representation {code (Maybe _.Expression)}) (case code (#.Some code) @@ -250,219 +70,465 @@ #.None "???")) -(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)])) - -(exception: (cannot-apply-a-non-function {object java/lang/Object}) - (exception.report - ["Object" (java/lang/Object::toString object)])) - -(def: (check-int js-object) - (-> jdk/nashorn/api/scripting/ScriptObjectMirror - (Maybe Int)) - (case [(jdk/nashorn/api/scripting/JSObject::getMember [runtime.i64-high-field] js-object) - (jdk/nashorn/api/scripting/JSObject::getMember [runtime.i64-low-field] js-object)] - (^multi [(#.Some high) (#.Some low)] - [[(host.check java/lang/Number high) - (host.check java/lang/Number low)] - [(#.Some high) (#.Some low)]] - [[(java/lang/Number::longValue high) - (java/lang/Number::longValue low)] - [high low]]) - (#.Some (.int (n.+ (|> high .nat (i64.left-shift 32)) - (if (i.< +0 (.int low)) - (|> low .nat (i64.left-shift 32) (i64.logic-right-shift 32)) - (.nat low))))) - - _ - #.None)) - -(def: (check-variant lux-object js-object) - (-> (-> java/lang/Object (Try Any)) - jdk/nashorn/api/scripting/ScriptObjectMirror - (Maybe Any)) - (case [(jdk/nashorn/api/scripting/JSObject::getMember [runtime.variant-tag-field] js-object) - (jdk/nashorn/api/scripting/JSObject::getMember [runtime.variant-flag-field] js-object) - (jdk/nashorn/api/scripting/JSObject::getMember [runtime.variant-value-field] js-object)] - (^multi [(#.Some tag) ?flag (#.Some value)] - [(host.check java/lang/Number tag) - (#.Some tag)] - [(lux-object value) - (#.Some value)]) - (#.Some [(java/lang/Number::intValue tag) - (maybe.default (host.null) ?flag) - value]) - - _ - #.None)) - -(def: (check-array lux-object js-object) - (-> (-> java/lang/Object (Try Any)) - jdk/nashorn/api/scripting/ScriptObjectMirror - (Maybe (Array java/lang/Object))) - (if (jdk/nashorn/api/scripting/JSObject::isArray js-object) - (let [num-keys (.nat (jdk/nashorn/api/scripting/ScriptObjectMirror::size js-object))] - (loop [idx 0 - output (: (Array java/lang/Object) - (array.new num-keys))] - (if (n.< num-keys idx) - (case (jdk/nashorn/api/scripting/JSObject::getMember (%.nat idx) js-object) - (#.Some member) - (case (host.check jdk/nashorn/internal/runtime/Undefined member) - (#.Some _) - (recur (inc idx) output) - - #.None - (case (lux-object member) - (#try.Success parsed-member) - (recur (inc idx) (array.write idx (:coerce java/lang/Object parsed-member) output)) - - (#try.Failure error) - #.None)) - - #.None - (recur (inc idx) output)) - (#.Some output)))) - #.None)) - -(def: (lux-object js-object) - (-> java/lang/Object (Try Any)) - (`` (<| (if (host.null? js-object) - (exception.throw ..null-has-no-lux-representation [#.None])) - (case (host.check jdk/nashorn/internal/runtime/Undefined js-object) - (#.Some _) - (exception.throw ..undefined-has-no-lux-representation []) - #.None) - (~~ (template [] - [(case (host.check js-object) - (#.Some js-object) - (exception.return js-object) - #.None)] - - [java/lang/Boolean] [java/lang/String])) - (~~ (template [ ] - [(case (host.check js-object) - (#.Some js-object) - (exception.return ( js-object)) - #.None)] - - [java/lang/Number java/lang/Number::doubleValue] - [StructureValue StructureValue::getValue] - [IntValue IntValue::getValue])) - (case (host.check jdk/nashorn/api/scripting/ScriptObjectMirror js-object) - (#.Some js-object) - (case (check-int js-object) - (#.Some value) - (exception.return value) - - #.None - (case (check-variant lux-object js-object) - (#.Some value) - (exception.return value) - - #.None - (case (check-array lux-object js-object) - (#.Some value) - (exception.return value) - - #.None - (if (jdk/nashorn/api/scripting/JSObject::isFunction js-object) - (exception.return js-object) - (exception.throw ..unknown-kind-of-host-object (:coerce java/lang/Object js-object)))))) - #.None) - ## else - (exception.throw ..unknown-kind-of-host-object (:coerce java/lang/Object js-object)) - ))) - -(def: (ensure-macro macro) - (-> Macro (Maybe jdk/nashorn/api/scripting/JSObject)) - (let [macro (:coerce java/lang/Object macro)] - (do maybe.monad - [macro (host.check jdk/nashorn/api/scripting/JSObject macro)] - (if (jdk/nashorn/api/scripting/JSObject::isFunction macro) - (#.Some macro) - #.None)))) - -(def: (call-macro inputs lux macro) - (-> (List Code) Lux jdk/nashorn/api/scripting/JSObject (Try (Try [Lux (List Code)]))) - (let [to-js (: (-> Any java/lang/Object) - (|>> (:coerce (Array java/lang/Object)) js-structure (:coerce java/lang/Object)))] - (<| (:coerce (Try (Try [Lux (List Code)]))) - (jdk/nashorn/api/scripting/JSObject::call #.None - (|> (array.new 2) - (: (Array java/lang/Object)) - (array.write 0 (to-js inputs)) - (array.write 1 (to-js lux))) - macro)))) - -(def: (expander macro inputs lux) - Expander - (case (..ensure-macro macro) - (#.Some macro) - (case (call-macro inputs lux macro) - (#try.Success output) - (|> output - (:coerce java/lang/Object) - lux-object - (:coerce (Try (Try [Lux (List Code)])))) - - (#try.Failure error) - (#try.Failure error)) - - #.None - (exception.throw ..cannot-apply-a-non-function (:coerce java/lang/Object macro)))) - -(def: (evaluate! interpreter alias input) - (-> javax/script/ScriptEngine Text _.Expression (Try Any)) - (do try.monad - [?output (javax/script/ScriptEngine::eval (_.code input) interpreter)] - (case ?output - (#.Some output) - (..lux-object output) - - #.None - (exception.throw ..null-has-no-lux-representation [(#.Some input)])))) - -(def: (execute! interpreter alias input) - (-> javax/script/ScriptEngine Text _.Statement (Try Any)) - (do try.monad - [?output (javax/script/ScriptEngine::eval (_.code input) interpreter)] - (wrap []))) - -(def: (define! interpreter context input) - (-> javax/script/ScriptEngine Context _.Expression (Try [Text Any _.Statement])) - (let [global (reference.artifact context) - @global (_.var global)] - (do try.monad - [#let [definition (_.define @global input)] - _ (execute! interpreter global definition) - value (evaluate! interpreter global @global)] - (wrap [global value definition])))) - -(def: host - (IO (Host _.Expression _.Statement)) - (io (let [interpreter (javax/script/ScriptEngineFactory::getScriptEngine - (jdk/nashorn/api/scripting/NashornScriptEngineFactory::new))] - (: (Host _.Expression _.Statement) - (structure - (def: evaluate! (..evaluate! interpreter)) - (def: execute! (..execute! interpreter)) - (def: define! (..define! interpreter)) - - (def: (ingest context content) - (|> content encoding.from-utf8 try.assume (:coerce _.Statement))) - - (def: (re-learn context content) - (..execute! interpreter (reference.artifact context) content)) - - (def: (re-load context content) - (do try.monad - [_ (..execute! interpreter "" content)] - (..evaluate! interpreter "" (_.var (reference.artifact context)))))))))) +(for {@.old + (as-is (import: #long java/lang/String) + + (import: #long (java/lang/Class a)) + + (import: #long java/lang/Object + (toString [] java/lang/String) + (getClass [] (java/lang/Class java/lang/Object))) + + (import: #long java/lang/Long + (intValue [] java/lang/Integer)) + + (import: #long java/lang/Integer + (longValue [] long)) + + (import: #long java/lang/Number + (intValue [] java/lang/Integer) + (longValue [] long) + (doubleValue [] double)) + + (import: #long java/util/Arrays + (#static [t] copyOfRange [[t] int int] [t])) + + (import: #long javax/script/ScriptEngine + (eval [java/lang/String] #try #? java/lang/Object)) + + (import: #long javax/script/ScriptEngineFactory + (getScriptEngine [] javax/script/ScriptEngine)) + + (import: #long jdk/nashorn/api/scripting/NashornScriptEngineFactory + (new [])) + + (import: #long jdk/nashorn/api/scripting/JSObject + (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: #long jdk/nashorn/api/scripting/AbstractJSObject) + + (import: #long jdk/nashorn/api/scripting/ScriptObjectMirror + (size [] int) + (toString [] java/lang/String)) + + (import: #long jdk/nashorn/internal/runtime/Undefined) + + (template [] + [(host.interface: + (getValue [] java/lang/Object)) + + (`` (import: (~~ (template.identifier ["program/" ])) + (getValue [] java/lang/Object)))] + + [IntValue] + [StructureValue] + ) + + (exception: (unknown-member {member Text} + {object java/lang/Object}) + (exception.report + ["Member" member] + ["Object" (debug.inspect object)])) + + (def: jvm-int + (-> (I64 Any) java/lang/Integer) + (|>> (:coerce java/lang/Long) java/lang/Long::intValue)) + + (def: (js-int value) + (-> Int jdk/nashorn/api/scripting/JSObject) + (host.object [] jdk/nashorn/api/scripting/AbstractJSObject [program/IntValue] + [] + ## Methods + (program/IntValue + [] (getValue self) java/lang/Object + (:coerce java/lang/Object value)) + (jdk/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) + + _ + (error! (exception.construct ..unknown-member [member (:coerce java/lang/Object value)])))) + )) + + (def: (::toString js-object) + (-> Any jdk/nashorn/api/scripting/JSObject) + (host.object [] jdk/nashorn/api/scripting/AbstractJSObject [] + [] + (jdk/nashorn/api/scripting/AbstractJSObject + [] (isFunction self) boolean + #1) + (jdk/nashorn/api/scripting/AbstractJSObject + [] (call self {this java/lang/Object} {args [java/lang/Object]}) java/lang/Object + (debug.inspect js-object)) + )) + + (def: (::slice js-object value) + (-> (-> java/lang/Object jdk/nashorn/api/scripting/JSObject) (Array java/lang/Object) jdk/nashorn/api/scripting/JSObject) + (host.object [] jdk/nashorn/api/scripting/AbstractJSObject [] + [] + (jdk/nashorn/api/scripting/AbstractJSObject + [] (isFunction self) boolean + #1) + (jdk/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.assume (:coerce Int)) + (.int (array.size value))) + js-object + (:coerce java/lang/Object))) + )) + + (def: (js-structure value) + (-> (Array java/lang/Object) jdk/nashorn/api/scripting/JSObject) + (let [js-object (: (-> java/lang/Object jdk/nashorn/api/scripting/JSObject) + (function (_ sub-value) + (<| (case (host.check [java/lang/Object] sub-value) + (#.Some sub-value) + (|> sub-value (:coerce (Array java/lang/Object)) js-structure) + #.None) + (case (host.check java/lang/Long sub-value) + (#.Some sub-value) + (|> sub-value (:coerce Int) js-int) + #.None) + ## else + (:coerce jdk/nashorn/api/scripting/JSObject sub-value))))] + (host.object [] jdk/nashorn/api/scripting/AbstractJSObject [program/StructureValue] + [] + ## Methods + (program/StructureValue + [] (getValue self) java/lang/Object + (:coerce (Array java/lang/Object) value)) + (jdk/nashorn/api/scripting/AbstractJSObject + [] (isArray self) boolean + #1) + (jdk/nashorn/api/scripting/AbstractJSObject + [] (getMember self {member java/lang/String}) java/lang/Object + (case member + (^or "toJSON" "toString") + (:coerce java/lang/Object + (::toString value)) + + "length" + (jvm-int (array.size value)) + + "slice" + (:coerce java/lang/Object + (::slice js-object value)) + + (^ (static runtime.variant-tag-field)) + (|> value (array.read 0) maybe.assume) + + (^ (static runtime.variant-flag-field)) + (case (array.read 1 value) + (#.Some set!) + set! + + _ + (host.null)) + + (^ (static runtime.variant-value-field)) + (|> value (array.read 2) maybe.assume js-object (:coerce java/lang/Object)) + + _ + (error! (exception.construct ..unknown-member [(:coerce Text member) (:coerce java/lang/Object value)]))) + ) + (jdk/nashorn/api/scripting/AbstractJSObject + [] (getSlot self {idx int}) java/lang/Object + (|> value + (array.read (|> idx java/lang/Integer::longValue (:coerce Nat))) + maybe.assume + js-object + (:coerce 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)])) + + (def: (check-int js-object) + (-> jdk/nashorn/api/scripting/ScriptObjectMirror + (Maybe Int)) + (case [(jdk/nashorn/api/scripting/JSObject::getMember [runtime.i64-high-field] js-object) + (jdk/nashorn/api/scripting/JSObject::getMember [runtime.i64-low-field] js-object)] + (^multi [(#.Some high) (#.Some low)] + [[(host.check java/lang/Number high) + (host.check java/lang/Number low)] + [(#.Some high) (#.Some low)]] + [[(java/lang/Number::longValue high) + (java/lang/Number::longValue low)] + [high low]]) + (#.Some (.int (n.+ (|> high .nat (i64.left-shift 32)) + (if (i.< +0 (.int low)) + (|> low .nat (i64.left-shift 32) (i64.logic-right-shift 32)) + (.nat low))))) + + _ + #.None)) + + (def: (check-variant lux-object js-object) + (-> (-> java/lang/Object (Try Any)) + jdk/nashorn/api/scripting/ScriptObjectMirror + (Maybe Any)) + (case [(jdk/nashorn/api/scripting/JSObject::getMember [runtime.variant-tag-field] js-object) + (jdk/nashorn/api/scripting/JSObject::getMember [runtime.variant-flag-field] js-object) + (jdk/nashorn/api/scripting/JSObject::getMember [runtime.variant-value-field] js-object)] + (^multi [(#.Some tag) ?flag (#.Some value)] + [(host.check java/lang/Number tag) + (#.Some tag)] + [(lux-object value) + (#.Some value)]) + (#.Some [(java/lang/Number::intValue tag) + (maybe.default (host.null) ?flag) + value]) + + _ + #.None)) + + (def: (check-array lux-object js-object) + (-> (-> java/lang/Object (Try Any)) + jdk/nashorn/api/scripting/ScriptObjectMirror + (Maybe (Array java/lang/Object))) + (if (jdk/nashorn/api/scripting/JSObject::isArray js-object) + (let [num-keys (.nat (jdk/nashorn/api/scripting/ScriptObjectMirror::size js-object))] + (loop [idx 0 + output (: (Array java/lang/Object) + (array.new num-keys))] + (if (n.< num-keys idx) + (case (jdk/nashorn/api/scripting/JSObject::getMember (%.nat idx) js-object) + (#.Some member) + (case (host.check jdk/nashorn/internal/runtime/Undefined member) + (#.Some _) + (recur (inc idx) output) + + #.None + (case (lux-object member) + (#try.Success parsed-member) + (recur (inc idx) (array.write idx (:coerce java/lang/Object parsed-member) output)) + + (#try.Failure error) + #.None)) + + #.None + (recur (inc idx) output)) + (#.Some output)))) + #.None)) + + (def: (lux-object js-object) + (-> java/lang/Object (Try Any)) + (`` (<| (if (host.null? js-object) + (exception.throw ..null-has-no-lux-representation [#.None])) + (case (host.check jdk/nashorn/internal/runtime/Undefined js-object) + (#.Some _) + (exception.throw ..undefined-has-no-lux-representation []) + #.None) + (~~ (template [] + [(case (host.check js-object) + (#.Some js-object) + (exception.return js-object) + #.None)] + + [java/lang/Boolean] [java/lang/String])) + (~~ (template [ ] + [(case (host.check js-object) + (#.Some js-object) + (exception.return ( js-object)) + #.None)] + + [java/lang/Number java/lang/Number::doubleValue] + [StructureValue StructureValue::getValue] + [IntValue IntValue::getValue])) + (case (host.check jdk/nashorn/api/scripting/ScriptObjectMirror js-object) + (#.Some js-object) + (case (check-int js-object) + (#.Some value) + (exception.return value) + + #.None + (case (check-variant lux-object js-object) + (#.Some value) + (exception.return value) + + #.None + (case (check-array lux-object js-object) + (#.Some value) + (exception.return value) + + #.None + (if (jdk/nashorn/api/scripting/JSObject::isFunction js-object) + (exception.return js-object) + (exception.throw ..unknown-kind-of-host-object (:coerce java/lang/Object js-object)))))) + #.None) + ## else + (exception.throw ..unknown-kind-of-host-object (:coerce java/lang/Object js-object)) + ))) + + (def: (ensure-function function) + (-> Any (Maybe jdk/nashorn/api/scripting/JSObject)) + (do maybe.monad + [function (|> function + (:coerce java/lang/Object) + (host.check jdk/nashorn/api/scripting/JSObject))] + (if (jdk/nashorn/api/scripting/JSObject::isFunction function) + (#.Some function) + #.None))) + ) + + @.js + (as-is)}) + +(for {@.old + (as-is (def: (call-macro inputs lux macro) + (-> (List Code) Lux jdk/nashorn/api/scripting/JSObject (Try (Try [Lux (List Code)]))) + (let [to-js (: (-> Any java/lang/Object) + (|>> (:coerce (Array java/lang/Object)) js-structure (:coerce java/lang/Object)))] + (<| (:coerce (Try (Try [Lux (List Code)]))) + (jdk/nashorn/api/scripting/JSObject::call #.None + (|> (array.new 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" (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 + (:coerce java/lang/Object) + lux-object + (:coerce (Try (Try [Lux (List Code)])))) + + (#try.Failure error) + (#try.Failure error)) + + #.None + (exception.throw ..cannot-apply-a-non-function (:coerce java/lang/Object macro)))) + ) + + @.js + (def: (expander macro inputs lux) + Expander + (#try.Success ((:coerce Macro' macro) inputs lux))) + }) + +(for {@.old + (as-is (def: (evaluate! interpreter alias input) + (-> javax/script/ScriptEngine Text _.Expression (Try Any)) + (do try.monad + [?output (javax/script/ScriptEngine::eval (_.code input) interpreter)] + (case ?output + (#.Some output) + (..lux-object output) + + #.None + (exception.throw ..null-has-no-lux-representation [(#.Some input)])))) + + (def: (execute! interpreter alias input) + (-> javax/script/ScriptEngine Text _.Statement (Try Any)) + (do try.monad + [?output (javax/script/ScriptEngine::eval (_.code input) interpreter)] + (wrap []))) + + (def: (define! interpreter context input) + (-> javax/script/ScriptEngine Context _.Expression (Try [Text Any _.Statement])) + (let [global (reference.artifact context) + @global (_.var global)] + (do try.monad + [#let [definition (_.define @global input)] + _ (execute! interpreter global definition) + value (evaluate! interpreter global @global)] + (wrap [global value definition])))) + + (def: host + (IO (Host _.Expression _.Statement)) + (io (let [interpreter (javax/script/ScriptEngineFactory::getScriptEngine + (jdk/nashorn/api/scripting/NashornScriptEngineFactory::new))] + (: (Host _.Expression _.Statement) + (structure + (def: evaluate! (..evaluate! interpreter)) + (def: execute! (..execute! interpreter)) + (def: define! (..define! interpreter)) + + (def: (ingest context content) + (|> content encoding.from-utf8 try.assume (:coerce _.Statement))) + + (def: (re-learn context content) + (..execute! interpreter (reference.artifact context) content)) + + (def: (re-load context content) + (do try.monad + [_ (..execute! interpreter "" content)] + (..evaluate! interpreter "" (_.var (reference.artifact context)))))))))) + ) + + @.js + (as-is (import: (eval [Text] #? Any)) + + (def: (evaluate! alias input) + (-> Text _.Expression (Try Any)) + (do try.monad + [?output (host.try (..eval (_.code input)))] + (case ?output + (#.Some output) + (wrap output) + + #.None + (exception.throw ..null-has-no-lux-representation [(#.Some input)])))) + + (def: (execute! alias input) + (-> Text _.Statement (Try Any)) + (do try.monad + [?output (host.try (..eval (_.code input)))] + (wrap []))) + + (def: (define! context input) + (-> Context _.Expression (Try [Text Any _.Statement])) + (let [global (reference.artifact context) + @global (_.var global)] + (do try.monad + [#let [definition (_.define @global input)] + _ (..execute! global definition) + value (..evaluate! global @global)] + (wrap [global value definition])))) + + (def: host + (IO (Host _.Expression _.Statement)) + (io (: (Host _.Expression _.Statement) + (structure + (def: evaluate! ..evaluate!) + (def: execute! ..execute!) + (def: define! ..define!) + + (def: (ingest context content) + (|> content encoding.from-utf8 try.assume (:coerce _.Statement))) + + (def: (re-learn context content) + (..execute! (reference.artifact context) content)) + + (def: (re-load context content) + (do try.monad + [_ (..execute! "" content)] + (..evaluate! "" (_.var (reference.artifact context))))))))) + )}) (def: platform (IO (Platform [Register Text] _.Expression _.Statement)) @@ -477,41 +543,49 @@ (def: (program namer context program) (-> (-> Context Text) (Program _.Expression _.Statement)) (let [@process (_.var "process") - raw-inputs (_.? (|> (|> @process _.type-of (_.= (_.string "undefined")) _.not) - (_.and (|> @process (_.the "argv")))) - (|> @process (_.the "argv")) - (_.array (list)))] - (_.statement (_.apply/1 (_.apply/1 program (runtime.lux//program-args raw-inputs)) + on-node-js? (|> (|> @process _.type-of (_.= (_.string "undefined")) _.not) + (_.and (|> @process (_.the "argv")))) + 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 ""))))) -(def: extender - Extender - ## TODO: Stop relying on coercions ASAP. - (<| (:coerce Extender) - (function (@self handler)) - (:coerce Handler) - (function (@self name phase)) - (:coerce Phase) - (function (@self archive parameters)) - (:coerce Operation) - (function (@self state)) - (:coerce Try) - try.assume - (:coerce Try) - (do try.monad - [handler (try.from-maybe (..ensure-macro (:coerce Macro handler))) - #let [to-js (: (-> Any java/lang/Object) - (|>> (:coerce (Array java/lang/Object)) js-structure (:coerce java/lang/Object)))] - output (jdk/nashorn/api/scripting/JSObject::call #.None - (|> (array.new 5) - (: (Array java/lang/Object)) - (array.write 0 name) - (array.write 1 (to-js phase)) - (array.write 2 (to-js archive)) - (array.write 3 (to-js parameters)) - (array.write 4 (to-js state))) - (:coerce jdk/nashorn/api/scripting/JSObject handler))] - (lux-object (:coerce java/lang/Object output))))) +(for {@.old + (def: extender + Extender + ## TODO: Stop relying on coercions ASAP. + (<| (:coerce Extender) + (function (@self handler)) + (:coerce Handler) + (function (@self name phase)) + (:coerce Phase) + (function (@self archive parameters)) + (:coerce Operation) + (function (@self state)) + (:coerce Try) + try.assume + (:coerce Try) + (do try.monad + [handler (try.from-maybe (..ensure-function handler)) + #let [to-js (: (-> Any java/lang/Object) + (|>> (:coerce (Array java/lang/Object)) js-structure (:coerce java/lang/Object)))] + output (jdk/nashorn/api/scripting/JSObject::call #.None + (|> (array.new 5) + (: (Array java/lang/Object)) + (array.write 0 name) + (array.write 1 (to-js phase)) + (array.write 2 (to-js archive)) + (array.write 3 (to-js parameters)) + (array.write 4 (to-js state))) + handler)] + (lux-object (:coerce java/lang/Object output))))) + + @.js + (def: (extender handler) + Extender + (:assume handler))}) (def: (declare-success! _) (-> Any (Promise Any)) diff --git a/stdlib/source/lux/host.js.lux b/stdlib/source/lux/host.js.lux index eb0da3594..8dd6f1ad8 100644 --- a/stdlib/source/lux/host.js.lux +++ b/stdlib/source/lux/host.js.lux @@ -57,11 +57,16 @@ (.form (<>.after (.this! (' new)) (.tuple (<>.some ..nullable))))) -(type: Field [Text Nullable]) +(type: Field [Bit Text Nullable]) + +(def: static! + (Parser Any) + (.this! (' #static))) (def: field (Parser Field) (.form ($_ <>.and + (<>.parses? ..static!) .local-identifier ..nullable))) @@ -83,12 +88,12 @@ ..nullable)) (def: static-method - (.form (<>.after (.this! (' #static)) ..common-method))) + (<>.after ..static! ..common-method)) (def: method (Parser Method) - (<>.or ..static-method - (.form ..common-method))) + (.form (<>.or ..static-method + ..common-method))) (type: Member (#Constructor Constructor) @@ -144,7 +149,7 @@ ($_ <>.and .local-identifier (<>.some member)) - ..static-method + (.form ..common-method) )) (syntax: #export (try expression) @@ -207,13 +212,18 @@ ("js constant" (~ (code.text real-class))) [(~+ (list@map (with-null g!temp) g!inputs))]))))) - (#Field [field fieldT]) - (` (def: ((~ (qualify field)) - (~ g!object)) - (-> (~ g!type) - (~ (nullable-type fieldT))) - (:assume - (~ (without-null g!temp fieldT (` ("js object get" (~ (code.text field)) (~ g!object)))))))) + (#Field [static? field fieldT]) + (if static? + (` ((~! syntax:) ((~ (qualify field))) + (:: (~! macro.monad) (~' wrap) + (list (` (.:coerce (~ (nullable-type fieldT)) + ("js constant" (~ (code.text (format real-class "." field)))))))))) + (` (def: ((~ (qualify field)) + (~ g!object)) + (-> (~ g!type) + (~ (nullable-type fieldT))) + (:assume + (~ (without-null g!temp fieldT (` ("js object get" (~ (code.text field)) (~ g!object))))))))) (#Method method) (case method diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux index fa9307f90..b87e6b901 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux @@ -14,7 +14,7 @@ [collection ["." list ("#@." functor)] ["." dictionary]]] - [target + ["@" target ["_" js (#+ Literal Expression Statement)]]] ["." //// #_ ["/" bundle] @@ -57,19 +57,36 @@ ) ## [[Numbers]] -(import: #long java/lang/Double - (#static MIN_VALUE double) - (#static MAX_VALUE double)) - -(template [ ] - [(def: ( _) - (Nullary Expression) - (//primitive.f64 ))] - - [f64//smallest (java/lang/Double::MIN_VALUE)] - [f64//min (f.* -1.0 (java/lang/Double::MAX_VALUE))] - [f64//max (java/lang/Double::MAX_VALUE)] - ) +(for {@.old + (as-is (import: #long java/lang/Double + (#static MIN_VALUE double) + (#static MAX_VALUE double)) + + (template [ ] + [(def: ( _) + (Nullary Expression) + (//primitive.f64 ))] + + [f64//smallest (java/lang/Double::MIN_VALUE)] + [f64//min (f.* -1.0 (java/lang/Double::MAX_VALUE))] + [f64//max (java/lang/Double::MAX_VALUE)] + )) + + @.js + (as-is (import: Number + (#static MIN_VALUE Frac) + (#static MAX_VALUE Frac)) + + (template [ ] + [(def: ( _) + (Nullary Expression) + (//primitive.f64 ))] + + [f64//smallest (Number::MIN_VALUE)] + [f64//min (f.* -1.0 (Number::MAX_VALUE))] + [f64//max (Number::MAX_VALUE)] + ) + )}) (def: f64//decode (Unary Expression) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux index 54f299c31..497261cf0 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux @@ -20,7 +20,8 @@ ["#." analysis (#+ Analysis)] ["/" synthesis (#+ Synthesis Phase)] [/// - [reference (#+)] + [reference (#+) + [variable (#+)]] ["." phase ("#@." monad)]]]]]) (def: (primitive analysis) diff --git a/stdlib/source/lux/tool/compiler/meta/packager/script.lux b/stdlib/source/lux/tool/compiler/meta/packager/script.lux index 88a7ddef0..bbbba4978 100644 --- a/stdlib/source/lux/tool/compiler/meta/packager/script.lux +++ b/stdlib/source/lux/tool/compiler/meta/packager/script.lux @@ -1,29 +1,20 @@ (.module: - [lux (#- Module Definition) + [lux #* [type (#+ :share)] - ["." host (#+ import: do-to)] [abstract ["." monad (#+ Monad do)]] [control ["." try (#+ Try)] - [concurrency - ["." promise (#+ Promise)]] [security ["!" capability]]] [data - ["." binary (#+ Binary)] - ["." text + [binary (#+ Binary)] + [text ["%" format (#+ format)] ["." encoding]] - [number - ["n" nat]] [collection - ["." row (#+ Row)] - ["." list ("#@." functor fold)]]] - [target - [jvm - [encoding - ["." name]]]] + ["." row] + ["." list ("#@." functor)]]] [world ["." file (#+ File Directory)]]] [program @@ -32,7 +23,7 @@ ["." // (#+ Packager) [// ["." archive - ["." descriptor (#+ Module)] + ["." descriptor] ["." artifact]] [cache ["." dependency]] @@ -41,11 +32,7 @@ [// [language ["$" lux - [generation (#+ Context)] - [phase - [generation - [jvm - ["." runtime (#+ Definition)]]]]]]]]]) + [generation (#+ Context)]]]]]]) ## TODO: Delete ASAP (type: (Action ! a) @@ -86,11 +73,7 @@ (Packager !))) (function (package monad file-system static archive program) (do {@ (try.with monad)} - [cache (:share [!] - {(Monad !) - monad} - {(! (Try (Directory !))) - (:assume (!.use (:: file-system directory) [(get@ #static.target static)]))}) + [cache (!.use (:: file-system directory) [(get@ #static.target static)]) order (:: monad wrap (dependency.load-order $.key archive))] (|> order (list@map (function (_ [module [module-id [descriptor document]]]) diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index 4fd43bf15..3a976918f 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -453,7 +453,7 @@ (sep host.String) (basename [host.String] host.String)) - (import: (#static require [host.String] Any)) + (import: (require [host.String] Any)) (template: (!fs) (:coerce ..Fs (..require "fs"))) diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index 63c398bf9..95ad2c771 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -24,7 +24,8 @@ ["." list ("#@." functor fold)]]] [world ["." file (#+ File Path)] - ["." console]] + ## ["." console] + ] [tool [compiler ["." phase] @@ -73,21 +74,33 @@ (def: (package! monad file-system [packager package] static archive context) (All [!] (-> (Monad !) (file.System !) [Packager Path] Static Archive Context (! (Try Any)))) - (do (try.with monad) - [#let [packager (:share [!] {(Monad !) monad} {(Packager !) packager})] - content (packager monad file-system static archive context) - package (:share [!] - {(Monad !) - monad} - {(! (Try (File !))) - (:assume (file.get-file monad file-system package))})] - (!.use (:: (:share [!] - {(Monad !) - monad} - {(File !) - (:assume package)}) - over-write) - [content]))) + (for {@.old + (do (try.with monad) + [#let [packager (:share [!] {(Monad !) monad} {(Packager !) packager})] + content (packager monad file-system static archive context) + package (:share [!] + {(Monad !) + monad} + {(! (Try (File !))) + (:assume (file.get-file monad file-system package))})] + (!.use (:: (:share [!] + {(Monad !) + monad} + {(File !) + (:assume package)}) + over-write) + [content]))} + ## TODO: Fix whatever type-checker bug is forcing me into this compromise... + (:assume + (: (Promise (Try Any)) + (let [monad (:coerce (Monad Promise) monad) + file-system (:coerce (file.System Promise) monad) + packager (:coerce (Packager Promise) packager)] + (do (try.with monad) + [content (packager monad file-system static archive context) + package (: (Promise (Try (File Promise))) + (file.get-file monad file-system package))] + (!.use (:: (: (File Promise) package) over-write) [content]))))))) (with-expansions [ (as-is anchor expression artifact)] (def: #export (compiler static -- cgit v1.2.3