diff options
Diffstat (limited to 'lux-r')
| -rw-r--r-- | lux-r/commands.md | 10 | ||||
| -rw-r--r-- | lux-r/source/program.lux | 195 |
2 files changed, 142 insertions, 63 deletions
diff --git a/lux-r/commands.md b/lux-r/commands.md index dd982fab6..33154ba7a 100644 --- a/lux-r/commands.md +++ b/lux-r/commands.md @@ -25,11 +25,9 @@ cd ~/lux/lux-r/ && java -jar target/program.jar repl --source ~/lux/stdlib/sourc ## Try ``` -cd ~/lux/lux-r/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux -cd ~/lux/stdlib/ && lein clean && cd ~/lux/lux-r/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux -cd ~/lux/stdlib/ && lein clean && cd ~/lux/lux-r/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --library ~/lux/stdlib/target/library.tar --target ~/lux/stdlib/target --module test/lux -cd ~/lux/lux-r/ && java -jar target/program.jar export --source ~/lux/stdlib/source --target ~/lux/stdlib/target - -cd ~/lux/stdlib/target/ && java -jar program.jar +## Compile Lux's Standard Library's tests using a JVM-based compiler. +cd ~/lux/stdlib/ \ +&& lein clean \ +&& time java -jar ~/lux/lux-r/target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux ``` diff --git a/lux-r/source/program.lux b/lux-r/source/program.lux index 183797d4f..19dd01630 100644 --- a/lux-r/source/program.lux +++ b/lux-r/source/program.lux @@ -89,6 +89,38 @@ (longValue [] long) (doubleValue [] double)]) +(ffi.import: org/renjin/sexp/SEXP + ["#::." + (asInt [] int)]) + +(ffi.import: org/renjin/sexp/IntArrayVector) + +(ffi.import: org/renjin/sexp/Logical + ["#::." + (toBooleanStrict [] boolean)]) + +(ffi.import: org/renjin/sexp/LogicalVector + ["#::." + (asLogical [] org/renjin/sexp/Logical)]) + +(ffi.import: org/renjin/sexp/LogicalArrayVector) + +(ffi.import: org/renjin/sexp/StringVector + ["#::." + (asString [] java/lang/String)]) + +(ffi.import: org/renjin/sexp/StringArrayVector) + +(ffi.import: org/renjin/sexp/Null) + +(ffi.import: org/renjin/sexp/ListVector + ["#::." + (get #as get_index [int] org/renjin/sexp/SEXP) + (get #as get_field [java/lang/String] org/renjin/sexp/SEXP) + (length [] int)]) + +(ffi.import: org/renjin/sexp/Closure) + (ffi.import: javax/script/ScriptEngine ["#::." (eval [java/lang/String] #try java/lang/Object)]) @@ -170,63 +202,103 @@ (type: (Reader a) (-> a (Try Any))) -## (def: (read_variant read host_object) -## (-> (Reader org/armedbear/lisp/LispObject) (Reader org/armedbear/lisp/Cons)) -## (do try.monad -## [tag (read (org/armedbear/lisp/LispObject::NTH +0 host_object)) -## value (read (org/armedbear/lisp/LispObject::NTH +2 host_object))] -## (wrap [(java/lang/Long::intValue (:coerce java/lang/Long tag)) -## (case (ffi.check org/armedbear/lisp/Nil (org/armedbear/lisp/LispObject::NTH +1 host_object)) -## (#.Some _) -## (: Any (ffi.null)) - -## _ -## (: Any synthesis.unit)) -## value]))) - -## (def: (read_tuple read host_object) -## (-> (Reader org/armedbear/lisp/LispObject) (Reader org/armedbear/lisp/SimpleVector)) -## (let [size (.nat (org/armedbear/lisp/LispObject::length host_object))] -## (loop [idx 0 -## output (:coerce (Array Any) (array.new size))] -## (if (n.< size idx) -## ## TODO: Start using "SVREF" instead of "elt" ASAP -## (case (read (org/armedbear/lisp/LispObject::elt (.int idx) host_object)) -## (#try.Failure error) -## (#try.Failure error) - -## (#try.Success member) -## (recur (inc idx) (array.write! idx (:coerce Any member) output))) -## (#try.Success output))))) +(def: (read_variant read host_object) + (-> (Reader java/lang/Object) (Reader org/renjin/sexp/ListVector)) + (do try.monad + [tag (|> host_object + (org/renjin/sexp/ListVector::get_field runtime.variant_tag_field) + (:coerce java/lang/Object) + read) + value (|> host_object + (org/renjin/sexp/ListVector::get_field runtime.variant_value_field) + (:coerce java/lang/Object) + read)] + (wrap [(|> tag (:coerce java/lang/Long) java/lang/Long::intValue) + (case (|> host_object + (org/renjin/sexp/ListVector::get_field runtime.variant_flag_field) + (ffi.check org/renjin/sexp/Null)) + (#.Some _) + (: Any (ffi.null)) + + _ + (: Any synthesis.unit)) + value]))) + +(def: (read_i64 host_object) + (Reader org/renjin/sexp/ListVector) + (case [(|> host_object + (org/renjin/sexp/ListVector::get_field runtime.i64_high_field) + (ffi.check org/renjin/sexp/IntArrayVector)) + (|> host_object + (org/renjin/sexp/ListVector::get_field runtime.i64_low_field) + (ffi.check org/renjin/sexp/IntArrayVector))] + [(#.Some high) (#.Some low)] + (#try.Success (runtime.lux_i64 (org/renjin/sexp/SEXP::asInt high) + (org/renjin/sexp/SEXP::asInt low))) + + _ + (#try.Failure ""))) + +(def: (read_tuple read host_object) + (-> (Reader java/lang/Object) (Reader org/renjin/sexp/ListVector)) + (let [size (.nat (org/renjin/sexp/ListVector::length host_object))] + (loop [idx 0 + output (:coerce (Array Any) (array.new size))] + (if (n.< size idx) + (case (|> host_object (org/renjin/sexp/ListVector::get_index (.int idx)) (:coerce java/lang/Object) read) + (#try.Failure error) + (#try.Failure error) + + (#try.Success member) + (recur (inc idx) (array.write! idx (:coerce Any member) output))) + (#try.Success output))))) + +(def: (field_class field host_object) + (-> Text org/renjin/sexp/ListVector Text) + (|> host_object + (org/renjin/sexp/ListVector::get_field field) + java/lang/Object::getClass + java/lang/Object::toString + (:coerce Text))) (def: (read host_object) (Reader java/lang/Object) - (`` (<| ## (~~ (template [<class> <post_processing>] - ## [(case (ffi.check <class> host_object) - ## (#.Some host_object) - ## (`` (|> host_object (~~ (template.splice <post_processing>)))) - - ## #.None)] - - ## [org/armedbear/lisp/Bignum [org/armedbear/lisp/Bignum::longValue #try.Success]] - ## [org/armedbear/lisp/Fixnum [org/armedbear/lisp/Fixnum::longValue #try.Success]] - ## [org/armedbear/lisp/DoubleFloat [org/armedbear/lisp/DoubleFloat::doubleValue #try.Success]] - ## [org/armedbear/lisp/SimpleString [org/armedbear/lisp/SimpleString::getStringValue #try.Success]] - ## [org/armedbear/lisp/Cons [(read_variant read)]] - ## [org/armedbear/lisp/SimpleVector [(read_tuple read)]] - ## [org/armedbear/lisp/Nil [(new> (#try.Success false) [])]] - ## [org/armedbear/lisp/Closure [#try.Success]] - ## [program/LuxADT [program/LuxADT::getValue #try.Success]])) - ## (case (ffi.check org/armedbear/lisp/Symbol host_object) - ## (#.Some host_object) - ## (if (is? (org/armedbear/lisp/Symbol::T) host_object) - ## (#try.Success true) - ## (exception.throw ..unknown_kind_of_object [host_object])) - - ## #.None) - ## else - (exception.throw ..unknown_kind_of_object [host_object]) - ))) + (exec + ## ("lux io log" (exception.construct ..unknown_kind_of_object [host_object])) + (`` (<| (case (ffi.check org/renjin/sexp/ListVector host_object) + (#.Some host_object) + (<| (case (..read_variant read host_object) + (#try.Success output) + (#try.Success output) + + (#try.Failure _)) + (case (..read_i64 host_object) + (#try.Success output) + (#try.Success output) + + (#try.Failure _)) + (..read_tuple read host_object)) + + #.None) + (~~ (template [<class> <post_processing>] + [(case (ffi.check <class> host_object) + (#.Some host_object) + (`` (|> host_object (~~ (template.splice <post_processing>)))) + + #.None)] + + [org/renjin/sexp/StringArrayVector [org/renjin/sexp/StringVector::asString #try.Success]] + [org/renjin/sexp/IntArrayVector [org/renjin/sexp/SEXP::asInt #try.Success]] + [org/renjin/sexp/LogicalArrayVector [org/renjin/sexp/LogicalVector::asLogical + org/renjin/sexp/Logical::toBooleanStrict + #try.Success]] + [org/renjin/sexp/Closure [#try.Success]] + ## [org/armedbear/lisp/DoubleFloat [org/armedbear/lisp/DoubleFloat::doubleValue #try.Success]] + ## [program/LuxADT [program/LuxADT::getValue #try.Success]] + )) + ## else + (exception.throw ..unknown_kind_of_object [host_object]) + )))) ## (def: ensure_macro ## (-> Macro (Maybe org/armedbear/lisp/Closure)) @@ -261,18 +333,27 @@ (: (Host _.Expression _.Expression) (structure (def: (evaluate! context code) - (run! code)) + (exec ("lux io log" "@evaluate!") + (run! code))) (def: (execute! input) - (javax/script/ScriptEngine::eval (_.code input) interpreter)) + (exec + ("lux io log" "@execute!") + ("lux io log" (_.code input)) + (javax/script/ScriptEngine::eval (_.code input) interpreter))) (def: (define! context input) (let [global (reference.artifact context) $global (_.var global)] (do try.monad [#let [definition (_.set! $global input)] + #let [_ ("lux io log" "@define! 0") + _ ("lux io log" (_.code definition)) + ] _ (javax/script/ScriptEngine::eval (_.code definition) interpreter) - value (run! $global)] + #let [_ ("lux io log" "@define! 1")] + value (run! $global) + #let [_ ("lux io log" "@define! 2")]] (wrap [global value definition])))) (def: (ingest context content) |