diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/php/eval.jvm.lux')
-rw-r--r-- | new-luxc/source/luxc/lang/translation/php/eval.jvm.lux | 139 |
1 files changed, 0 insertions, 139 deletions
diff --git a/new-luxc/source/luxc/lang/translation/php/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/php/eval.jvm.lux deleted file mode 100644 index 4c4a6c641..000000000 --- a/new-luxc/source/luxc/lang/translation/php/eval.jvm.lux +++ /dev/null @@ -1,139 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data [bit] - [maybe] - ["e" error #+ Error] - text/format - (coll [array])) - [host]) - (luxc [lang] - (lang (host ["_" php #+ Expression Statement]))) - [//]) - -(template [<name>] - [(exception: #export (<name> {message Text}) - message)] - - [Not-A-Variant] - [Null-Has-No-Lux-Representation] - [Cannot-Evaluate] - ) - -(host.import: java/lang/Object - (toString [] String) - (getClass [] (Class Object))) - -(host.import: java/lang/Long - (intValue [] Integer)) - -(exception: #export (Unknown-Kind-Of-Host-Object {host-object Object}) - (let [object-class (:coerce Text (Object::toString [] (Object::getClass [] (:coerce Object host-object)))) - text-representation (:coerce Text (Object::toString [] (:coerce Object host-object)))] - (format object-class " --- " text-representation))) - -(host.import: php/runtime/Memory) - -(host.import: php/runtime/memory/NullMemory) - -(host.import: php/runtime/memory/FalseMemory) -(host.import: php/runtime/memory/TrueMemory) - -(host.import: php/runtime/memory/LongMemory - (new [long]) - (toLong [] long)) - -(host.import: php/runtime/memory/DoubleMemory - (toDouble [] double)) - -(host.import: php/runtime/memory/StringMemory - (new [String]) - (toString [] String)) - -(host.import: php/runtime/memory/ReferenceMemory - (getValue [] Memory)) - -(host.import: php/runtime/memory/ArrayMemory - (size [] int) - (isMap [] boolean) - (get [Memory] Memory)) - -(def: (tuple lux-object host-object) - (-> (-> Object (Error Any)) ArrayMemory (Error Any)) - (let [size (ArrayMemory::size [] host-object)] - (loop [idx 0 - output (: (Array Any) (array.new (:coerce Nat size)))] - (if (i/< size idx) - (let [value (|> host-object - (ArrayMemory::get [(LongMemory::new [idx])]) - (:coerce ReferenceMemory) (ReferenceMemory::getValue []))] - (if (host.instance? php/runtime/memory/NullMemory value) - (recur (inc idx) - (array.write (:coerce Nat idx) (host.null) output)) - (do e.Monad<Error> - [lux-value (lux-object value)] - (recur (inc idx) - (array.write (:coerce Nat idx) lux-value output))))) - (ex.return output))))) - -(def: (variant lux-object host-object) - (-> (-> Object (Error Any)) ArrayMemory (Error Any)) - (do e.Monad<Error> - [variant-tag (lux-object (ArrayMemory::get [(StringMemory::new [//.variant-tag-field])] host-object)) - variant-value (lux-object (ArrayMemory::get [(StringMemory::new [//.variant-value-field])] host-object))] - (wrap (: Any - [(Long::intValue [] (:coerce Long variant-tag)) - (: Any - (if (|> host-object - (ArrayMemory::get [(StringMemory::new [//.variant-flag-field])]) - (:coerce ReferenceMemory) - (ReferenceMemory::getValue []) - (host.instance? php/runtime/memory/NullMemory)) - (host.null) - "")) - variant-value])))) - -(def: (lux-object host-object) - (-> Object (Error Any)) - (cond (host.instance? php/runtime/memory/FalseMemory host-object) - (ex.return #0) - - (host.instance? php/runtime/memory/TrueMemory host-object) - (ex.return #1) - - (host.instance? php/runtime/memory/LongMemory host-object) - (ex.return (LongMemory::toLong [] (:coerce LongMemory host-object))) - - (host.instance? php/runtime/memory/DoubleMemory host-object) - (ex.return (DoubleMemory::toDouble [] (:coerce DoubleMemory host-object))) - - (host.instance? php/runtime/memory/StringMemory host-object) - (ex.return (StringMemory::toString [] (:coerce StringMemory host-object))) - - (host.instance? php/runtime/memory/ReferenceMemory host-object) - (lux-object (ReferenceMemory::getValue [] (:coerce ReferenceMemory host-object))) - - (host.instance? php/runtime/memory/ArrayMemory host-object) - (if (ArrayMemory::isMap [] (:coerce ArrayMemory host-object)) - (variant lux-object (:coerce ArrayMemory host-object)) - (tuple lux-object (:coerce ArrayMemory host-object))) - - ## else - (ex.throw Unknown-Kind-Of-Host-Object host-object))) - -(def: #export (eval code) - (-> Expression (Meta Any)) - (function (_ compiler) - (let [interpreter (|> compiler (get@ #.host) (:coerce //.Host) (get@ #//.interpreter))] - (case (interpreter code) - (#e.Error error) - ((lang.throw Cannot-Evaluate error) compiler) - - (#e.Success output) - (case (lux-object output) - (#e.Success parsed-output) - (#e.Success [compiler parsed-output]) - - (#e.Error error) - ((lang.throw Cannot-Evaluate error) compiler)))))) |