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 | 184 |
1 files changed, 0 insertions, 184 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 deleted file mode 100644 index 89f419cc3..000000000 --- a/new-luxc/source/luxc/lang/translation/js/eval.jvm.lux +++ /dev/null @@ -1,184 +0,0 @@ -(.module: - lux - (lux (control ["ex" exception #+ exception:]) - (data [bit] - [maybe] - ["e" error #+ Error] - text/format - (coll [array])) - [host]) - (luxc [lang] - (lang (host [js #+ JS Expression Statement]))) - [//]) - -(do-template [<name>] - [(exception: #export (<name> {message Text}) - message)] - - [Unknown-Kind-Of-JS-Object] - [Null-Has-No-Lux-Representation] - - [Cannot-Evaluate] - ) - -(host.import: java/lang/Object - (toString [] String)) - -(host.import: java/lang/Integer - (longValue [] Long)) - -(host.import: java/lang/Number - (doubleValue [] double) - (longValue [] Long) - (intValue [] Integer)) - -(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 [] (:coerce Number high)) - (Number::longValue [] (:coerce Number low))] - [high low]]) - (#.Some (.int (n/+ (|> high (:coerce Nat) (bit.left-shift +32)) - (if (i/< 0 (:coerce Int low)) - (|> low (:coerce Nat) (bit.left-shift +32) (bit.logical-right-shift +32)) - (|> low (:coerce Nat)))))) - - _ - #.None)) - -(def: (variant lux-object js-object) - (-> (-> Object (Error Any)) ScriptObjectMirror (Maybe Any)) - (case [(JSObject::getMember [//.variant-tag-field] js-object) - (JSObject::getMember [//.variant-flag-field] js-object) - (JSObject::getMember [//.variant-value-field] js-object)] - (^multi [(#.Some tag) ?flag (#.Some value)] - (host.instance? Number tag) - [[(Number::intValue [] (:coerce Number tag)) - (lux-object value)] - [tag (#.Some value)]]) - (#.Some [tag (maybe.default (host.null) ?flag) value]) - - _ - #.None)) - -(def: (array lux-object js-object) - (-> (-> Object (Error Any)) ScriptObjectMirror (Maybe (Array Object))) - (if (JSObject::isArray [] js-object) - (let [init-num-keys (.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 .int %i)] - (case (JSObject::getMember idx-key js-object) - (#.Some member) - (case (lux-object member) - (#e.Success parsed-member) - (recur num-keys (inc idx) (array.write idx (:coerce Object parsed-member) output)) - - (#e.Error error) - #.None) - - #.None - (recur num-keys (inc idx) output))) - (#.Some output)))) - #.None)) - -(def: (lux-object js-object) - (-> Object (Error Any)) - (`` (cond (host.null? js-object) - (ex.throw Null-Has-No-Lux-Representation "") - - (host.instance? Integer js-object) - (ex.return (Integer::longValue [] (:coerce 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 [] (:coerce Number js-object))) - - (~~ (do-template [<interface> <method>] - [(host.instance? <interface> js-object) - (ex.return (<method> [] (:coerce <interface> js-object)))] - - [StructureValue StructureValue::getValue] - [IntValue IntValue::getValue])) - - (host.instance? ScriptObjectMirror js-object) - (let [js-object (:coerce ScriptObjectMirror js-object)] - (case (int js-object) - (#.Some value) - (ex.return value) - - #.None - (case (variant lux-object 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 [] (:coerce Object js-object))))))) - - ## else - (ex.throw Unknown-Kind-Of-JS-Object (Object::toString [] (:coerce Object js-object)))))) - -(def: #export (eval code) - (-> Expression (Meta Any)) - (function (_ compiler) - (case (|> compiler - (get@ #.host) - (:coerce //.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)))))) |