diff options
Diffstat (limited to 'lux-r')
-rw-r--r-- | lux-r/source/program.lux | 413 |
1 files changed, 291 insertions, 122 deletions
diff --git a/lux-r/source/program.lux b/lux-r/source/program.lux index 19dd01630..5e5523e83 100644 --- a/lux-r/source/program.lux +++ b/lux-r/source/program.lux @@ -20,8 +20,10 @@ ["." utf8]]] [collection ["." array (#+ Array)]]] - [macro - ["." template]] + ["." macro + [syntax (#+ syntax:)] + ["." template] + ["." code]] [math [number (#+ hex) ["n" nat] @@ -93,6 +95,12 @@ ["#::." (asInt [] int)]) +(ffi.import: org/renjin/sexp/AttributeMap + ["#::." + (#static EMPTY org/renjin/sexp/AttributeMap)]) + +(ffi.import: org/renjin/sexp/AbstractSEXP) + (ffi.import: org/renjin/sexp/IntArrayVector) (ffi.import: org/renjin/sexp/Logical @@ -119,13 +127,34 @@ (get #as get_field [java/lang/String] org/renjin/sexp/SEXP) (length [] int)]) -(ffi.import: org/renjin/sexp/Closure) +(ffi.import: org/renjin/sexp/PairList) + +(ffi.import: org/renjin/sexp/PairList$Builder + ["#::." + (new []) + (add [org/renjin/sexp/SEXP] org/renjin/sexp/PairList$Builder) + (build [] org/renjin/sexp/PairList)]) + +(ffi.import: org/renjin/eval/Context) + +(ffi.import: org/renjin/sexp/Environment) + +(ffi.import: org/renjin/sexp/FunctionCall + ["#::." + (new [org/renjin/sexp/SEXP org/renjin/sexp/PairList]) + (eval [org/renjin/eval/Context org/renjin/sexp/Environment] #try org/renjin/sexp/SEXP)]) + +(ffi.import: org/renjin/sexp/Closure + ["#::." + (getEnclosingEnvironment [] org/renjin/sexp/Environment)]) (ffi.import: javax/script/ScriptEngine ["#::." (eval [java/lang/String] #try java/lang/Object)]) -(ffi.import: org/renjin/script/RenjinScriptEngine) +(ffi.import: org/renjin/script/RenjinScriptEngine + ["#::." + (getRuntimeContext [] org/renjin/eval/Context)]) (ffi.import: org/renjin/script/RenjinScriptEngineFactory ["#::." @@ -147,57 +176,172 @@ ## (|>> (case> #0 (org/armedbear/lisp/Nil::NIL) ## #1 (org/armedbear/lisp/Symbol::T)))) -## (def: (host_value value) -## (-> Any org/armedbear/lisp/LispObject) -## (let [to_sub (: (-> Any org/armedbear/lisp/LispObject) -## (function (_ sub_value) -## (let [sub_value (:coerce java/lang/Object sub_value)] -## (`` (<| (~~ (template [<type> <then>] -## [(case (ffi.check <type> sub_value) -## (#.Some sub_value) -## (`` (|> sub_value (~~ (template.splice <then>)))) -## #.None)] - -## [[java/lang/Object] [host_value]] -## [java/lang/Boolean [..host_bit]] -## [java/lang/Integer [java/lang/Integer::longValue org/armedbear/lisp/Fixnum::getInstance]] -## [java/lang/Long [org/armedbear/lisp/Bignum::getInstance]] -## [java/lang/Double [org/armedbear/lisp/DoubleFloat::new]] -## [java/lang/String [org/armedbear/lisp/SimpleString::new]] -## )) -## ## else -## (:coerce org/armedbear/lisp/LispObject sub_value))))))] -## (`` (ffi.object [] org/armedbear/lisp/LispObject [program/LuxADT] -## [] -## ## Methods -## (program/LuxADT -## [] (getValue self) java/lang/Object -## (:coerce java/lang/Object value)) - -## (org/armedbear/lisp/LispObject -## [] (length self) -## int -## (|> value -## (:coerce (Array java/lang/Object)) -## array.size -## (:coerce java/lang/Long) -## java/lang/Number::intValue)) - -## (~~ (template [<name>] -## [(org/armedbear/lisp/LispObject -## [] (<name> self {idx int}) -## org/armedbear/lisp/LispObject -## (case (array.read (|> idx java/lang/Integer::longValue (:coerce Nat)) -## (:coerce (Array java/lang/Object) value)) -## (#.Some sub) -## (to_sub sub) - -## #.None -## (org/armedbear/lisp/Nil::NIL)))] - -## [NTH] [SVREF] [elt] -## )) -## )))) +(syntax: (%%code term) + (wrap (list (code.text (%.code term))))) + +(def: (host_value value) + (-> Any org/renjin/sexp/SEXP) + (let [## to_sub (: (-> Any org/armedbear/lisp/LispObject) + ## (function (_ sub_value) + ## (let [sub_value (:coerce java/lang/Object sub_value)] + ## (`` (<| (~~ (template [<type> <then>] + ## [(case (ffi.check <type> sub_value) + ## (#.Some sub_value) + ## (`` (|> sub_value (~~ (template.splice <then>)))) + ## #.None)] + + ## [[java/lang/Object] [host_value]] + ## [java/lang/Boolean [..host_bit]] + ## [java/lang/Integer [java/lang/Integer::longValue org/armedbear/lisp/Fixnum::getInstance]] + ## [java/lang/Long [org/armedbear/lisp/Bignum::getInstance]] + ## [java/lang/Double [org/armedbear/lisp/DoubleFloat::new]] + ## [java/lang/String [org/armedbear/lisp/SimpleString::new]] + ## )) + ## ## else + ## (:coerce org/armedbear/lisp/LispObject sub_value)))))) + ] + (`` (macro.log_expand_once! + (ffi.object [] + ## org/renjin/sexp/AbstractSEXP + org/renjin/sexp/ListVector + ## java/lang/Object + [ ## program/LuxADT + ## org/renjin/sexp/SEXP + ] + [{[org/renjin/sexp/SEXP] + (ffi.array org/renjin/sexp/SEXP 0) + + ## (java/util/List java/lang/Object) + ## (:assume (..fake_list [])) + }] + ## Methods + ## (program/LuxADT + ## [] (getValue self) java/lang/Object + ## (:coerce java/lang/Object value)) + + ## (org/renjin/sexp/AbstractSEXP + ## [] (eval self {context org/renjin/eval/Context} {environment org/renjin/sexp/Environment}) + ## org/renjin/sexp/SEXP + ## (exec + ## ("lux io log" (exception.report + ## ["@@" "eval"] + ## ["context" (debug.inspect context)] + ## ["environment" (debug.inspect environment)])) + ## self)) + + ## (org/renjin/sexp/AbstractSEXP + ## [] (getAttributes self) + ## org/renjin/sexp/AttributeMap + ## (org/renjin/sexp/AttributeMap::EMPTY)) + + ## (org/renjin/sexp/AbstractSEXP + ## [] (getTypeName self) + ## java/lang/String + ## "LUX") + + (org/renjin/sexp/ListVector + [] (get self {_ int}) + org/renjin/sexp/SEXP + (exec + ## ("lux io log" (..%%code <call>)) + _jvm_this)) + + (org/renjin/sexp/ListVector + [] (get self {_ java/lang/String}) + org/renjin/sexp/SEXP + (exec + ## ("lux io log" (..%%code <call>)) + _jvm_this)) + + (~~ (template [<call> <output>] + [(org/renjin/sexp/ListVector + ## org/renjin/sexp/AbstractSEXP + ## org/renjin/sexp/SEXP + [] <call> + <output> + ## (exec + ## ## ("lux io log" (..%%code <call>)) + ## (error! (..%%code <call>))) + (error! (..%%code <call>)))] + + ## org/renjin/sexp/ListVector + [(accept self {_ org/renjin/sexp/SexpVisitor}) void] + [(anyNA self) boolean] + [(contains self {_ org/renjin/sexp/Vector} {_ int}) boolean] + ## [(copyTo self {_ [double]} {_ int} {_ int}) void] + [(equals self {_ java/lang/Object}) boolean] + + [(getComputationDepth self) int] + [(getElementAsByte self {_ int}) byte] + [(getElementAsComplex self {_ int}) org/apache/commons/math/complex/Complex] + [(getElementAsComplexIm self {_ int}) double] + [(getElementAsDouble self {_ int}) double] + + [(getElementAsDouble self {_ java/lang/String}) double] + [(getElementAsInt self {_ int}) int] + [(getElementAsInt self {_ java/lang/String}) int] + [(getElementAsList self {_ java/lang/String}) org/renjin/sexp/ListVector] + [(getElementAsLogical self {_ int}) org/renjin/sexp/Logical] + [(getElementAsObject self {_ int}) java/lang/Object] + [(getElementAsRawLogical self {_ int}) int] + [(getElementAsSEXP self {_ int}) org/renjin/sexp/SEXP] + [(getElementAsSEXP self {_ java/lang/String}) org/renjin/sexp/SEXP] + [(getElementAsString self {_ int}) java/lang/String] + [(getElementAsString self {_ java/lang/String}) java/lang/String] + [(getElementAsVector self {_ java/lang/String}) org/renjin/sexp/Vector] + + [(getTypeName self) java/lang/String] + [(getVectorType self) org/renjin/sexp/Vector$Type] + [(indexOf self {_ org/renjin/sexp/Vector} {_ int} {_ int}) int] + [(indexOfName self {_ java/lang/String}) int] + [(isConstantAccessTime self) boolean] + [(isDeferred self) boolean] + [(isElementNA self {_ int}) boolean] + [(isElementNaN self {_ int}) boolean] + [(isElementTrue self {_ int}) boolean] + [(iterator self) (java/util/Iterator org/renjin/sexp/SEXP)] + [(length self) int] + [(maxElementLength self) int] + [(minElementLength self) int] + [(namedValues self) (java/lang/Iterable org/renjin/sexp/NamedValue)] + [(newBuilderWithInitialCapacity self {_ int}) org/renjin/sexp/ListVector$Builder] + [(newBuilderWithInitialSize self {_ int}) org/renjin/sexp/Vector$Builder] + [(newCopyBuilder self) org/renjin/sexp/ListVector$Builder] + [(newCopyBuilder self {_ org/renjin/sexp/Vector$Type}) org/renjin/sexp/Vector$Builder] + [(newCopyNamedBuilder self) org/renjin/sexp/ListVector$NamedBuilder] + [(promise self {_ org/renjin/sexp/Environment}) org/renjin/sexp/SEXP] + [(repromise self) org/renjin/sexp/SEXP] + [(repromise self {_ org/renjin/sexp/SEXP}) org/renjin/sexp/SEXP] + [(toArrayUnsafe self) [org/renjin/sexp/SEXP]] + [(toString self) java/lang/String] + + ## org/renjin/sexp/AbstractSEXP + ## org/renjin/sexp/SEXP + ## [(accept self {_ org/renjin/sexp/SexpVisitor}) void] + ## [(asInt self) int] + ## [(asLogical self) org/renjin/sexp/Logical] + ## [(asReal self) double] + ## [(asString self) java/lang/String] + ## [(force self {_ org/renjin/eval/Context}) org/renjin/sexp/SEXP] + ## [(getAttribute self {_ org/renjin/sexp/Symbol}) org/renjin/sexp/SEXP] + ## [(getElementAsSEXP self {_ int}) org/renjin/sexp/SEXP] + ## [(getImplicitClass self) java/lang/String] + ## ## [(getIndexByName self {_ java/lang/String}) int] + ## [(getName self {_ int}) java/lang/String] + ## [(getNames self) org/renjin/sexp/AtomicVector] + ## [(getS3Class self) org/renjin/sexp/StringVector] + ## ## [(hasAttributes self) boolean] + ## [(hasNames self) boolean] + ## [(inherits self {_ java/lang/String}) boolean] + ## [(isNumeric self) boolean] + ## ## [(isObject self) boolean] + ## [(length self) int] + ## ## [(setAttribute self {_ java/lang/String} {_ org/renjin/sexp/SEXP}) org/renjin/sexp/SEXP] + ## [(setAttribute self {_ org/renjin/sexp/Symbol} {_ org/renjin/sexp/SEXP}) org/renjin/sexp/SEXP] + ## [(setAttributes self {_ org/renjin/sexp/AttributeMap$Builder}) org/renjin/sexp/SEXP] + ## [(setAttributes self {_ org/renjin/sexp/AttributeMap}) org/renjin/sexp/SEXP] + )) + ))))) (type: (Reader a) (-> a (Try Any))) @@ -300,29 +444,51 @@ (exception.throw ..unknown_kind_of_object [host_object]) )))) -## (def: ensure_macro -## (-> Macro (Maybe org/armedbear/lisp/Closure)) -## (|>> (:coerce java/lang/Object) (ffi.check org/armedbear/lisp/Closure))) - -## (def: (call_macro inputs lux macro) -## (-> (List Code) Lux org/armedbear/lisp/Closure (Try (Try [Lux (List Code)]))) -## (do try.monad -## [raw_output (org/armedbear/lisp/LispObject::execute (..host_value inputs) (..host_value lux) macro)] -## (:coerce (Try (Try [Lux (List Code)])) -## (..read raw_output)))) - -(def: (expander macro inputs lux) - Expander - ## (case (ensure_macro macro) - ## (#.Some macro) - ## (call_macro inputs lux macro) - - ## #.None - ## (exception.throw ..cannot_apply_a_non_function (:coerce java/lang/Object macro))) - (exception.throw ..cannot_apply_a_non_function (:coerce java/lang/Object macro))) +(def: ensure_macro + (-> Macro (Maybe org/renjin/sexp/Closure)) + (|>> (:coerce java/lang/Object) (ffi.check org/renjin/sexp/Closure))) + +(def: (call_macro interpreter inputs lux macro) + (-> org/renjin/script/RenjinScriptEngine (List Code) Lux org/renjin/sexp/Closure (Try (Try [Lux (List Code)]))) + (let [_ ("lux io log" "@call_macro 0") + r_inputs (: org/renjin/sexp/PairList + (case (ffi.try (|> (org/renjin/sexp/PairList$Builder::new) + (org/renjin/sexp/PairList$Builder::add (..host_value inputs)) + (org/renjin/sexp/PairList$Builder::add (..host_value lux)) + org/renjin/sexp/PairList$Builder::build + (:coerce org/renjin/sexp/PairList))) + (#try.Success r_inputs) + r_inputs + + (#try.Failure error) + (exec + ("lux io log" error) + (error! error)))) + _ ("lux io log" "@call_macro 1") + r_macro (org/renjin/sexp/FunctionCall::new macro r_inputs) + _ ("lux io log" "@call_macro 2") + r_environment (org/renjin/sexp/Closure::getEnclosingEnvironment macro) + _ ("lux io log" "@call_macro 3") + r_context (org/renjin/script/RenjinScriptEngine::getRuntimeContext interpreter) + _ ("lux io log" "@call_macro 4")] + (do try.monad + [raw_output (org/renjin/sexp/FunctionCall::eval r_context r_environment r_macro) + #let [_ ("lux io log" "@call_macro 5")]] + (:coerce (Try (Try [Lux (List Code)])) + (..read (:coerce java/lang/Object raw_output)))))) + +(def: (expander interpreter macro inputs lux) + (-> org/renjin/script/RenjinScriptEngine Expander) + (case (ensure_macro macro) + (#.Some macro) + (call_macro interpreter inputs lux macro) + + #.None + (exception.throw ..cannot_apply_a_non_function [(:coerce java/lang/Object macro)]))) (def: host - (IO (Host _.Expression _.Expression)) + (IO [org/renjin/script/RenjinScriptEngine + (Host _.Expression _.Expression)]) (io (let [interpreter (|> (org/renjin/script/RenjinScriptEngineFactory::new) org/renjin/script/RenjinScriptEngineFactory::getScriptEngine) run! (: (-> (_.Code Any) (Try Any)) @@ -330,53 +496,56 @@ (do try.monad [host_value (javax/script/ScriptEngine::eval (_.code code) interpreter)] (read host_value))))] - (: (Host _.Expression _.Expression) - (structure - (def: (evaluate! context code) - (exec ("lux io log" "@evaluate!") - (run! code))) - - (def: (execute! input) - (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) - #let [_ ("lux io log" "@define! 1")] - value (run! $global) - #let [_ ("lux io log" "@define! 2")]] - (wrap [global value definition])))) - - (def: (ingest context content) - (|> content (\ utf8.codec decode) try.assume (:coerce _.Expression))) - - (def: (re_learn context content) - (run! content)) - - (def: (re_load context content) - (do try.monad - [_ (run! content)] - (run! (_.var (reference.artifact context))))) - ))))) + [(:coerce org/renjin/script/RenjinScriptEngine interpreter) + (: (Host _.Expression _.Expression) + (structure + (def: (evaluate! context code) + (exec ("lux io log" "@evaluate!") + (run! code))) + + (def: (execute! input) + (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) + #let [_ ("lux io log" "@define! 1")] + value (run! $global) + #let [_ ("lux io log" "@define! 2")]] + (wrap [global value definition])))) + + (def: (ingest context content) + (|> content (\ utf8.codec decode) try.assume (:coerce _.Expression))) + + (def: (re_learn context content) + (run! content)) + + (def: (re_load context content) + (do try.monad + [_ (run! content)] + (run! (_.var (reference.artifact context))))) + ))]))) (def: platform - (IO (Platform _.SVar _.Expression _.Expression)) + (IO [org/renjin/script/RenjinScriptEngine + (Platform _.SVar _.Expression _.Expression)]) (do io.monad - [host ..host] - (wrap {#platform.&file_system (file.async file.default) - #platform.host host - #platform.phase r.generate - #platform.runtime runtime.generate - #platform.write (|>> _.code (\ utf8.codec encode))}))) + [[interpreter host] ..host] + (wrap [interpreter + {#platform.&file_system (file.async file.default) + #platform.host host + #platform.phase r.generate + #platform.runtime runtime.generate + #platform.write (|>> _.code (\ utf8.codec encode))}]))) (def: (program context program) (Program _.Expression _.Expression) @@ -421,13 +590,13 @@ (`` (program: [{service /cli.service}] (let [extension ".r"] (do io.monad - [platform ..platform] + [[interpreter platform] ..platform] (exec (do promise.monad [_ (/.compiler {#/static.host @.r #/static.host_module_extension extension #/static.target (/cli.target service) #/static.artifact_extension extension} - ..expander + (..expander interpreter) analysis.bundle (io.io platform) generation.bundle |