aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--documentation/bookmark/math.md2
-rw-r--r--lux-r/commands.md10
-rw-r--r--lux-r/source/program.lux195
-rw-r--r--stdlib/source/lux/target/r.lux73
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux67
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux112
6 files changed, 277 insertions, 182 deletions
diff --git a/documentation/bookmark/math.md b/documentation/bookmark/math.md
index f50c1fc50..9d5309612 100644
--- a/documentation/bookmark/math.md
+++ b/documentation/bookmark/math.md
@@ -79,6 +79,7 @@
1. https://www.3dgep.com/understanding-quaternions/
1. https://probablydance.com/2017/08/05/intuitive-quaternions/
1. [Quaternion algebras](https://math.dartmouth.edu/~jvoight/quat.html)
+1. [Rotations with quaternions](https://imadr.github.io/rotations-with-quaternions/)
# _Compendium of resources_
@@ -150,6 +151,7 @@
1. https://www.math3ma.com/blog/matrices-as-tensor-network-diagrams
1. [Convolution is outer product](https://arxiv.org/abs/1905.01289)
1. [Graphical Calculus for products and convolutions](https://arxiv.org/abs/1903.01366)
+1. [3 Point Parameterization of Affine Transform](https://www.catid.io/affine3)
# Domain Theory
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)
diff --git a/stdlib/source/lux/target/r.lux b/stdlib/source/lux/target/r.lux
index c60456ad2..2e8283a9e 100644
--- a/stdlib/source/lux/target/r.lux
+++ b/stdlib/source/lux/target/r.lux
@@ -71,11 +71,13 @@
(:abstraction
(format "(" code ")")))
+ (def: nested_new_line
+ (format text.new_line text.tab))
+
(def: nest
(-> Text Text)
- (let [nested_new_line (format text.new_line text.tab)]
- (|>> (format text.new_line)
- (text.replace_all text.new_line nested_new_line))))
+ (|>> (text.replace_all text.new_line ..nested_new_line)
+ (format ..nested_new_line)))
(def: (_block expression)
(-> Text Text)
@@ -84,12 +86,14 @@
(def: #export (block expression)
(-> Expression Expression)
(:abstraction
- (format "{" (:representation expression) "}")))
+ (format "{"
+ (..nest (:representation expression))
+ text.new_line "}")))
(template [<name> <r>]
[(def: #export <name>
Expression
- (..self_contained <r>))]
+ (:abstraction <r>))]
[null "NULL"]
[n/a "NA"]
@@ -107,11 +111,11 @@
(-> Bit Expression)
(|>> (case> #0 "FALSE"
#1 "TRUE")
- ..self_contained))
+ :abstraction))
(def: #export (int value)
(-> Int Expression)
- (..self_contained (format "as.integer(" (%.int value) ")")))
+ (:abstraction (format "as.integer(" (%.int value) ")")))
(def: #export float
(-> Frac Expression)
@@ -146,31 +150,8 @@
(def: #export string
(-> Text Expression)
- (|>> %.text ..sanitize ..self_contained))
-
- (def: (composite_literal left_delimiter right_delimiter entry_serializer)
- (All [a] (-> Text Text (-> a Text)
- (-> (List a) Expression)))
- (.function (_ entries)
- (..self_contained
- (format left_delimiter
- (|> entries (list\map entry_serializer) (text.join_with ","))
- right_delimiter))))
-
- (def: #export named_list
- (-> (List [Text Expression]) Expression)
- (composite_literal "list(" ")" (.function (_ [key value])
- (format key "=" (:representation value)))))
-
- (template [<name> <function>]
- [(def: #export <name>
- (-> (List Expression) Expression)
- (composite_literal (format <function> "(") ")" ..code))]
+ (|>> ..sanitize %.text :abstraction))
- [vector "c"]
- [list "list"]
- )
-
(def: #export (slice from to list)
(-> Expression Expression Expression Expression)
(..self_contained
@@ -185,8 +166,30 @@
(def: #export (apply args func)
(-> (List Expression) Expression Expression)
- (..self_contained
- (format (:representation func) "(" (text.join_with "," (list\map ..code args)) ")")))
+ (let [func (:representation func)
+ spacing (|> " " (list.repeat (text.size func)) (text.join_with ""))]
+ (:abstraction
+ (format func "("
+ (|> args
+ (list\map ..code)
+ (text.join_with (format "," text.new_line))
+ ..nest)
+ ")"))))
+
+ (template [<name> <function>]
+ [(def: #export (<name> members)
+ (-> (List Expression) Expression)
+ (..apply members (..var <function>)))]
+
+ [vector "c"]
+ [list "list"]
+ )
+
+ (def: #export named_list
+ (-> (List [Text Expression]) Expression)
+ (|>> (list\map (.function (_ [key value])
+ (:abstraction (format key "=" (:representation value)))))
+ ..list))
(def: #export (apply_kw args kw_args func)
(-> (List Expression) (List [Text Expression]) Expression Expression)
@@ -228,9 +231,9 @@
[0
[["commandArgs"]]]
[1
- []]
+ [["intToUtf8"]]]
[2
- []]
+ [["paste"]]]
)
(def: #export (nth idx list)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux
index cb82c6cb4..d9178d8c2 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux
@@ -92,25 +92,25 @@
## ## (-> Expression Expression Expression))
## ## (//runtime.i64//64 (operation parameter subject)))
-## (def: i64_procs
-## Bundle
-## (<| (/.prefix "i64")
-## (|> /.empty
-## (/.install "and" (binary _.logand/2))
-## (/.install "or" (binary _.logior/2))
-## (/.install "xor" (binary _.logxor/2))
-## (/.install "left-shift" (binary _.ash/2))
-## (/.install "right-shift" (binary (product.uncurry //runtime.i64//right_shift)))
-## (/.install "=" (binary _.=/2))
-## (/.install "<" (binary _.</2))
-## (/.install "+" (binary _.+/2))
-## (/.install "-" (binary _.-/2))
-## (/.install "*" (binary _.*/2))
-## (/.install "/" (binary _.floor/2))
-## (/.install "%" (binary _.rem/2))
-## ## (/.install "f64" (unary (_.//2 (_.float +1.0))))
-## (/.install "char" (unary (|>> _.code-char/1 _.string/1)))
-## )))
+(def: i64_procs
+ Bundle
+ (<| (/.prefix "i64")
+ (|> /.empty
+ ## (/.install "and" (binary _.logand/2))
+ ## (/.install "or" (binary _.logior/2))
+ ## (/.install "xor" (binary _.logxor/2))
+ ## (/.install "left-shift" (binary _.ash/2))
+ ## (/.install "right-shift" (binary (product.uncurry //runtime.i64//right_shift)))
+ ## (/.install "=" (binary _.=/2))
+ ## (/.install "<" (binary _.</2))
+ ## (/.install "+" (binary _.+/2))
+ ## (/.install "-" (binary _.-/2))
+ ## (/.install "*" (binary _.*/2))
+ ## (/.install "/" (binary _.floor/2))
+ ## (/.install "%" (binary _.rem/2))
+ ## (/.install "f64" (unary (_.//2 (_.float +1.0))))
+ (/.install "char" (unary (|>> //runtime.i64_low _.intToUtf8/1)))
+ )))
## (def: f64_procs
## Bundle
@@ -140,19 +140,18 @@
## (Binary (Expression Any))
## (_.char-code/1 (_.char/2 [text index])))
-## (def: text_procs
-## Bundle
-## (<| (/.prefix "text")
-## (|> /.empty
-## (/.install "=" (binary _.string=/2))
-## ## (/.install "<" (binary (product.uncurry _.string<?/2)))
-## (/.install "concat" (binary (function (_ [left right])
-## (_.concatenate/3 [(_.symbol "string") left right]))))
-## (/.install "index" (trinary ..text//index))
-## (/.install "size" (unary _.length/1))
-## (/.install "char" (binary ..text//char))
-## (/.install "clip" (trinary ..text//clip))
-## )))
+(def: text_procs
+ Bundle
+ (<| (/.prefix "text")
+ (|> /.empty
+ ## (/.install "=" (binary _.string=/2))
+ ## (/.install "<" (binary (product.uncurry _.string<?/2)))
+ (/.install "concat" (binary _.paste/2))
+ ## (/.install "index" (trinary ..text//index))
+ ## (/.install "size" (unary _.length/1))
+ ## (/.install "char" (binary ..text//char))
+ ## (/.install "clip" (trinary ..text//clip))
+ )))
## (def: (io//log! message)
## (Unary (Expression Any))
@@ -172,8 +171,8 @@
(<| (/.prefix "lux")
(|> /.empty
## (dictionary.merge lux_procs)
- ## (dictionary.merge i64_procs)
+ (dictionary.merge i64_procs)
## (dictionary.merge f64_procs)
- ## (dictionary.merge text_procs)
+ (dictionary.merge text_procs)
## (dictionary.merge io_procs)
)))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux
index 1b7119378..326d688c2 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux
@@ -94,43 +94,11 @@
(_.named_list (list [..i64_high_field (_.int high)]
[..i64_low_field (_.int low)]))))
-(def: #export variant_tag_field "luxVT")
-(def: #export variant_flag_field "luxVF")
-(def: #export variant_value_field "luxVV")
-
-(def: #export (flag value)
- (-> Bit Expression)
- (if value
- (_.string "")
- _.null))
-
-(def: (variant' tag last? value)
- (-> Expression Expression Expression Expression)
- (_.named_list (list [..variant_tag_field tag]
- [..variant_flag_field last?]
- [..variant_value_field value])))
-
-(def: #export (variant tag last? value)
- (-> Nat Bit Expression Expression)
- (variant' (_.int (.int tag))
- (flag last?)
- value))
-
-(def: #export none
- Expression
- (variant 0 #0 ..unit))
-
-(def: #export some
- (-> Expression Expression)
- (variant 1 #1))
-
-(def: #export left
- (-> Expression Expression)
- (variant 0 #0))
-
-(def: #export right
- (-> Expression Expression)
- (variant 1 #1))
+(def: #export (lux_i64 high low)
+ (-> Int Int Int)
+ (|> high
+ (i64.left_shift 32)
+ (i64.or low)))
(syntax: #export (with_vars {vars (<code>.tuple (<>.some <code>.local_identifier))}
body)
@@ -180,6 +148,47 @@
(_.function (list (~+ inputsC))
(~ code))))))))))))))
+(def: #export variant_tag_field "luxVT")
+(def: #export variant_flag_field "luxVF")
+(def: #export variant_value_field "luxVV")
+
+(def: #export (flag value)
+ (-> Bit Expression)
+ (if value
+ (_.string "")
+ _.null))
+
+(def: (variant' tag last? value)
+ (-> Expression Expression Expression Expression)
+ (_.named_list (list [..variant_tag_field tag]
+ [..variant_flag_field last?]
+ [..variant_value_field value])))
+
+(runtime: (adt::variant tag last? value)
+ (..variant' tag last? value))
+
+(def: #export (variant tag last? value)
+ (-> Nat Bit Expression Expression)
+ (adt::variant (_.int (.int tag))
+ (flag last?)
+ value))
+
+(def: #export none
+ Expression
+ (variant 0 #0 ..unit))
+
+(def: #export some
+ (-> Expression Expression)
+ (variant 1 #1))
+
+(def: #export left
+ (-> Expression Expression)
+ (variant 0 #0))
+
+(def: #export right
+ (-> Expression Expression)
+ (variant 1 #1))
+
(def: high_shift (_.bit_shl (_.int +32)))
(runtime: f2^32 (|> (_.int +2) (_.** (_.int +32))))
@@ -628,6 +637,7 @@
@tuple::left
@tuple::right
@sum::get
+ @adt::variant
))
(template [<name> <op>]
@@ -667,6 +677,21 @@
(def: runtime::i64
Expression
($_ _.then
+ @f2^32
+ @f2^63
+
+ @i64::new
+ @i64::from_float
+
+ @i64::and
+ @i64::or
+ @i64::xor
+ @i64::not
+ @i64::left_shift
+ @i64::arithmetic_right_shift_32
+ @i64::arithmetic_right_shift
+ @i64::right_shift
+
@i64::zero
@i64::one
@i64::min
@@ -682,15 +707,6 @@
@i64::*
@i64::/
@i64::%
-
- @i64::and
- @i64::or
- @i64::xor
- @i64::not
- @i64::left_shift
- @i64::arithmetic_right_shift_32
- @i64::arithmetic_right_shift
- @i64::right_shift
))
(runtime: (frac::decode input)
@@ -822,10 +838,6 @@
Expression
($_ _.then
runtime::lux
- @f2^32
- @f2^63
- @i64::new
- @i64::from_float
runtime::i64
runtime::adt
runtime::frac
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-05 06:21:33 +0000