aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lux-bootstrapper/src/lux/host/generics.clj7
-rw-r--r--lux-r/source/program.lux413
-rw-r--r--stdlib/source/lux/target/r.lux12
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux84
4 files changed, 345 insertions, 171 deletions
diff --git a/lux-bootstrapper/src/lux/host/generics.clj b/lux-bootstrapper/src/lux/host/generics.clj
index 9e0359760..58986c100 100644
--- a/lux-bootstrapper/src/lux/host/generics.clj
+++ b/lux-bootstrapper/src/lux/host/generics.clj
@@ -144,6 +144,13 @@
(&/$GenericClass name params)
(->bytecode-class-name name)
+ (&/$GenericArray (&/$GenericClass name params))
+ (case name
+ ("void" "boolean" "byte" "short" "int" "long" "float" "double" "char")
+ (str "[" (->type-signature name))
+ ;; else
+ (str "[L" (->bytecode-class-name name) ";"))
+
(&/$GenericArray param)
(str "[" (gclass->class-name param))
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
diff --git a/stdlib/source/lux/target/r.lux b/stdlib/source/lux/target/r.lux
index 2e8283a9e..40fb28da7 100644
--- a/stdlib/source/lux/target/r.lux
+++ b/stdlib/source/lux/target/r.lux
@@ -113,9 +113,9 @@
#1 "TRUE")
:abstraction))
- (def: #export (int value)
+ (def: #export int
(-> Int Expression)
- (:abstraction (format "as.integer(" (%.int value) ")")))
+ (|>> %.int :abstraction))
(def: #export float
(-> Frac Expression)
@@ -236,6 +236,10 @@
[["paste"]]]
)
+ (def: #export as::integer
+ (-> Expression Expression)
+ (..apply/1 (..var "as.integer")))
+
(def: #export (nth idx list)
(-> Expression Expression Expression)
(..self_contained
@@ -243,14 +247,14 @@
(def: #export (if test then else)
(-> Expression Expression Expression Expression)
- (..self_contained
+ (:abstraction
(format "if(" (:representation test) ")"
" " (.._block (:representation then))
" else " (.._block (:representation else)))))
(def: #export (when test then)
(-> Expression Expression Expression)
- (..self_contained
+ (:abstraction
(format "if(" (:representation test) ") {"
(.._block (:representation then))
text.new_line "}")))
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 326d688c2..ac0efe5ef 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
@@ -75,31 +75,6 @@
## else
(.int input)))
-(def: high_32
- (-> Nat Nat)
- (i64.right_shift 32))
-
-(def: low_32
- (-> Nat Nat)
- (|>> (i64.and (hex "FFFFFFFF"))))
-
-(def: #export i64_high_field "luxIH")
-(def: #export i64_low_field "luxIL")
-
-(def: #export (i64 value)
- (-> Int Expression)
- (let [value (.nat value)
- high (|> value ..high_32 ..cap_32)
- low (|> value ..low_32 ..cap_32)]
- (_.named_list (list [..i64_high_field (_.int high)]
- [..i64_low_field (_.int low)]))))
-
-(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)
(do {! meta.monad}
@@ -158,15 +133,11 @@
(_.string "")
_.null))
-(def: (variant' tag last? value)
- (-> Expression Expression Expression Expression)
- (_.named_list (list [..variant_tag_field tag]
+(runtime: (adt::variant tag last? value)
+ (_.named_list (list [..variant_tag_field (_.as::integer 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))
@@ -191,16 +162,19 @@
(def: high_shift (_.bit_shl (_.int +32)))
-(runtime: f2^32 (|> (_.int +2) (_.** (_.int +32))))
-(runtime: f2^63 (|> (_.int +2) (_.** (_.int +63))))
+(template [<name> <power>]
+ [(runtime: <name> (|> (_.as::integer (_.int +2)) (_.** (_.as::integer (_.int <power>)))))]
+
+ [f2^32 +32]
+ [f2^63 +63]
+ )
(def: (as_double value)
(-> Expression Expression)
(_.apply (list value) (_.var "as.double")))
-(def: (as_integer value)
- (-> Expression Expression)
- (_.apply (list value) (_.var "as.integer")))
+(def: #export i64_high_field "luxIH")
+(def: #export i64_low_field "luxIL")
(runtime: (i64::unsigned_low input)
(with_vars [low]
@@ -219,8 +193,28 @@
(|> high (_.+ low) as_double)))
(runtime: (i64::new high low)
- (_.named_list (list [..i64_high_field (as_integer high)]
- [..i64_low_field (as_integer low)])))
+ (_.named_list (list [..i64_high_field (_.as::integer high)]
+ [..i64_low_field (_.as::integer low)])))
+
+(def: high_32
+ (-> Nat Nat)
+ (i64.right_shift 32))
+
+(def: low_32
+ (-> Nat Nat)
+ (|>> (i64.and (hex "FFFFFFFF"))))
+
+(def: #export (i64 value)
+ (-> Int Expression)
+ (let [value (.nat value)]
+ (i64::new (|> value ..high_32 ..cap_32 _.int)
+ (|> value ..low_32 ..cap_32 _.int))))
+
+(def: #export (lux_i64 high low)
+ (-> Int Int Int)
+ (|> high
+ (i64.left_shift 32)
+ (i64.or low)))
(template [<name> <value>]
[(runtime: <name>
@@ -299,13 +293,13 @@
(runtime: (i64::< reference sample)
(with_vars [r_? s_?]
($_ _.then
- (_.set! s_? (|> sample i64_high (_.< (_.int +0))))
- (_.set! r_? (|> reference i64_high (_.< (_.int +0))))
+ (_.set! s_? (|> sample ..i64_high (_.< (_.int +0))))
+ (_.set! r_? (|> reference ..i64_high (_.< (_.int +0))))
(|> (|> s_? (_.and (_.not r_?)))
(_.or (|> (_.not s_?) (_.and r_?) _.not))
(_.or (|> sample
(i64::- reference)
- i64_high
+ ..i64_high
(_.< (_.int +0))))))))
(runtime: (i64::from_float input)
@@ -385,7 +379,7 @@
(def: (limit_shift! shift)
(-> SVar Expression)
- (_.set! shift (|> shift (_.bit_and (_.int +63)))))
+ (_.set! shift (|> shift (_.bit_and (_.as::integer (_.int +63))))))
(def: (no_shift_clause shift input)
(-> SVar SVar [Expression Expression])
@@ -409,7 +403,7 @@
(i64::new high (_.int +0))))))
(runtime: (i64::arithmetic_right_shift_32 shift input)
- (let [top_bit (|> input (_.bit_and (_.int (hex "+80000000"))))]
+ (let [top_bit (|> input (_.bit_and (_.as::integer (_.int (hex "+80000000")))))]
(|> input
(_.bit_ushr shift)
(_.bit_or top_bit))))
@@ -627,7 +621,7 @@
[(|> (|> wants_last? (_.= (_.string "")))
(_.and (|> wanted_tag (_.< sum_tag))))
- (variant' (|> sum_tag (_.- wanted_tag)) sum_flag sum_value)])
+ (adt::variant (|> sum_tag (_.- wanted_tag)) sum_flag sum_value)])
no_match)))
@@ -663,7 +657,7 @@
low (|> (i64_low input)
(_.bit_ushr shift)
(_.bit_or (_.if (_.apply (list $mid) (_.var "is.na"))
- (_.int +0)
+ (_.as::integer (_.int +0))
$mid)))]
($_ _.then
(_.set! $mid mid)
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-05 01:33:57 +0000