Postponing work on R due to flaws of the bootstrapping compiler.

Will resume once the new JVM compiler replaces the bootstrapping compiler.

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