aboutsummaryrefslogtreecommitdiff
path: root/lux-r/source/program.lux
diff options
context:
space:
mode:
Diffstat (limited to 'lux-r/source/program.lux')
-rw-r--r--lux-r/source/program.lux413
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
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-20 00:10:48 +0000