diff options
-rw-r--r-- | new-luxc/project.clj | 33 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/translation/r.lux | 5 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/translation/r/eval.jvm.lux | 154 |
3 files changed, 17 insertions, 175 deletions
diff --git a/new-luxc/project.clj b/new-luxc/project.clj index b92276a50..5cf1e9a4e 100644 --- a/new-luxc/project.clj +++ b/new-luxc/project.clj @@ -20,23 +20,22 @@ :dependencies [;; JVM Bytecode [org.ow2.asm/asm-all "5.0.3"] - ;; Lua - [net.sandius.rembulan/rembulan-runtime "0.1-SNAPSHOT"] - [net.sandius.rembulan/rembulan-stdlib "0.1-SNAPSHOT"] - [net.sandius.rembulan/rembulan-compiler "0.1-SNAPSHOT"] - ;; Ruby - [org.jruby/jruby-complete "9.1.16.0"] - ;; Python - [org.python/jython-standalone "2.7.1"] - ;; R - [org.renjin/renjin-script-engine "0.8.2527"] - ;; Scheme - [kawa-scheme/kawa-core "2.4"] - ;; Common Lisp - [org.abcl/abcl "1.5.0"] - ;; PHP 5 - [org.develnext.jphp/jphp-core "0.9.2"] - [org.develnext.jphp/jphp-scripting "0.9.2"]] + ;; ;; Lua + ;; [net.sandius.rembulan/rembulan-runtime "0.1-SNAPSHOT"] + ;; [net.sandius.rembulan/rembulan-stdlib "0.1-SNAPSHOT"] + ;; [net.sandius.rembulan/rembulan-compiler "0.1-SNAPSHOT"] + ;; ;; Ruby + ;; [org.jruby/jruby-complete "9.1.16.0"] + ;; ;; Python + ;; [org.python/jython-standalone "2.7.1"] + ;; ;; Scheme + ;; [kawa-scheme/kawa-core "2.4"] + ;; ;; Common Lisp + ;; [org.abcl/abcl "1.5.0"] + ;; ;; PHP 5 + ;; [org.develnext.jphp/jphp-core "0.9.2"] + ;; [org.develnext.jphp/jphp-scripting "0.9.2"] + ] :source-paths ["source"] :test-paths ["test"] diff --git a/new-luxc/source/luxc/lang/translation/r.lux b/new-luxc/source/luxc/lang/translation/r.lux index 7dc84700f..a013bfd1c 100644 --- a/new-luxc/source/luxc/lang/translation/r.lux +++ b/new-luxc/source/luxc/lang/translation/r.lux @@ -48,9 +48,6 @@ (host.import: javax/script/ScriptEngineFactory (getScriptEngine [] ScriptEngine)) -(host.import: org/renjin/script/RenjinScriptEngineFactory - (new [])) - (type: #export Anchor [Text Register]) (type: #export Host @@ -63,7 +60,7 @@ (def: #export init (IO Host) - (io (let [interpreter (|> (RenjinScriptEngineFactory::new []) + (io (let [interpreter (|> (undefined) (ScriptEngineFactory::getScriptEngine []))] {#context ["" +0] #anchor #.None diff --git a/new-luxc/source/luxc/lang/translation/r/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/r/eval.jvm.lux deleted file mode 100644 index 0bfd50aa8..000000000 --- a/new-luxc/source/luxc/lang/translation/r/eval.jvm.lux +++ /dev/null @@ -1,154 +0,0 @@ -(.module: - lux - (lux (control ["ex" exception #+ exception:] - [monad #+ do]) - (data [bit] - [maybe] - ["e" error #+ Error] - text/format - (coll [array])) - [host]) - (luxc [lang] - (lang (host [r #+ Expression]))) - [//]) - -(do-template [<name>] - [(exception: #export (<name> {message Text}) - message)] - - [Unknown-Kind-Of-Host-Object] - [Null-Has-No-Lux-Representation] - [Cannot-Evaluate] - ) - -(host.import: java/lang/Object - (toString [] String) - (getClass [] (Class Object))) - -(host.import: java/lang/Long - (intValue [] Integer)) - -(host.import: org/renjin/sexp/SEXP) - -(host.import: org/renjin/sexp/StringArrayVector - (getElementAsString [int] String)) - -(host.import: org/renjin/sexp/LogicalArrayVector - (getElementAsRawLogical [int] int)) - -(host.import: org/renjin/sexp/IntArrayVector - (getElementAsInt [int] int)) - -(host.import: org/renjin/sexp/DoubleArrayVector - (getElementAsDouble [int] double)) - -(host.import: org/renjin/sexp/ListVector - (length [] int) - (getElementAsSEXP [int] #try SEXP) - (getElementAsSEXP #as get-field-sexp [String] #try SEXP)) - -(host.import: org/renjin/sexp/Null) - -(def: (parse-tuple lux-object host-object) - (-> (-> Object (Error Any)) ListVector (Error Any)) - (let [size (:coerce Nat (ListVector::length [] host-object))] - (loop [idx +0 - output (:coerce (Array Any) (array.new size))] - (if (n/< size idx) - (case (ListVector::getElementAsSEXP [(:coerce Int idx)] host-object) - (#e.Error error) - (#e.Error error) - - (#e.Success value) - (case (lux-object (:coerce Object value)) - (#e.Error error) - (#e.Error error) - - (#e.Success lux-value) - (recur (inc idx) (array.write idx (:coerce Any lux-value) output)))) - (#e.Success output))))) - -(def: (parse-variant lux-object host-object) - (-> (-> Object (Error Any)) ListVector (Error Any)) - (do e.Monad<Error> - [tag (ListVector::get-field-sexp [//.variant-tag-field] host-object) - flag (ListVector::get-field-sexp [//.variant-flag-field] host-object) - value (ListVector::get-field-sexp [//.variant-value-field] host-object) - value (lux-object (:coerce Object value))] - (wrap [(|> tag - (:coerce IntArrayVector) - (IntArrayVector::getElementAsInt [0]) - (Long::intValue [])) - (: Any - (if (host.instance? Null flag) - (host.null) - //.unit)) - value]))) - -(def: (parse-int host-object) - (-> ListVector (Error Int)) - (do e.Monad<Error> - [high (ListVector::get-field-sexp [//.int-high-field] host-object) - low (ListVector::get-field-sexp [//.int-low-field] host-object) - #let [get-int-32 (|>> (IntArrayVector::getElementAsInt [0]) (:coerce Nat)) - high (get-int-32 (:coerce IntArrayVector high)) - low (get-int-32 (:coerce IntArrayVector low))]] - (wrap (:coerce Int - (n/+ (|> high (bit.left-shift +32)) - (if (i/< 0 (:coerce Int low)) - (|> low (bit.left-shift +32) (bit.logical-right-shift +32)) - low)))))) - -(def: (lux-object host-object) - (-> Object (Error Any)) - (cond (host.instance? StringArrayVector host-object) - (#e.Success (StringArrayVector::getElementAsString [0] (:coerce StringArrayVector host-object))) - - (host.instance? LogicalArrayVector host-object) - (#e.Success (i/= 1 (LogicalArrayVector::getElementAsRawLogical [0] (:coerce LogicalArrayVector host-object)))) - - (host.instance? IntArrayVector host-object) - (#e.Success (IntArrayVector::getElementAsInt [0] (:coerce IntArrayVector host-object))) - - (host.instance? DoubleArrayVector host-object) - (#e.Success (DoubleArrayVector::getElementAsDouble [0] (:coerce DoubleArrayVector host-object))) - - (host.instance? ListVector host-object) - (case (parse-int (:coerce ListVector host-object)) - (#e.Error error) - (case (parse-variant lux-object (:coerce ListVector host-object)) - (#e.Error error) - (parse-tuple lux-object (:coerce ListVector host-object)) - - output - output) - - output - output) - - ## else - (let [object-class (:coerce Text (Object::toString [] (Object::getClass [] (:coerce Object host-object)))) - text-representation (:coerce Text (Object::toString [] (:coerce Object host-object)))] - (ex.throw Unknown-Kind-Of-Host-Object (format object-class " --- " text-representation))))) - -(def: #export (eval code) - (-> Expression (Meta Any)) - (function (_ compiler) - (let [interpreter (|> compiler (get@ #.host) (:coerce //.Host) (get@ #//.interpreter))] - (case (interpreter code) - (#e.Error error) - (exec (log! (format "eval #e.Error\n" - "<< " (r.expression code) "\n" - 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) - (exec (log! (format "eval #e.Error\n" - "<< " (r.expression code) "\n" - error)) - ((lang.throw Cannot-Evaluate error) compiler))))))) |