diff options
Diffstat (limited to '')
| -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 | 
2 files changed, 1 insertions, 158 deletions
| 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))))))) | 
