aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/translation/js.lux382
-rw-r--r--new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux2
2 files changed, 382 insertions, 2 deletions
diff --git a/new-luxc/source/luxc/lang/translation/js.lux b/new-luxc/source/luxc/lang/translation/js.lux
index 6cc19e01d..e0278ceeb 100644
--- a/new-luxc/source/luxc/lang/translation/js.lux
+++ b/new-luxc/source/luxc/lang/translation/js.lux
@@ -1,8 +1,388 @@
(.module:
- lux)
+ lux
+ (lux (control ["ex" exception #+ exception:]
+ pipe)
+ (data [bit]
+ [maybe]
+ ["e" error #+ Error]
+ [text "text/" Eq<Text>]
+ text/format
+ (coll [array]))
+ [macro]
+ [io #+ Process]
+ [host #+ class: object]
+ (world [file #+ File]))
+ (luxc [lang]
+ [".C" io]))
(type: #export JS Text)
(type: #export Expression JS)
(type: #export Statement JS)
+
+(host.import java/lang/Object
+ (toString [] String))
+
+(host.import java/lang/String
+ (getBytes [String] #try (Array byte)))
+
+(host.import java/lang/Number
+ (doubleValue [] double))
+
+(host.import java/lang/Integer
+ (longValue [] Long))
+
+(host.import java/lang/Long
+ (intValue [] Integer))
+
+(host.import java/lang/AbstractStringBuilder
+ (append [String] AbstractStringBuilder))
+
+(host.import java/lang/StringBuilder
+ (new [])
+ (toString [] String))
+
+(host.import javax/script/ScriptEngine
+ (eval [String] #try #? Object))
+
+(host.import javax/script/ScriptEngineFactory
+ (getScriptEngine [] ScriptEngine))
+
+(host.import jdk/nashorn/api/scripting/NashornScriptEngineFactory
+ (new []))
+
+(host.import jdk/nashorn/api/scripting/NashornScriptEngine)
+
+(host.import jdk/nashorn/api/scripting/JSObject
+ (isArray [] boolean)
+ (isFunction [] boolean)
+ (getMember [String] #? Object)
+ (hasMember [String] boolean))
+
+(host.import jdk/nashorn/api/scripting/AbstractJSObject)
+
+(host.import jdk/nashorn/api/scripting/ScriptObjectMirror)
+
+(host.import jdk/nashorn/internal/runtime/Undefined)
+
+(host.import java/util/Arrays
+ (#static [t] copyOfRange [(Array t) int int] (Array t)))
+
+(type: #export Host
+ {## #artifacts Artifacts
+ ## #context [Text Nat]
+
+ #interpreter ScriptEngine
+ #module-buffer (Maybe StringBuilder)
+ #program-buffer StringBuilder
+ })
+
+(def: #export (init _)
+ (-> Top Host)
+ {#interpreter (ScriptEngineFactory::getScriptEngine [] (NashornScriptEngineFactory::new []))
+ #module-buffer #.None
+ #program-buffer (StringBuilder::new [])})
+
+(def: #export module-js-name Text "module.js")
+
+(def: #export (init-module-buffer _)
+ (-> Top (Meta Unit))
+ (function [compiler]
+ (#e.Success [(update@ #.host
+ (|>> (:! Host)
+ (set@ #module-buffer (#.Some (StringBuilder::new [])))
+ (:! Void))
+ compiler)
+ []])))
+
+(exception: #export No-Active-Module-Buffer)
+(exception: #export Cannot-Execute)
+(exception: #export Cannot-Evaluate)
+
+(def: #export module-buffer
+ (Meta StringBuilder)
+ (function [compiler]
+ (case (|> compiler (get@ #.host) (:! Host) (get@ #module-buffer))
+ #.None
+ ((lang.fail (No-Active-Module-Buffer "")) compiler)
+
+ (#.Some module-buffer)
+ (#e.Success [compiler module-buffer]))))
+
+(def: #export program-buffer
+ (Meta StringBuilder)
+ (function [compiler]
+ (#e.Success [compiler (|> compiler (get@ #.host) (:! Host) (get@ #program-buffer))])))
+
+(def: (execute code)
+ (-> Expression (Meta Unit))
+ (function [compiler]
+ (case (|> compiler
+ (get@ #.host)
+ (:! Host)
+ (get@ #interpreter)
+ (ScriptEngine::eval [code]))
+ (#e.Error error)
+ ((lang.fail (Cannot-Execute error)) compiler)
+
+ (#e.Success _)
+ (#e.Success [compiler []]))))
+
+(def: (::toString js-object)
+ (-> Top JSObject)
+ (object [] AbstractJSObject []
+ []
+ (AbstractJSObject (isFunction) boolean
+ true)
+ (AbstractJSObject (call [args (Array Object)]) Object
+ (Object::toString [] (:! Object js-object)))
+ ))
+
+(def: (::slice js-object value)
+ (-> (-> Object JSObject) (Array Object) JSObject)
+ (object [] AbstractJSObject []
+ []
+ (AbstractJSObject (isFunction) boolean
+ true)
+ (AbstractJSObject (call [args (Array Object)]) Object
+ (:! Object
+ (js-object (Arrays::copyOfRange [value
+ (|> args (array.read +0) maybe.assume (:! Int))
+ (nat-to-int (array.size value))]))))
+ ))
+
+(exception: #export Unknown-Member)
+
+(def: int-high-field Text "H")
+(def: int-low-field Text "L")
+
+(def: jvm-int
+ (-> Nat Integer)
+ (|>> (:! Long) (Long::intValue [])))
+
+(def: low-mask
+ Nat
+ (|> +1 (bit.shift-left +32) n/dec))
+
+(def: high (-> Nat Nat) (bit.shift-right +32))
+(def: low (-> Nat Nat) (bit.and low-mask))
+
+(class: #final LuxInt AbstractJSObject []
+ ## Fields
+ (#public value Long)
+ ## Methods
+ (#public [] (new [value Long]) []
+ (exec (:= ::value value)
+ []))
+ (AbstractJSObject [] (getMember [member String]) Object
+ (cond (text/= int-high-field member)
+ (|> ::value int-to-nat high jvm-int)
+
+ (text/= int-low-field member)
+ (|> ::value int-to-nat low jvm-int)
+
+ ## else
+ (error! (Unknown-Member (format " member = " member "\n"
+ "object(int) = " (%i ::value) "\n"))))))
+
+(host.import luxc/lang/translation/js/LuxInt
+ (value Long)
+ (new [Long]))
+
+(class: #final LuxArray AbstractJSObject []
+ ## Fields
+ (#public structure (Array Object))
+ ## Methods
+ (#public [] (new [structure (Array Object)]) []
+ (exec (:= ::structure structure)
+ []))
+ (AbstractJSObject [] (isArray) boolean
+ true)
+ (AbstractJSObject [] (getMember [member String]) Object
+ (cond (text/= "toString" member)
+ (:! Object
+ (::toString ::structure))
+
+ (text/= "length" member)
+ (jvm-int (array.size ::structure))
+
+ (text/= "slice" member)
+ (let [js-object (: (-> Object JSObject)
+ (|>> (cond> [(host.instance? (Array Object))]
+ [(:! (Array Object)) [] ::new!]
+
+ [(host.instance? Long)]
+ [(:! Long) [] LuxInt::new]
+
+ ## else
+ [(:! JSObject)])))]
+ (:! Object
+ (::slice js-object ::structure)))
+
+ ## else
+ (error! (Unknown-Member (format " member = " (:! Text member) "\n"
+ "object(structure) = " (Object::toString [] (:! Object ::structure)) "\n")))))
+ (AbstractJSObject [] (getSlot [idx int]) Object
+ (|> ::structure
+ (array.read (|> idx (Integer::longValue []) (:! Nat)))
+ maybe.assume
+ (cond> [(host.instance? (Array Object))]
+ [(:! (Array Object)) [] ::new!]
+
+ [(host.instance? Long)]
+ [(:! Long) [] LuxInt::new]
+
+ ## else
+ [(:! JSObject)])))
+ )
+
+(host.import luxc/lang/translation/js/LuxArray
+ (structure (Array Object))
+ (new [(Array Object)]))
+
+## (def: (wrap-lux-object object)
+## (-> Top JSObject)
+## (if (host.instance? JSObject object)
+## (lux-obj object)
+## obj))
+
+(def: (int js-object)
+ (-> JSObject (Maybe Int))
+ (case [(JSObject::getMember [int-high-field] js-object)
+ (JSObject::getMember [int-low-field] js-object)]
+ (^multi [(#.Some high) (#.Some low)]
+ (and (host.instance? Number high)
+ (host.instance? Number low))
+ [[(Number::longValue [] high) (Number::longValue [] low)]
+ [high low]])
+ (#.Some (nat-to-int (n/+ (-> high (:! Int) int-to-nat (bit.shift-left +32))
+ (-> low (:! Int) int-to-nat))))
+
+ _
+ #.None))
+
+(def: (extend-array by input)
+ (All [a] (-> Nat (Array a) (Array a)))
+ (let [size (array.size input)]
+ (|> (array.new (n/+ by size))
+ (array.copy size +0 input +0))))
+
+(def: (array js-object)
+ (-> ScriptObjectMirror (Maybe (Array Object)))
+ (if (JSObject::isArray [] js-object)
+ (#.Some (loop [num-keys (ScriptObjectMirror::size js-object)
+ idx +0
+ output (: (Array Object)
+ (array.new num-keys))]
+ (if (n/< num-keys idx)
+ (let [idx-key (|> idx nat-to-int %i)]
+ (case (JSObject::getMember idx-key js-object)
+ (#.Some member)
+ (recur num-keys
+ (n/inc idx)
+ (array.write idx output member))
+
+ #.None
+ (recur (n/inc num-keys)
+ (n/inc idx)
+ (extend-array +1 output))))
+ output)))
+ #.None))
+
+(exception: #export Unknown-Kind-Of-JS-Object)
+(exception: #export Null-Has-No-Lux-Representation)
+
+(def: (lux-object js-object)
+ (-> Object (Error Top))
+ (cond (host.null? js-object)
+ (ex.throw Null-Has-No-Lux-Representation "")
+
+ (host.instance? java.lang.Integer js-object)
+ (ex.return (Integer::longValue [] js-object))
+
+ (or (host.instance? java.lang.Boolean js-object)
+ (host.instance? java.lang.String js-object))
+ (ex.return js-object)
+
+ (host.instance? java.lang.Number js-object)
+ (ex.return (Number::doubleValue [] (:! java.lang.Number js-object)))
+
+ (host.instance? LuxArray js-object)
+ (ex.return (LuxArray::structure [] (:! LuxArray js-object)))
+
+ (host.instance? LuxInt js-object)
+ (ex.return (LuxInt::value [] (:! LuxInt js-object)))
+
+ (host.instance? JSObject js-object)
+ (let [js-object (:! JSObject js-object)]
+ (case (int js-object)
+ (#.Some value)
+ (ex.return value)
+
+ #.None
+ (case (array lux-object js-object)
+ (#.Some value)
+ (ex.return value)
+
+ #.None
+ ## (JSObject::isFunction [] js-object)
+ ## js-object
+
+ ## else
+ (ex.throw Unknown-Kind-Of-JS-Object (Object::toString [] (:! Object js-object))))))
+
+ ## else
+ (ex.throw Unknown-Kind-Of-JS-Object (Object::toString [] (:! Object js-object)))))
+
+(def: #export (eval code)
+ (-> Expression (Meta Top))
+ (function [compiler]
+ (case (|> compiler
+ (:! Host)
+ (get@ #interpreter)
+ (ScriptEngine::eval [code]))
+ (#e.Error error)
+ ((lang.fail (Cannot-Evaluate error)) compiler)
+
+ (#e.Success output)
+ (#e.Success [compiler (case output
+ #.None
+ []
+
+ (#.Some output)
+ (js-to-lux output))]))))
+
+(def: #export unit Text "\u0000")
+
+(def: (module-name module)
+ (-> Text Text)
+ (-> module
+ (text.replace-all "/" "$")
+ (text.replace-all "-" "_")))
+
+(def: (definition-name [module name])
+ (-> Ident Text)
+ (format (module-name module) "$" (&host/def-name name)))
+
+(def: #export (save-definition name code)
+ (-> Ident Expression (Meta Unit))
+ (do macro.Monad<Meta>
+ [#let [js-definition (format "var " (definition-name name) " = " code ";\n")]
+ module-buffer module-buffer
+ #let [_ (StringBuilder::append [js-definition] module-buffer)]]
+ (execute js-definition)))
+
+(def: #export (save-module! target)
+ (-> File (Meta (Process Unit)))
+ (do macro.Monad<Meta>
+ [module macro.current-module-name
+ module-buffer module-buffer
+ program-buffer program-buffer
+ #let [_ (StringBuilder::append [(format module-buffer "\n")] program-buffer)]]
+ (wrap (ioC.write target
+ (format module "/" module-js-name)
+ (|> module-buffer
+ (StringBuilder::toString [])
+ (String::getBytes ["UTF-8"])
+ e.assume)))))
diff --git a/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux
index 742185c2e..4c50a7aef 100644
--- a/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/js/runtime.jvm.lux
@@ -7,7 +7,7 @@
(def: prefix Text "LuxRuntime")
-(def: #export unit //.Expression (%t "\u0000"))
+(def: #export unit //.Expression (%t //.unit))
(def: (flag value)
(-> Bool //.JS)