aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--commands.md5
-rw-r--r--lux-js/source/program.lux928
-rw-r--r--stdlib/source/lux/host.js.lux34
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux45
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux3
-rw-r--r--stdlib/source/lux/tool/compiler/meta/packager/script.lux33
-rw-r--r--stdlib/source/lux/world/file.lux2
-rw-r--r--stdlib/source/program/compositor.lux45
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 [<name>]
- [(interface: <name>
- (getValue [] java/lang/Object))
-
- (`` (import: (~~ (template.identifier ["program/" <name>]))
- (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 [<class>]
- [(case (host.check <class> js-object)
- (#.Some js-object)
- (exception.return js-object)
- #.None)]
-
- [java/lang/Boolean] [java/lang/String]))
- (~~ (template [<class> <method>]
- [(case (host.check <class> js-object)
- (#.Some js-object)
- (exception.return (<method> 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 [<name>]
+ [(host.interface: <name>
+ (getValue [] java/lang/Object))
+
+ (`` (import: (~~ (template.identifier ["program/" <name>]))
+ (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 [<class>]
+ [(case (host.check <class> js-object)
+ (#.Some js-object)
+ (exception.return js-object)
+ #.None)]
+
+ [java/lang/Boolean] [java/lang/String]))
+ (~~ (template [<class> <method>]
+ [(case (host.check <class> js-object)
+ (#.Some js-object)
+ (exception.return (<method> 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 @@
(<c>.form (<>.after (<c>.this! (' new))
(<c>.tuple (<>.some ..nullable)))))
-(type: Field [Text Nullable])
+(type: Field [Bit Text Nullable])
+
+(def: static!
+ (Parser Any)
+ (<c>.this! (' #static)))
(def: field
(Parser Field)
(<c>.form ($_ <>.and
+ (<>.parses? ..static!)
<c>.local-identifier
..nullable)))
@@ -83,12 +88,12 @@
..nullable))
(def: static-method
- (<c>.form (<>.after (<c>.this! (' #static)) ..common-method)))
+ (<>.after ..static! ..common-method))
(def: method
(Parser Method)
- (<>.or ..static-method
- (<c>.form ..common-method)))
+ (<c>.form (<>.or ..static-method
+ ..common-method)))
(type: Member
(#Constructor Constructor)
@@ -144,7 +149,7 @@
($_ <>.and
<c>.local-identifier
(<>.some member))
- ..static-method
+ (<c>.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 [<name> <const>]
- [(def: (<name> _)
- (Nullary Expression)
- (//primitive.f64 <const>))]
-
- [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 [<name> <const>]
+ [(def: (<name> _)
+ (Nullary Expression)
+ (//primitive.f64 <const>))]
+
+ [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 [<name> <const>]
+ [(def: (<name> _)
+ (Nullary Expression)
+ (//primitive.f64 <const>))]
+
+ [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 [<parameters> (as-is anchor expression artifact)]
(def: #export (compiler static
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 04:48:21 +0000