diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/js/eval.jvm.lux')
-rw-r--r-- | new-luxc/source/luxc/lang/translation/js/eval.jvm.lux | 164 |
1 files changed, 164 insertions, 0 deletions
diff --git a/new-luxc/source/luxc/lang/translation/js/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/js/eval.jvm.lux new file mode 100644 index 000000000..bcf70bcae --- /dev/null +++ b/new-luxc/source/luxc/lang/translation/js/eval.jvm.lux @@ -0,0 +1,164 @@ +(.module: + lux + (lux (control ["ex" exception #+ exception:]) + (data [bit] + ["e" error #+ Error] + text/format + (coll [array])) + [host]) + (luxc [lang]) + [//]) + +(host.import java/lang/Object + (toString [] String)) + +(host.import java/lang/Number + (doubleValue [] double) + (longValue [] Long)) + +(host.import java/lang/Integer + (longValue [] Long)) + +(host.import javax/script/ScriptEngine + (eval [String] #try #? Object)) + +(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 + (size [] int)) + +(host.import jdk/nashorn/internal/runtime/Undefined) + +(host.import luxc/lang/translation/js/IntValue + (getValue [] Long)) + +(host.import luxc/lang/translation/js/StructureValue + (getValue [] (Array Object))) + +(def: (int js-object) + (-> ScriptObjectMirror (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 [] (:! Number high)) + (Number::longValue [] (:! Number 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 element-parser js-object) + (-> (-> Object (Error Top)) ScriptObjectMirror (Maybe (Array Object))) + (if (JSObject::isArray [] js-object) + (let [init-num-keys (int-to-nat (ScriptObjectMirror::size [] js-object))] + (loop [num-keys init-num-keys + idx +0 + output (: (Array Object) + (array.new init-num-keys))] + (if (n/< num-keys idx) + (let [idx-key (|> idx nat-to-int %i)] + (case (JSObject::getMember idx-key js-object) + (#.Some member) + (case (element-parser member) + (#e.Success parsed-member) + (recur num-keys + (n/inc idx) + (array.write idx (:! Object parsed-member) output)) + + (#e.Error error) + #.None) + + #.None + (recur (n/inc num-keys) + (n/inc idx) + (extend-array +1 output)))) + (#.Some 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? Integer js-object) + (ex.return (Integer::longValue [] (:! Integer js-object))) + + (or (host.instance? java/lang/Boolean js-object) + (host.instance? java/lang/String js-object)) + (ex.return js-object) + + (host.instance? Number js-object) + (ex.return (Number::doubleValue [] (:! Number js-object))) + + (~~ (do-template [<interface> <method>] + [(host.instance? <interface> js-object) + (ex.return (<method> [] (:! <interface> js-object)))] + + [StructureValue StructureValue::getValue] + [IntValue IntValue::getValue])) + + (host.instance? ScriptObjectMirror js-object) + (let [js-object (:! ScriptObjectMirror 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)))))) + +(exception: #export Cannot-Evaluate) + +(def: #export (eval code) + (-> //.Expression (Meta Top)) + (function [compiler] + (case (|> compiler + (get@ #.host) + (:! //.Host) + (get@ #//.interpreter) + (ScriptEngine::eval [code])) + (#e.Error error) + ((lang.throw Cannot-Evaluate error) compiler) + + (#e.Success output) + (case output + #.None + (#e.Success [compiler []]) + + (#.Some output) + (case (lux-object output) + (#e.Success parsed-output) + (#e.Success [compiler parsed-output]) + + (#e.Error error) + ((lang.throw Cannot-Evaluate error) compiler)))))) |