aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source')
-rw-r--r--new-luxc/source/luxc/lang/host/r.lux279
-rw-r--r--new-luxc/source/luxc/lang/translation/r.lux38
-rw-r--r--new-luxc/source/luxc/lang/translation/r/case.jvm.lux86
-rw-r--r--new-luxc/source/luxc/lang/translation/r/eval.jvm.lux17
-rw-r--r--new-luxc/source/luxc/lang/translation/r/expression.jvm.lux2
-rw-r--r--new-luxc/source/luxc/lang/translation/r/function.jvm.lux62
-rw-r--r--new-luxc/source/luxc/lang/translation/r/loop.jvm.lux4
-rw-r--r--new-luxc/source/luxc/lang/translation/r/primitive.jvm.lux2
-rw-r--r--new-luxc/source/luxc/lang/translation/r/procedure.jvm.lux2
-rw-r--r--new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux2
-rw-r--r--new-luxc/source/luxc/lang/translation/r/reference.jvm.lux2
-rw-r--r--new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux897
-rw-r--r--new-luxc/source/luxc/lang/translation/r/statement.jvm.lux4
-rw-r--r--new-luxc/source/luxc/lang/translation/r/structure.jvm.lux2
14 files changed, 655 insertions, 744 deletions
diff --git a/new-luxc/source/luxc/lang/host/r.lux b/new-luxc/source/luxc/lang/host/r.lux
index 62c33479d..5394b756f 100644
--- a/new-luxc/source/luxc/lang/host/r.lux
+++ b/new-luxc/source/luxc/lang/host/r.lux
@@ -1,7 +1,8 @@
(.module:
- [lux #- not or and list if function cond]
+ [lux #- not or and list if function cond when]
(lux (control pipe)
- (data [text]
+ (data [maybe "maybe/" Functor<Maybe>]
+ [text]
text/format
[number]
(coll [list "list/" Functor<List> Fold<List>]))
@@ -34,16 +35,26 @@
(def: #export code (-> Text Expression) (|>> @abstraction))
(def: (self-contained code)
+ (-> Text Expression)
+ (@abstraction
+ (format "(" code ")")))
+
+ (def: nest
(-> Text Text)
- (format "(" code ")"))
+ (|>> (format "\n")
+ (text.replace-all "\n" "\n ")))
+
+ (def: (block expression)
+ (-> Text Text)
+ (format "{" (nest expression) "\n" "}"))
(def: #export null
Expression
- (|> "NULL" self-contained @abstraction))
+ (|> "NULL" self-contained))
(def: #export n/a
Expression
- (|> "NA" self-contained @abstraction))
+ (|> "NA" self-contained))
(def: #export not-available Expression n/a)
(def: #export not-applicable Expression n/a)
@@ -53,14 +64,12 @@
(-> Bool Expression)
(|>> (case> true "TRUE"
false "FALSE")
- self-contained
- @abstraction))
+ self-contained))
(def: #export (int value)
(-> Int Expression)
- (@abstraction
- (self-contained
- (format "as.integer(" (%i value) ")"))))
+ (self-contained
+ (format "as.integer(" (%i value) ")")))
(def: #export float
(-> Frac Expression)
@@ -75,22 +84,20 @@
## else
[%f])
- self-contained
- @abstraction))
+ self-contained))
(def: #export string
(-> Text Expression)
- (|>> %t self-contained @abstraction))
+ (|>> %t self-contained))
(def: (composite-literal left-delimiter right-delimiter entry-serializer)
(All [a] (-> Text Text (-> a Text)
(-> (List a) Expression)))
(.function (_ entries)
- (@abstraction
- (self-contained
- (format left-delimiter
- (|> entries (list/map entry-serializer) (text.join-with ","))
- right-delimiter)))))
+ (self-contained
+ (format left-delimiter
+ (|> entries (list/map entry-serializer) (text.join-with ","))
+ right-delimiter))))
(def: #export named-list
(-> (List [Text Expression]) Expression)
@@ -108,49 +115,50 @@
(def: #export (slice from to list)
(-> Expression Expression Expression Expression)
- (@abstraction
- (self-contained
- (format (@representation list)
- "[" (@representation from) ":" (@representation to) "]"))))
+ (self-contained
+ (format (@representation list)
+ "[" (@representation from) ":" (@representation to) "]")))
(def: #export (slice-from from list)
(-> Expression Expression Expression)
- (@abstraction
- (self-contained
- (format (@representation list)
- "[-1" ":-" (@representation from) "]"))))
+ (self-contained
+ (format (@representation list)
+ "[-1" ":-" (@representation from) "]")))
(def: #export (apply args func)
(-> (List Expression) Expression Expression)
- (@abstraction
- (self-contained
- (format (@representation func) "(" (text.join-with "," (list/map expression args)) ")"))))
+ (self-contained
+ (format (@representation func) "(" (text.join-with "," (list/map expression args)) ")")))
(def: #export (apply-kw args kw-args func)
(-> (List Expression) (List [Text Expression]) Expression Expression)
- (@abstraction
- (self-contained
- (format (@representation func)
- (format "("
- (text.join-with "," (list/map expression args))
- (text.join-with "," (list/map (.function (_ [key val])
- (format key "=" (expression val)))
- kw-args))
- ")")))))
+ (self-contained
+ (format (@representation func)
+ (format "("
+ (text.join-with "," (list/map expression args))
+ (text.join-with "," (list/map (.function (_ [key val])
+ (format key "=" (expression val)))
+ kw-args))
+ ")"))))
(def: #export (nth idx list)
(-> Expression Expression Expression)
- (@abstraction
- (self-contained
- (format (@representation list) "[[" (@representation idx) "]]"))))
+ (self-contained
+ (format (@representation list) "[[" (@representation idx) "]]")))
(def: #export (if test then else)
(-> Expression Expression Expression Expression)
- (@abstraction
- (self-contained
- (format "if(" (@representation test) ")"
- " " (@representation then)
- " else " (@representation else)))))
+ (self-contained
+ (format "if(" (@representation test) ")"
+ " " (block (@representation then))
+ " else " (block (@representation else)))))
+
+ (def: #export (when test then)
+ (-> Expression Expression Expression)
+ (self-contained
+ (format "if(" (@representation test) ") {"
+ (block (@representation then))
+ "\n" "}")))
(def: #export (cond clauses else)
(-> (List [Expression Expression]) Expression Expression)
@@ -162,11 +170,10 @@
(do-template [<name> <op>]
[(def: #export (<name> param subject)
(-> Expression Expression Expression)
- (@abstraction
- (self-contained
- (format (@representation subject)
- " " <op> " "
- (@representation param)))))]
+ (self-contained
+ (format (@representation subject)
+ " " <op> " "
+ (@representation param))))]
[= "=="]
[< "<"]
@@ -185,7 +192,7 @@
(def: #export @@
(All [k] (-> (Var k) Expression))
- (|>> ..name self-contained @abstraction))
+ (|>> ..name self-contained))
(def: #export global
(-> Text Expression)
@@ -210,7 +217,7 @@
(do-template [<name> <op>]
[(def: #export <name>
(-> Expression Expression)
- (|>> @representation (format <op>) self-contained @abstraction))]
+ (|>> @representation (format <op>) self-contained))]
[not "!"]
[negate "-"]
@@ -222,126 +229,66 @@
(def: #export (range from to)
(-> Expression Expression Expression)
- (@abstraction
- (self-contained
- (format (@representation from) ":" (@representation to)))))
- )
-
-(abstract: #export Statement
- {}
-
- Text
-
- (def: #export statement (-> Statement Text) (|>> @representation))
-
- (def: nest
- (-> Statement Text)
- (|>> @representation
- (format "\n")
- (text.replace-all "\n" "\n ")))
-
- (def: #export (set-nth! idx value list)
- (-> Expression Expression SVar Statement)
- (@abstraction (format (..name list) "[" (expression idx) "] <- " (expression value))))
-
- (def: #export (set! var value)
- (-> (Var Single) Expression Statement)
- (@abstraction
- (format (..name var) " <- " (expression value))))
-
- (def: #export (if! test then! else!)
- (-> Expression Statement Statement Statement)
- (@abstraction
- (format "if(" (expression test) ") {"
- (nest then!)
- "\n" "} else {"
- (nest else!)
- "\n" "}")))
-
- (def: #export (when! test then!)
- (-> Expression Statement Statement)
- (@abstraction
- (format "if(" (expression test) ") {"
- (nest then!)
- "\n" "}")))
-
- (def: #export (cond! clauses else!)
- (-> (List [Expression Statement]) Statement Statement)
- (list/fold (.function (_ [test then!] next!)
- (if! test then! next!))
- else!
- (list.reverse clauses)))
-
- (def: #export (then! pre! post!)
- (-> Statement Statement Statement)
- (@abstraction
- (format (@representation pre!)
- "\n"
- (@representation post!))))
-
- (def: #export (while! test body!)
- (-> Expression Statement Statement)
- (@abstraction
- (format "while (" (expression test) ") {"
- (nest body!)
- "\n" "}")))
-
- (def: #export (do! expression)
- (-> Expression Statement)
- (@abstraction (..expression expression)))
+ (self-contained
+ (format (@representation from) ":" (@representation to))))
+
+ (def: #export (function inputs body)
+ (-> (List (Ex [k] (Var k))) Expression Expression)
+ (let [args (|> inputs (list/map ..name) (text.join-with ", "))]
+ (self-contained
+ (format "function(" args ") "
+ (..block (@representation body))))))
+
+ (def: #export (try body warning error finally)
+ (-> Expression (Maybe Expression) (Maybe Expression) (Maybe Expression) Expression)
+ (let [optional (: (-> Text (Maybe Expression) (-> Text Text) Text)
+ (.function (_ parameter value preparation)
+ (|> value
+ (maybe/map (|>> @representation preparation (format ", " parameter " = ")))
+ (maybe.default ""))))]
+ (self-contained
+ (format "tryCatch("
+ (..block (@representation body))
+ (optional "warning" warning id)
+ (optional "error" error id)
+ (optional "finally" finally ..block)
+ ")"))))
+
+ (def: #export (while test body)
+ (-> Expression Expression Expression)
+ (self-contained
+ (format "while (" (@representation test) ") "
+ (..block (@representation body)))))
- (def: #export no-op!
- Statement
- (@abstraction "\n"))
+ (def: #export (for-in var inputs body)
+ (-> SVar Expression Expression Expression)
+ (self-contained
+ (format "for (" (..name var) " in " (..expression inputs) ")"
+ (..block (@representation body)))))
(do-template [<name> <keyword>]
[(def: #export (<name> message)
- (-> Expression Statement)
- (@abstraction
- (format <keyword> "(" (expression message) ")")))]
+ (-> Expression Expression)
+ (..apply (.list message) (..global <keyword>)))]
- [stop! "stop"]
- [print! "print"]
+ [stop "stop"]
+ [print "print"]
)
- (def: #export (block statement)
- (-> Statement Expression)
- (..code (format "{"
- (nest statement)
- "\n" "}")))
+ (def: #export (set! var value)
+ (-> (Var Single) Expression Expression)
+ (self-contained
+ (format (..name var) " <- " (@representation value))))
+
+ (def: #export (set-nth! idx value list)
+ (-> Expression Expression SVar Expression)
+ (self-contained
+ (format (..name list) "[" (@representation idx) "] <- " (@representation value))))
- (def: #export (for-in! var inputs body!)
- (-> SVar Expression Statement Statement)
+ (def: #export (then pre post)
+ (-> Expression Expression Expression)
(@abstraction
- (format "for (" (..name var) " in " (..expression inputs) ")"
- (..expression (..block body!)))))
+ (format (@representation pre)
+ "\n"
+ (@representation post))))
)
-
-(def: #export (function inputs body!)
- (-> (List (Ex [k] (Var k))) Statement Expression)
- (let [args (|> inputs (list/map ..name) (text.join-with ", "))]
- (..code (format "function(" args ")" (..expression (..block body!))))))
-
-(def: #export (try body! warning error finally!)
- (-> Statement (Maybe Expression) (Maybe Expression) (Maybe Statement) Expression)
- (..code (format "(tryCatch("
- (..expression (..block body!))
- (case warning
- (#.Some warning)
- (format ", warning = " (..expression warning))
-
- #.None
- "")
- (case error
- (#.Some error)
- (format ", error = " (..expression error))
-
- #.None
- "")
- (case finally!
- (#.Some finally!)
- (format ", finally = " (..expression (..block finally!)))
-
- #.None
- "")
- "))")))
diff --git a/new-luxc/source/luxc/lang/translation/r.lux b/new-luxc/source/luxc/lang/translation/r.lux
index aba64bc87..446df095d 100644
--- a/new-luxc/source/luxc/lang/translation/r.lux
+++ b/new-luxc/source/luxc/lang/translation/r.lux
@@ -15,7 +15,7 @@
(world [file #+ File]))
(luxc [lang]
(lang [".L" variable #+ Register]
- (host [r #+ Expression Statement]))
+ (host [r #+ Expression]))
[".C" io]))
(do-template [<name>]
@@ -56,7 +56,7 @@
(type: #export Host
{#context [Text Nat]
#anchor (Maybe Anchor)
- #loader (-> Statement (Error Unit))
+ #loader (-> Expression (Error Unit))
#interpreter (-> Expression (Error Object))
#module-buffer (Maybe StringBuilder)
#program-buffer StringBuilder})
@@ -69,7 +69,7 @@
#anchor #.None
#loader (function (_ code)
(do e.Monad<Error>
- [_ (ScriptEngine::eval [(r.statement code)] interpreter)]
+ [_ (ScriptEngine::eval [(r.expression code)] interpreter)]
(wrap [])))
#interpreter (function (_ code)
(do e.Monad<Error>
@@ -164,21 +164,20 @@
(function (_ compiler)
(#e.Success [compiler (|> compiler (get@ #.host) (:! Host) (get@ #program-buffer))])))
-(do-template [<name> <field> <inputT> <outputT> <unwrap>]
+(do-template [<name> <field> <outputT>]
[(def: (<name> code)
- (-> <inputT> (Meta <outputT>))
+ (-> Expression (Meta <outputT>))
(function (_ compiler)
(let [runner (|> compiler (get@ #.host) (:! Host) (get@ <field>))]
(case (runner code)
(#e.Error error)
- (exec ## (log! (<unwrap> code))
- ((lang.throw Cannot-Execute error) compiler))
+ ((lang.throw Cannot-Execute error) compiler)
(#e.Success output)
(#e.Success [compiler output])))))]
- [load! #loader Statement Unit r.statement]
- [interpret #interpreter Expression Object r.expression]
+ [load! #loader Unit]
+ [interpret #interpreter Object]
)
(def: #export variant-tag-field "luxVT")
@@ -194,18 +193,15 @@
(-> Ident Text)
(lang.normalize-name (format module "$" name)))
-(do-template [<name> <eval> <un-wrap> <inputT> <outputT>]
- [(def: #export (<name> code)
- (-> <inputT> (Meta <outputT>))
- (do macro.Monad<Meta>
- [module-buffer module-buffer
- #let [_ (Appendable::append [(:! CharSequence (<un-wrap> code))]
- module-buffer)]]
- (<eval> code)))]
-
- [save load! r.statement Statement Unit]
- [run interpret r.expression Expression Object]
- )
+(def: #export (save code)
+ (-> Expression (Meta Unit))
+ (do macro.Monad<Meta>
+ [module-buffer module-buffer
+ #let [_ (Appendable::append [(:! CharSequence (r.expression code))]
+ module-buffer)]]
+ (load! code)))
+
+(def: #export run interpret)
(def: #export (save-module! target)
(-> File (Meta (Process Unit)))
diff --git a/new-luxc/source/luxc/lang/translation/r/case.jvm.lux b/new-luxc/source/luxc/lang/translation/r/case.jvm.lux
index 2a635030c..67de862e8 100644
--- a/new-luxc/source/luxc/lang/translation/r/case.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/r/case.jvm.lux
@@ -12,7 +12,7 @@
(luxc [lang]
(lang [".L" variable #+ Register Variable]
["ls" synthesis #+ Synthesis Path]
- (host [r #+ Expression Statement SVar @@])))
+ (host [r #+ Expression SVar @@])))
[//]
(// [".T" runtime]
[".T" primitive]
@@ -25,9 +25,9 @@
[valueO (translate valueS)
bodyO (translate bodyS)
#let [$register (referenceT.variable register)]]
- (wrap (r.block ($_ r.then!
- (r.set! $register valueO)
- (r.do! bodyO))))))
+ (wrap ($_ r.then
+ (r.set! $register valueO)
+ bodyO))))
(def: #export (translate-record-get translate valueS pathP)
(-> (-> Synthesis (Meta Expression)) Synthesis (List [Nat Bool])
@@ -52,23 +52,23 @@
(def: top r.length)
(def: next (|>> r.length (r.+ (r.int 1))))
(def: (push! value var)
- (-> Expression SVar Statement)
+ (-> Expression SVar Expression)
(r.set-nth! (next (@@ var)) value var))
(def: (pop! var)
- (-> SVar Statement)
+ (-> SVar Expression)
(r.set-nth! (top (@@ var)) r.null var))
(def: (push-cursor! value)
- (-> Expression Statement)
+ (-> Expression Expression)
(push! value $cursor))
(def: save-cursor!
- Statement
+ Expression
(push! (r.slice (r.float 1.0) (r.length (@@ $cursor)) (@@ $cursor))
$savepoint))
(def: restore-cursor!
- Statement
+ Expression
(r.set! $cursor (r.nth (top (@@ $savepoint)) (@@ $savepoint))))
(def: cursor-top
@@ -76,12 +76,12 @@
(top (@@ $cursor)))
(def: pop-cursor!
- Statement
+ Expression
(pop! $cursor))
(def: pm-error (r.string "PM-ERROR"))
-(def: fail-pm! (r.stop! pm-error))
+(def: fail-pm! (r.stop pm-error))
(def: $temp (r.var "lux_pm_temp"))
@@ -90,20 +90,20 @@
(def: $alt_error (r.var "alt_error"))
-(def: (pm-catch handler!)
- (-> Statement Expression)
+(def: (pm-catch handler)
+ (-> Expression Expression)
(r.function (list $alt_error)
- (r.if! (|> (@@ $alt_error) (r.= pm-error))
- handler!
- (r.stop! (@@ $alt_error)))))
+ (r.if (|> (@@ $alt_error) (r.= pm-error))
+ handler
+ (r.stop (@@ $alt_error)))))
(def: (translate-pattern-matching' translate pathP)
- (-> (-> Synthesis (Meta Expression)) Path (Meta Statement))
+ (-> (-> Synthesis (Meta Expression)) Path (Meta Expression))
(case pathP
(^code ("lux case exec" (~ bodyS)))
(do macro.Monad<Meta>
[bodyO (translate bodyS)]
- (wrap (r.do! bodyO)))
+ (wrap bodyO))
(^code ("lux case pop"))
(meta/wrap pop-cursor!)
@@ -113,8 +113,8 @@
(^template [<tag> <format>]
[_ (<tag> value)]
- (meta/wrap (r.when! (r.not (r.= (|> value <format>) cursor-top))
- fail-pm!)))
+ (meta/wrap (r.when (r.not (r.= (|> value <format>) cursor-top))
+ fail-pm!)))
([#.Nat (<| runtimeT.int (:! Int))]
[#.Int runtimeT.int]
[#.Deg (<| runtimeT.int (:! Int))]
@@ -130,11 +130,11 @@
(^template [<pm> <flag>]
(^code (<pm> (~ [_ (#.Nat idx)])))
- (meta/wrap ($_ r.then!
+ (meta/wrap ($_ r.then
(r.set! $temp (runtimeT.sum//get cursor-top (r.int (:! Int idx)) <flag>))
- (r.if! (r.not (r.= r.null (@@ $temp)))
- (push-cursor! (@@ $temp))
- fail-pm!))))
+ (r.if (r.not (r.= r.null (@@ $temp)))
+ (push-cursor! (@@ $temp))
+ fail-pm!))))
(["lux case variant left" r.null]
["lux case variant right" (r.string "")])
@@ -142,7 +142,7 @@
(do macro.Monad<Meta>
[leftO (translate-pattern-matching' translate leftP)
rightO (translate-pattern-matching' translate rightP)]
- (wrap ($_ r.then!
+ (wrap ($_ r.then
leftO
rightO)))
@@ -150,31 +150,31 @@
(do macro.Monad<Meta>
[leftO (translate-pattern-matching' translate leftP)
rightO (translate-pattern-matching' translate rightP)]
- (wrap (r.do! (r.try ($_ r.then!
- save-cursor!
- leftO)
- #.None
- (#.Some (pm-catch ($_ r.then!
- restore-cursor!
- rightO)))
- #.None))))
+ (wrap (r.try ($_ r.then
+ save-cursor!
+ leftO)
+ #.None
+ (#.Some (pm-catch ($_ r.then
+ restore-cursor!
+ rightO)))
+ #.None)))
_
(lang.throw Unrecognized-Path (%code pathP))
))
(def: (translate-pattern-matching translate pathP)
- (-> (-> Synthesis (Meta Expression)) Path (Meta Statement))
+ (-> (-> Synthesis (Meta Expression)) Path (Meta Expression))
(do macro.Monad<Meta>
[pattern-matching! (translate-pattern-matching' translate pathP)]
- (wrap (r.do! (r.try pattern-matching!
- #.None
- (#.Some (pm-catch (r.stop! (r.string "Invalid expression for pattern-matching."))))
- #.None)))))
+ (wrap (r.try pattern-matching!
+ #.None
+ (#.Some (pm-catch (r.stop (r.string "Invalid expression for pattern-matching."))))
+ #.None))))
(def: (initialize-pattern-matching! stack-init)
- (-> Expression Statement)
- ($_ r.then!
+ (-> Expression Expression)
+ ($_ r.then
(r.set! $cursor (r.list (list stack-init)))
(r.set! $savepoint (r.list (list)))))
@@ -183,6 +183,6 @@
(do macro.Monad<Meta>
[valueO (translate valueS)
pattern-matching! (translate-pattern-matching translate pathP)]
- (wrap (r.block ($_ r.then!
- (initialize-pattern-matching! valueO)
- pattern-matching!)))))
+ (wrap ($_ r.then
+ (initialize-pattern-matching! valueO)
+ pattern-matching!))))
diff --git a/new-luxc/source/luxc/lang/translation/r/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/r/eval.jvm.lux
index 27d05fdaa..c026750a7 100644
--- a/new-luxc/source/luxc/lang/translation/r/eval.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/r/eval.jvm.lux
@@ -9,7 +9,7 @@
(coll [array]))
[host])
(luxc [lang]
- (lang (host [r #+ Expression Statement])))
+ (lang (host [r #+ Expression])))
[//])
(do-template [<name>]
@@ -124,20 +124,7 @@
## else
(let [object-class (:! Text (Object::toString [] (Object::getClass [] (:! Object host-object))))
text-representation (:! Text (Object::toString [] (:! Object host-object)))]
- (ex.throw Unknown-Kind-Of-Host-Object (format object-class " --- " text-representation))))
- ## (case (python-type host-object)
- ## "tuple"
- ## (tuple lux-object host-object)
-
- ## "dict"
- ## (variant lux-object host-object)
-
- ## "NoneType"
- ## (#e.Success [])
-
- ## type
- ## (ex.throw Unknown-Kind-Of-Host-Object (format type " " (Object::toString [] host-object))))
- )
+ (ex.throw Unknown-Kind-Of-Host-Object (format object-class " --- " text-representation)))))
(def: #export (eval code)
(-> Expression (Meta Top))
diff --git a/new-luxc/source/luxc/lang/translation/r/expression.jvm.lux b/new-luxc/source/luxc/lang/translation/r/expression.jvm.lux
index 67ea089a2..d68f6055e 100644
--- a/new-luxc/source/luxc/lang/translation/r/expression.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/r/expression.jvm.lux
@@ -11,7 +11,7 @@
(lang [".L" variable #+ Variable Register]
[".L" extension]
["ls" synthesis]
- (host [r #+ Expression Statement])))
+ (host [r #+ Expression])))
[//]
(// [".T" runtime]
[".T" primitive]
diff --git a/new-luxc/source/luxc/lang/translation/r/function.jvm.lux b/new-luxc/source/luxc/lang/translation/r/function.jvm.lux
index c42327839..3d4407bd0 100644
--- a/new-luxc/source/luxc/lang/translation/r/function.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/r/function.jvm.lux
@@ -10,7 +10,7 @@
(luxc ["&" lang]
(lang ["ls" synthesis]
[".L" variable #+ Variable]
- (host [r #+ Expression Statement @@])))
+ (host [r #+ Expression @@])))
[//]
(// [".T" reference]))
@@ -28,7 +28,7 @@
(|> (@@ $curried) (r.nth (|> register n/inc nat-to-int r.int)))))
(def: (with-closure function-name inits function-definition)
- (-> Text (List Expression) Statement (Meta Expression))
+ (-> Text (List Expression) Expression (Meta Expression))
(let [$closure (r.var (format function-name "___CLOSURE"))]
(case inits
#.Nil
@@ -41,9 +41,9 @@
[_ (//.save (r.set! $closure
(r.function (|> (list.enumerate inits)
(list/map (|>> product.left referenceT.closure)))
- ($_ r.then!
+ ($_ r.then
function-definition
- (r.do! (r.global function-name))))))]
+ (r.global function-name)))))]
(wrap (r.apply inits (@@ $closure)))))))
(def: #export (translate-function translate env arity bodyS)
@@ -57,14 +57,7 @@
(//.with-anchor [function-name +1]
(translate bodyS))))
closureO+ (monad.map @ referenceT.translate-variable env)
- #let [args-inits! (|> (list.n/range +0 (n/dec arity))
- (list/map input-declaration)
- (case> #.Nil
- r.no-op!
-
- (#.Cons head tail)
- (list/fold r.then! head tail)))
- arityO (|> arity nat-to-int r.int)
+ #let [arityO (|> arity nat-to-int r.int)
$num_args (r.var "num_args")
$function (r.var function-name)
apply-poly (function (_ args func)
@@ -72,30 +65,27 @@
(with-closure function-name closureO+
(r.set! $function
(r.function (list r.var-args)
- ($_ r.then!
- ## (r.set! $curried (r.apply (list (@@ r.var-args)) (r.global "list")))
+ ($_ r.then
(r.set! $curried (@@ r.var-args))
(r.set! $num_args (r.length (@@ $curried)))
- (r.do!
- (r.cond (list [(|> (@@ $num_args) (r.= arityO))
- (r.block
- ($_ r.then!
- (r.set! (referenceT.variable +0) (@@ $function))
- args-inits!
- (r.do! bodyO)))]
- [(|> (@@ $num_args) (r.> arityO))
- (let [arity-args (r.slice (r.int 1) arityO (@@ $curried))
- output-func-args (r.slice arityO (@@ $num_args) (@@ $curried))]
- (|> (@@ $function)
- (apply-poly arity-args)
- (apply-poly output-func-args)))])
- ## (|> (@@ $num_args) (r.< arityO))
- (let [$missing (r.var "missing")]
- (r.function (list r.var-args)
- ($_ r.then!
- ## (r.set! $missing (r.apply (list (@@ r.var-args)) (r.global "list")))
- (r.set! $missing (@@ r.var-args))
- (r.do! (|> (@@ $function)
- (apply-poly (r.apply (list (@@ $curried) (@@ $missing))
- (r.global "append"))))))))))))))
+ (r.cond (list [(|> (@@ $num_args) (r.= arityO))
+ ($_ r.then
+ (r.set! (referenceT.variable +0) (@@ $function))
+ (|> (list.n/range +0 (n/dec arity))
+ (list/map input-declaration)
+ (list/fold r.then bodyO)))]
+ [(|> (@@ $num_args) (r.> arityO))
+ (let [arity-args (r.slice (r.int 1) arityO (@@ $curried))
+ output-func-args (r.slice arityO (@@ $num_args) (@@ $curried))]
+ (|> (@@ $function)
+ (apply-poly arity-args)
+ (apply-poly output-func-args)))])
+ ## (|> (@@ $num_args) (r.< arityO))
+ (let [$missing (r.var "missing")]
+ (r.function (list r.var-args)
+ ($_ r.then
+ (r.set! $missing (@@ r.var-args))
+ (|> (@@ $function)
+ (apply-poly (r.apply (list (@@ $curried) (@@ $missing))
+ (r.global "append"))))))))))))
))
diff --git a/new-luxc/source/luxc/lang/translation/r/loop.jvm.lux b/new-luxc/source/luxc/lang/translation/r/loop.jvm.lux
index d0caebd80..ecaf12c7c 100644
--- a/new-luxc/source/luxc/lang/translation/r/loop.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/r/loop.jvm.lux
@@ -7,7 +7,7 @@
[macro])
(luxc [lang]
(lang ["ls" synthesis]
- (host [r #+ Expression Statement @@])))
+ (host [r #+ Expression @@])))
[//]
(// [".T" reference]))
@@ -25,7 +25,7 @@
_ (//.save (r.set! $loop-name
(r.function (|> (list.n/range +0 (n/dec (list.size initsS+)))
(list/map (|>> (n/+ offset) referenceT.variable)))
- (r.do! bodyO))))]
+ bodyO)))]
(wrap (r.apply initsO+ @loop-name))))
(def: #export (translate-recur translate argsS+)
diff --git a/new-luxc/source/luxc/lang/translation/r/primitive.jvm.lux b/new-luxc/source/luxc/lang/translation/r/primitive.jvm.lux
index 2afe41421..a6101f749 100644
--- a/new-luxc/source/luxc/lang/translation/r/primitive.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/r/primitive.jvm.lux
@@ -1,7 +1,7 @@
(.module:
lux
(lux [macro "meta/" Monad<Meta>])
- (luxc (lang (host [r #+ Expression Statement])))
+ (luxc (lang (host [r #+ Expression])))
[//]
(// [".T" runtime]))
diff --git a/new-luxc/source/luxc/lang/translation/r/procedure.jvm.lux b/new-luxc/source/luxc/lang/translation/r/procedure.jvm.lux
index 699c0c000..0cb14d379 100644
--- a/new-luxc/source/luxc/lang/translation/r/procedure.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/r/procedure.jvm.lux
@@ -7,7 +7,7 @@
(coll [dict])))
(luxc ["&" lang]
(lang ["ls" synthesis]
- (host [python #+ Expression Statement])))
+ (host [r #+ Expression])))
[//]
(/ ["/." common]
["/." host]))
diff --git a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux
index 849093126..1bcd560e9 100644
--- a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux
@@ -16,7 +16,7 @@
(luxc ["&" lang]
(lang ["la" analysis]
["ls" synthesis]
- (host [r #+ Expression Statement])))
+ (host [r #+ Expression])))
[///]
(/// [".T" runtime]
[".T" case]
diff --git a/new-luxc/source/luxc/lang/translation/r/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/r/reference.jvm.lux
index 0a1bcae1f..e63066959 100644
--- a/new-luxc/source/luxc/lang/translation/r/reference.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/r/reference.jvm.lux
@@ -5,7 +5,7 @@
text/format))
(luxc ["&" lang]
(lang [".L" variable #+ Variable Register]
- (host [r #+ Expression Statement SVar @@])))
+ (host [r #+ Expression SVar @@])))
[//]
(// [".T" runtime]))
diff --git a/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux
index 9b6d0c862..b75da1804 100644
--- a/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux
@@ -12,7 +12,7 @@
[io #+ Process])
[//]
(luxc [lang]
- (lang (host [r #+ SVar Expression Statement @@]))))
+ (lang (host [r #+ SVar Expression @@]))))
(def: prefix Text "LuxRuntime")
@@ -60,7 +60,7 @@
(-> Expression Expression)
(variant +1 true))
-(type: Runtime Statement)
+(type: Runtime Expression)
(def: declaration
(s.Syntax [Text (List Text)])
@@ -84,7 +84,7 @@
(~ type)
(r.apply (list (~+ argsC+)) (~ @runtime))))
(` (def: (~ implementation)
- r.Statement
+ r.Expression
(~ (case argsC+
#.Nil
(` (r.set! (~ $runtime) (~ definition)))
@@ -118,12 +118,11 @@
(runtime: (int//unsigned-low input)
(with-vars [low]
- ($_ r.then!
+ ($_ r.then
(r.set! low (|> (@@ input) (r.nth (r.string //.int-low-field))))
- (r.do!
- (r.if (|> (@@ low) (r.>= (r.int 0)))
- (@@ low)
- (|> (@@ low) (r.+ f2^32)))))))
+ (r.if (|> (@@ low) (r.>= (r.int 0)))
+ (@@ low)
+ (|> (@@ low) (r.+ f2^32))))))
(runtime: (int//to-float input)
(let [high (|> (@@ input)
@@ -131,12 +130,11 @@
high-shift)
low (|> (@@ input)
int//unsigned-low)]
- (r.do! (|> high (r.+ low)))))
+ (|> high (r.+ low))))
(runtime: (int//new high low)
- (r.do!
- (r.named-list (list [//.int-high-field (as-integer (@@ high))]
- [//.int-low-field (as-integer (@@ low))]))))
+ (r.named-list (list [//.int-high-field (as-integer (@@ high))]
+ [//.int-low-field (as-integer (@@ low))])))
(do-template [<name> <high> <low>]
[(runtime: <name>
@@ -152,13 +150,13 @@
(def: int64-low (r.nth (r.string //.int-low-field)))
(runtime: (bit//not input)
- (r.do! (int//new (|> (@@ input) int64-high r.bit-not)
- (|> (@@ input) int64-low r.bit-not))))
+ (int//new (|> (@@ input) int64-high r.bit-not)
+ (|> (@@ input) int64-low r.bit-not)))
(runtime: (int//+ param subject)
(with-vars [sH sL pH pL
x00 x16 x32 x48]
- ($_ r.then!
+ ($_ r.then
(r.set! sH (|> (@@ subject) int64-high))
(r.set! sL (|> (@@ subject) int64-low))
(r.set! pH (|> (@@ param) int64-high))
@@ -179,262 +177,261 @@
new-half (function (_ top bottom)
(|> top bottom-16 move-top-16
(r.bit-or (bottom-16 bottom))))]
- ($_ r.then!
+ ($_ r.then
(r.set! x00 (|> s00 (r.+ p00)))
(r.set! x16 (|> (@@ x00) top-16 (r.+ s16) (r.+ p16)))
(r.set! x32 (|> (@@ x16) top-16 (r.+ s32) (r.+ p32)))
(r.set! x48 (|> (@@ x32) top-16 (r.+ s48) (r.+ p48)))
- (r.do! (int//new (new-half (@@ x48) (@@ x32))
- (new-half (@@ x16) (@@ x00)))))))))
+ (int//new (new-half (@@ x48) (@@ x32))
+ (new-half (@@ x16) (@@ x00))))))))
(runtime: (int//= reference sample)
(let [comparison (: (-> (-> Expression Expression) Expression)
(function (_ field)
(|> (field (@@ sample)) (r.= (field (@@ reference))))))]
- (r.do! (|> (comparison int64-high)
- (r.and (comparison int64-low))))))
+ (|> (comparison int64-high)
+ (r.and (comparison int64-low)))))
(runtime: (int//negate input)
- (r.do!
- (r.if (|> (@@ input) (int//= int//min))
- int//min
- (|> (@@ input) bit//not (int//+ int//one)))))
+ (r.if (|> (@@ input) (int//= int//min))
+ int//min
+ (|> (@@ input) bit//not (int//+ int//one))))
(runtime: int//-one
(int//negate int//one))
(runtime: (int//- param subject)
- (r.do! (int//+ (int//negate (@@ param)) (@@ subject))))
+ (int//+ (int//negate (@@ param)) (@@ subject)))
(runtime: (int//< reference sample)
(with-vars [r-? s-?]
- ($_ r.then!
+ ($_ r.then
(r.set! s-? (|> (@@ sample) int64-high (r.< (r.int 0))))
(r.set! r-? (|> (@@ reference) int64-high (r.< (r.int 0))))
- (r.do! (|> (|> (@@ s-?) (r.and (r.not (@@ r-?))))
- (r.or (|> (r.not (@@ s-?)) (r.and (@@ r-?)) r.not))
- (r.or (|> (@@ sample)
- (int//- (@@ reference))
- int64-high
- (r.< (r.int 0)))))))))
+ (|> (|> (@@ s-?) (r.and (r.not (@@ r-?))))
+ (r.or (|> (r.not (@@ s-?)) (r.and (@@ r-?)) r.not))
+ (r.or (|> (@@ sample)
+ (int//- (@@ reference))
+ int64-high
+ (r.< (r.int 0))))))))
(runtime: (int//from-float input)
- (r.do!
- (r.cond (list [(r.apply (list (@@ input)) (r.global "is.nan"))
- int//zero]
- [(|> (@@ input) (r.<= (r.negate f2^63)))
- int//min]
- [(|> (@@ input) (r.+ (r.float 1.0)) (r.>= f2^63))
- int//max]
- [(|> (@@ input) (r.< (r.float 0.0)))
- (|> (@@ input) r.negate int//from-float int//negate)])
- (int//new (|> (@@ input) (r./ f2^32))
- (|> (@@ input) (r.%% f2^32))))))
+ (r.cond (list [(r.apply (list (@@ input)) (r.global "is.nan"))
+ int//zero]
+ [(|> (@@ input) (r.<= (r.negate f2^63)))
+ int//min]
+ [(|> (@@ input) (r.+ (r.float 1.0)) (r.>= f2^63))
+ int//max]
+ [(|> (@@ input) (r.< (r.float 0.0)))
+ (|> (@@ input) r.negate int//from-float int//negate)])
+ (int//new (|> (@@ input) (r./ f2^32))
+ (|> (@@ input) (r.%% f2^32)))))
(runtime: (int//* param subject)
(with-vars [sH sL pH pL
x00 x16 x32 x48]
- ($_ r.then!
+ ($_ r.then
(r.set! sH (|> (@@ subject) int64-high))
(r.set! pH (|> (@@ param) int64-high))
(let [negative-subject? (|> (@@ sH) (r.< (r.int 0)))
negative-param? (|> (@@ pH) (r.< (r.int 0)))]
- (r.cond! (list [negative-subject?
- (r.if! negative-param?
- (r.do! (int//* (int//negate (@@ param))
- (int//negate (@@ subject))))
- (r.do! (int//negate (int//* (@@ param)
- (int//negate (@@ subject))))))]
-
- [negative-param?
- (r.do! (int//negate (int//* (int//negate (@@ param))
- (@@ subject))))])
- ($_ r.then!
- (r.set! sL (|> (@@ subject) int64-low))
- (r.set! pL (|> (@@ param) int64-low))
- (let [bits16 (r.code "0xFFFF")
- move-top-16 (r.bit-shl (r.int 16))
- top-16 (r.bit-ushr (r.int 16))
- bottom-16 (r.bit-and bits16)
- split-16 (function (_ source)
- [(|> source top-16)
- (|> source bottom-16)])
- split-int (function (_ high low)
- [(split-16 high)
- (split-16 low)])
- new-half (function (_ top bottom)
- (|> top bottom-16 move-top-16
- (r.bit-or (bottom-16 bottom))))
-
- [[_s48 _s32] [_s16 _s00]] (split-int (@@ sH) (@@ sL))
- [[_p48 _p32] [_p16 _p00]] (split-int (@@ pH) (@@ pL))
- x16-top (|> (@@ x16) top-16)
- x32-top (|> (@@ x32) top-16)]
- (with-vars [s48 s32 s16 s00
- p48 p32 p16 p00]
- ($_ r.then!
- (r.set! s48 _s48) (r.set! s32 _s32) (r.set! s16 _s16) (r.set! s00 _s00)
- (r.set! p48 _p48) (r.set! p32 _p32) (r.set! p16 _p16) (r.set! p00 _p00)
- (r.set! x00 (|> (@@ s00) (r.* (@@ p00))))
- (r.set! x16 (|> (@@ x00) top-16 (r.+ (|> (@@ s16) (r.* (@@ p00))))))
- (r.set! x32 x16-top)
- (r.set! x16 (|> (@@ x16) bottom-16 (r.+ (|> (@@ s00) (r.* (@@ p16))))))
- (r.set! x32 (|> (@@ x32) (r.+ x16-top) (r.+ (|> (@@ s32) (r.* (@@ p00))))))
- (r.set! x48 x32-top)
- (r.set! x32 (|> (@@ x32) bottom-16 (r.+ (|> (@@ s16) (r.* (@@ p16))))))
- (r.set! x48 (|> (@@ x48) (r.+ x32-top)))
- (r.set! x32 (|> (@@ x32) bottom-16 (r.+ (|> (@@ s00) (r.* (@@ p32))))))
- (r.set! x48 (|> (@@ x48) (r.+ x32-top)
- (r.+ (|> (@@ s48) (r.* (@@ p00))))
- (r.+ (|> (@@ s32) (r.* (@@ p16))))
- (r.+ (|> (@@ s16) (r.* (@@ p32))))
- (r.+ (|> (@@ s00) (r.* (@@ p48))))))
- (r.do! (int//new (new-half (@@ x48) (@@ x32))
- (new-half (@@ x16) (@@ x00))))))
- )))))))
+ (r.cond (list [negative-subject?
+ (r.if negative-param?
+ (int//* (int//negate (@@ param))
+ (int//negate (@@ subject)))
+ (int//negate (int//* (@@ param)
+ (int//negate (@@ subject)))))]
+
+ [negative-param?
+ (int//negate (int//* (int//negate (@@ param))
+ (@@ subject)))])
+ ($_ r.then
+ (r.set! sL (|> (@@ subject) int64-low))
+ (r.set! pL (|> (@@ param) int64-low))
+ (let [bits16 (r.code "0xFFFF")
+ move-top-16 (r.bit-shl (r.int 16))
+ top-16 (r.bit-ushr (r.int 16))
+ bottom-16 (r.bit-and bits16)
+ split-16 (function (_ source)
+ [(|> source top-16)
+ (|> source bottom-16)])
+ split-int (function (_ high low)
+ [(split-16 high)
+ (split-16 low)])
+ new-half (function (_ top bottom)
+ (|> top bottom-16 move-top-16
+ (r.bit-or (bottom-16 bottom))))
+ x16-top (|> (@@ x16) top-16)
+ x32-top (|> (@@ x32) top-16)]
+ (with-vars [s48 s32 s16 s00
+ p48 p32 p16 p00]
+ (let [[[_s48 _s32] [_s16 _s00]] (split-int (@@ sH) (@@ sL))
+ [[_p48 _p32] [_p16 _p00]] (split-int (@@ pH) (@@ pL))
+ set-subject-chunks! ($_ r.then (r.set! s48 _s48) (r.set! s32 _s32) (r.set! s16 _s16) (r.set! s00 _s00))
+ set-param-chunks! ($_ r.then (r.set! p48 _p48) (r.set! p32 _p32) (r.set! p16 _p16) (r.set! p00 _p00))]
+ ($_ r.then
+ set-subject-chunks!
+ set-param-chunks!
+ (r.set! x00 (|> (@@ s00) (r.* (@@ p00))))
+ (r.set! x16 (|> (@@ x00) top-16 (r.+ (|> (@@ s16) (r.* (@@ p00))))))
+ (r.set! x32 x16-top)
+ (r.set! x16 (|> (@@ x16) bottom-16 (r.+ (|> (@@ s00) (r.* (@@ p16))))))
+ (r.set! x32 (|> (@@ x32) (r.+ x16-top) (r.+ (|> (@@ s32) (r.* (@@ p00))))))
+ (r.set! x48 x32-top)
+ (r.set! x32 (|> (@@ x32) bottom-16 (r.+ (|> (@@ s16) (r.* (@@ p16))))))
+ (r.set! x48 (|> (@@ x48) (r.+ x32-top)))
+ (r.set! x32 (|> (@@ x32) bottom-16 (r.+ (|> (@@ s00) (r.* (@@ p32))))))
+ (r.set! x48 (|> (@@ x48) (r.+ x32-top)
+ (r.+ (|> (@@ s48) (r.* (@@ p00))))
+ (r.+ (|> (@@ s32) (r.* (@@ p16))))
+ (r.+ (|> (@@ s16) (r.* (@@ p32))))
+ (r.+ (|> (@@ s00) (r.* (@@ p48))))))
+ (int//new (new-half (@@ x48) (@@ x32))
+ (new-half (@@ x16) (@@ x00))))))
+ )))))))
(def: (limit-shift! shift)
- (-> SVar Statement)
+ (-> SVar Expression)
(r.set! shift (|> (@@ shift) (r.bit-and (r.int 63)))))
(def: (no-shift-clause shift input)
- (-> SVar SVar [Expression Statement])
+ (-> SVar SVar [Expression Expression])
[(|> (@@ shift) (r.= (r.int 0)))
- (r.do! (@@ input))])
+ (@@ input)])
(runtime: (bit//shift-left shift input)
- ($_ r.then!
+ ($_ r.then
(limit-shift! shift)
- (r.cond! (list (no-shift-clause shift input)
- [(|> (@@ shift) (r.< (r.int 32)))
- (let [mid (|> (int64-low (@@ input)) (r.bit-ushr (|> (r.int 32) (r.- (@@ shift)))))
- high (|> (int64-high (@@ input))
- (r.bit-shl (@@ shift))
- (r.bit-or mid))
- low (|> (int64-low (@@ input))
- (r.bit-shl (@@ shift)))]
- (r.do! (int//new high low)))])
- (let [high (|> (int64-high (@@ input))
- (r.bit-shl (|> (@@ shift) (r.- (r.int 32)))))]
- (r.do! (int//new high (r.int 0)))))))
+ (r.cond (list (no-shift-clause shift input)
+ [(|> (@@ shift) (r.< (r.int 32)))
+ (let [mid (|> (int64-low (@@ input)) (r.bit-ushr (|> (r.int 32) (r.- (@@ shift)))))
+ high (|> (int64-high (@@ input))
+ (r.bit-shl (@@ shift))
+ (r.bit-or mid))
+ low (|> (int64-low (@@ input))
+ (r.bit-shl (@@ shift)))]
+ (int//new high low))])
+ (let [high (|> (int64-high (@@ input))
+ (r.bit-shl (|> (@@ shift) (r.- (r.int 32)))))]
+ (int//new high (r.int 0))))))
(runtime: (bit//signed-shift-right-32 shift input)
(let [top-bit (|> (@@ input) (r.bit-and (r.int (hex "80000000"))))]
- (r.do! (|> (@@ input)
- (r.bit-ushr (@@ shift))
- (r.bit-or top-bit)))))
+ (|> (@@ input)
+ (r.bit-ushr (@@ shift))
+ (r.bit-or top-bit))))
(runtime: (bit//signed-shift-right shift input)
- ($_ r.then!
+ ($_ r.then
(limit-shift! shift)
- (r.cond! (list (no-shift-clause shift input)
- [(|> (@@ shift) (r.< (r.int 32)))
- (let [mid (|> (int64-high (@@ input)) (r.bit-shl (|> (r.int 32) (r.- (@@ shift)))))
- high (|> (int64-high (@@ input))
- (bit//signed-shift-right-32 (@@ shift)))
- low (|> (int64-low (@@ input))
- (r.bit-ushr (@@ shift))
- (r.bit-or mid))]
- (r.do! (int//new high low)))])
- (let [low (|> (int64-high (@@ input))
- (bit//signed-shift-right-32 (|> (@@ shift) (r.- (r.int 32)))))
- high (r.if (|> (int64-high (@@ input)) (r.>= (r.int 0)))
- (r.int 0)
- (r.int -1))]
- (r.do! (int//new high low))))))
+ (r.cond (list (no-shift-clause shift input)
+ [(|> (@@ shift) (r.< (r.int 32)))
+ (let [mid (|> (int64-high (@@ input)) (r.bit-shl (|> (r.int 32) (r.- (@@ shift)))))
+ high (|> (int64-high (@@ input))
+ (bit//signed-shift-right-32 (@@ shift)))
+ low (|> (int64-low (@@ input))
+ (r.bit-ushr (@@ shift))
+ (r.bit-or mid))]
+ (int//new high low))])
+ (let [low (|> (int64-high (@@ input))
+ (bit//signed-shift-right-32 (|> (@@ shift) (r.- (r.int 32)))))
+ high (r.if (|> (int64-high (@@ input)) (r.>= (r.int 0)))
+ (r.int 0)
+ (r.int -1))]
+ (int//new high low)))))
(runtime: (int/// param subject)
(let [negative? (|>> (int//< int//zero))
valid-division-check [(|> (@@ param) (int//= int//zero))
- (r.stop! (r.string "Cannot divide by zero!"))]
+ (r.stop (r.string "Cannot divide by zero!"))]
short-circuit-check [(|> (@@ subject) (int//= int//zero))
- (r.do! int//zero)]]
- (r.cond! (list valid-division-check
- short-circuit-check
-
- [(|> (@@ subject) (int//= int//min))
- (r.cond! (list [(|> (|> (@@ param) (int//= int//one))
- (r.or (|> (@@ param) (int//= int//-one))))
- (r.do! int//min)]
- [(|> (@@ param) (int//= int//min))
- (r.do! int//one)])
- (with-vars [approximation]
- ($_ r.then!
- (r.set! approximation
- (|> (@@ subject)
- (bit//signed-shift-right (r.int 1))
- (int/// (@@ param))
- (bit//shift-left (r.int 1))))
- (r.if! (|> (@@ approximation) (int//= int//zero))
- (r.do! (r.if (negative? (@@ param))
- int//one
- int//-one))
- (let [remainder (int//- (int//* (@@ param) (@@ approximation))
- (@@ subject))]
- (r.do! (|> remainder
- (int/// (@@ param))
- (int//+ (@@ approximation)))))))))]
- [(|> (@@ param) (int//= int//min))
- (r.do! int//zero)]
-
- [(negative? (@@ subject))
- (r.do! (r.if (negative? (@@ param))
- (|> (int//negate (@@ subject))
- (int/// (int//negate (@@ param))))
- (|> (int//negate (@@ subject))
- (int/// (@@ param))
- int//negate)))]
-
- [(negative? (@@ param))
- (r.do! (|> (@@ param)
- int//negate
- (int/// (@@ subject))
- int//negate))])
- (with-vars [result remainder approximate approximate-result log2 approximate-remainder]
- ($_ r.then!
- (r.set! result int//zero)
- (r.set! remainder (@@ subject))
- (r.while! (|> (|> (@@ remainder) (int//< (@@ param)))
- (r.or (|> (@@ remainder) (int//= (@@ param)))))
- (let [calc-rough-estimate (r.apply (list (|> (int//to-float (@@ remainder)) (r./ (int//to-float (@@ param)))))
- (r.global "floor"))
- calc-approximate-result (int//from-float (@@ approximate))
- calc-approximate-remainder (|> (@@ approximate-result) (int//* (@@ param)))
- delta (r.if (|> (r.float 48.0) (r.<= (@@ log2)))
- (r.float 1.0)
- (r.** (|> (@@ log2) (r.- (r.float 48.0)))
- (r.float 2.0)))]
- ($_ r.then!
- (r.set! approximate (r.apply (list (r.float 1.0) calc-rough-estimate)
- (r.global "max")))
- (r.set! log2 (let [log (function (_ input)
- (r.apply (list input) (r.global "log")))]
- (r.apply (list (|> (log (r.int 2))
- (r./ (log (@@ approximate)))))
- (r.global "ceil"))))
- (r.set! approximate-result calc-approximate-result)
- (r.set! approximate-remainder calc-approximate-remainder)
- (r.while! (|> (negative? (@@ approximate-remainder))
- (r.or (|> (@@ approximate-remainder) (int//< (@@ remainder)))))
- ($_ r.then!
- (r.set! approximate (|> delta (r.- (@@ approximate))))
- (r.set! approximate-result calc-approximate-result)
- (r.set! approximate-remainder calc-approximate-remainder)))
- (r.set! result (|> (r.if (|> (@@ approximate-result) (int//= int//zero))
- int//one
- (@@ approximate-result))
- (int//+ (@@ result))))
- (r.set! remainder (|> (@@ remainder) (int//- (@@ approximate-remainder)))))))
- (r.do! (@@ result))))
- )))
+ int//zero]]
+ (r.cond (list valid-division-check
+ short-circuit-check
+
+ [(|> (@@ subject) (int//= int//min))
+ (r.cond (list [(|> (|> (@@ param) (int//= int//one))
+ (r.or (|> (@@ param) (int//= int//-one))))
+ int//min]
+ [(|> (@@ param) (int//= int//min))
+ int//one])
+ (with-vars [approximation]
+ ($_ r.then
+ (r.set! approximation
+ (|> (@@ subject)
+ (bit//signed-shift-right (r.int 1))
+ (int/// (@@ param))
+ (bit//shift-left (r.int 1))))
+ (r.if (|> (@@ approximation) (int//= int//zero))
+ (r.if (negative? (@@ param))
+ int//one
+ int//-one)
+ (let [remainder (int//- (int//* (@@ param) (@@ approximation))
+ (@@ subject))]
+ (|> remainder
+ (int/// (@@ param))
+ (int//+ (@@ approximation))))))))]
+ [(|> (@@ param) (int//= int//min))
+ int//zero]
+
+ [(negative? (@@ subject))
+ (r.if (negative? (@@ param))
+ (|> (int//negate (@@ subject))
+ (int/// (int//negate (@@ param))))
+ (|> (int//negate (@@ subject))
+ (int/// (@@ param))
+ int//negate))]
+
+ [(negative? (@@ param))
+ (|> (@@ param)
+ int//negate
+ (int/// (@@ subject))
+ int//negate)])
+ (with-vars [result remainder approximate approximate-result log2 approximate-remainder]
+ ($_ r.then
+ (r.set! result int//zero)
+ (r.set! remainder (@@ subject))
+ (r.while (|> (|> (@@ remainder) (int//< (@@ param)))
+ (r.or (|> (@@ remainder) (int//= (@@ param)))))
+ (let [calc-rough-estimate (r.apply (list (|> (int//to-float (@@ remainder)) (r./ (int//to-float (@@ param)))))
+ (r.global "floor"))
+ calc-approximate-result (int//from-float (@@ approximate))
+ calc-approximate-remainder (|> (@@ approximate-result) (int//* (@@ param)))
+ delta (r.if (|> (r.float 48.0) (r.<= (@@ log2)))
+ (r.float 1.0)
+ (r.** (|> (@@ log2) (r.- (r.float 48.0)))
+ (r.float 2.0)))]
+ ($_ r.then
+ (r.set! approximate (r.apply (list (r.float 1.0) calc-rough-estimate)
+ (r.global "max")))
+ (r.set! log2 (let [log (function (_ input)
+ (r.apply (list input) (r.global "log")))]
+ (r.apply (list (|> (log (r.int 2))
+ (r./ (log (@@ approximate)))))
+ (r.global "ceil"))))
+ (r.set! approximate-result calc-approximate-result)
+ (r.set! approximate-remainder calc-approximate-remainder)
+ (r.while (|> (negative? (@@ approximate-remainder))
+ (r.or (|> (@@ approximate-remainder) (int//< (@@ remainder)))))
+ ($_ r.then
+ (r.set! approximate (|> delta (r.- (@@ approximate))))
+ (r.set! approximate-result calc-approximate-result)
+ (r.set! approximate-remainder calc-approximate-remainder)))
+ (r.set! result (|> (r.if (|> (@@ approximate-result) (int//= int//zero))
+ int//one
+ (@@ approximate-result))
+ (int//+ (@@ result))))
+ (r.set! remainder (|> (@@ remainder) (int//- (@@ approximate-remainder)))))))
+ (@@ result)))
+ )))
(runtime: (int//% param subject)
(let [flat (|> (@@ subject) (int/// (@@ param)) (int//* (@@ param)))]
- (r.do! (|> (@@ subject) (int//- flat)))))
+ (|> (@@ subject) (int//- flat))))
(def: runtime//int
Runtime
- ($_ r.then!
+ ($_ r.then
@@int//unsigned-low
@@int//to-float
@@int//new
@@ -454,25 +451,25 @@
(runtime: (lux//try op)
(with-vars [error value]
- (r.do! (r.try ($_ r.then!
- (r.set! value (r.apply (list ..unit) (@@ op)))
- (r.do! (..right (@@ value))))
- #.None
- (#.Some (r.function (list error)
- (r.do! (..left (@@ error)))))
- #.None))))
+ (r.try ($_ r.then
+ (r.set! value (r.apply (list ..unit) (@@ op)))
+ (..right (@@ value)))
+ #.None
+ (#.Some (r.function (list error)
+ (..left (@@ error))))
+ #.None)))
(runtime: (lux//program-args program-args)
(with-vars [inputs value]
- ($_ r.then!
+ ($_ r.then
(r.set! inputs ..none)
- (<| (r.for-in! value (@@ program-args))
+ (<| (r.for-in value (@@ program-args))
(r.set! inputs (..some (r.list (list (@@ value) (@@ inputs))))))
- (r.do! (@@ inputs)))))
+ (@@ inputs))))
(def: runtime//lux
Runtime
- ($_ r.then!
+ ($_ r.then
@@lux//try
@@lux//program-args))
@@ -482,13 +479,13 @@
(r.apply (list raw-time) (r.global "as.numeric"))))
(runtime: (io//current-time! _)
- (r.do! (|> current-time-float
- (r.* (r.float 1_000.0))
- int//from-float)))
+ (|> current-time-float
+ (r.* (r.float 1_000.0))
+ int//from-float))
(def: runtime//io
Runtime
- ($_ r.then!
+ ($_ r.then
@@io//current-time!))
(def: minimum-index-length
@@ -509,28 +506,28 @@
(runtime: (product//left product index)
(let [$index_min_length (r.var "index_min_length")]
- ($_ r.then!
+ ($_ r.then
(r.set! $index_min_length (minimum-index-length index))
- (r.do! (r.if (|> (r.length (@@ product)) (r.> (@@ $index_min_length)))
- ## No need for recursion
- (product-element (@@ product) (@@ index))
- ## Needs recursion
- (product//left (product-tail product)
- (updated-index (@@ $index_min_length) (@@ product))))))))
+ (r.if (|> (r.length (@@ product)) (r.> (@@ $index_min_length)))
+ ## No need for recursion
+ (product-element (@@ product) (@@ index))
+ ## Needs recursion
+ (product//left (product-tail product)
+ (updated-index (@@ $index_min_length) (@@ product)))))))
(runtime: (product//right product index)
(let [$index_min_length (r.var "index_min_length")]
- ($_ r.then!
+ ($_ r.then
(r.set! $index_min_length (minimum-index-length index))
- (r.do! (r.cond (list [## Last element.
- (|> (r.length (@@ product)) (r.= (@@ $index_min_length)))
- (product-element (@@ product) (@@ index))]
- [## Needs recursion
- (|> (r.length (@@ product)) (r.< (@@ $index_min_length)))
- (product//right (product-tail product)
- (updated-index (@@ $index_min_length) (@@ product)))])
- ## Must slice
- (|> (@@ product) (r.slice-from (@@ index))))))))
+ (r.cond (list [## Last element.
+ (|> (r.length (@@ product)) (r.= (@@ $index_min_length)))
+ (product-element (@@ product) (@@ index))]
+ [## Needs recursion
+ (|> (r.length (@@ product)) (r.< (@@ $index_min_length)))
+ (product//right (product-tail product)
+ (updated-index (@@ $index_min_length) (@@ product)))])
+ ## Must slice
+ (|> (@@ product) (r.slice-from (@@ index)))))))
(runtime: (sum//get sum wanted_tag wants_last)
(let [no-match r.null
@@ -544,23 +541,23 @@
(|> (@@ wanted_tag) (r.- sum-tag))
(@@ wants_last))
no-match)]
- (r.do! (r.cond (list [(r.= sum-tag (@@ wanted_tag))
- (r.if (r.= (@@ wants_last) sum-flag)
- sum-value
- test-recursion)]
+ (r.cond (list [(r.= sum-tag (@@ wanted_tag))
+ (r.if (r.= (@@ wants_last) sum-flag)
+ sum-value
+ test-recursion)]
- [(|> (@@ wanted_tag) (r.> sum-tag))
- test-recursion]
+ [(|> (@@ wanted_tag) (r.> sum-tag))
+ test-recursion]
- [(|> (|> (@@ wants_last) (r.= (r.string "")))
- (r.and (|> (@@ wanted_tag) (r.< sum-tag))))
- (variant' (|> sum-tag (r.- (@@ wanted_tag))) sum-flag sum-value)])
+ [(|> (|> (@@ wants_last) (r.= (r.string "")))
+ (r.and (|> (@@ wanted_tag) (r.< sum-tag))))
+ (variant' (|> sum-tag (r.- (@@ wanted_tag))) sum-flag sum-value)])
- no-match))))
+ no-match)))
(def: runtime//adt
Runtime
- ($_ r.then!
+ ($_ r.then
@@product//left
@@product//right
@@sum//get
@@ -568,10 +565,10 @@
(do-template [<name> <op>]
[(runtime: (<name> mask input)
- (r.do! (int//new (<op> (int64-high (@@ mask))
- (int64-high (@@ input)))
- (<op> (int64-low (@@ mask))
- (int64-low (@@ input))))))]
+ (int//new (<op> (int64-high (@@ mask))
+ (int64-high (@@ input)))
+ (<op> (int64-low (@@ mask))
+ (int64-low (@@ input)))))]
[bit//and r.bit-and]
[bit//or r.bit-or]
@@ -580,42 +577,42 @@
(runtime: (bit//count-32 input)
(with-vars [count]
- ($_ r.then!
+ ($_ r.then
(r.set! count (r.int 0))
(let [last-input-bit (|> (@@ input) (r.bit-and (r.int 1)))
update-count! (r.set! count (|> (@@ count) (r.+ last-input-bit)))
consume-input! (r.set! input (|> (@@ input) (r.bit-ushr (r.int 1))))
input-remaining? (|> (@@ input) (r.= (r.int 0)))]
- (r.while! input-remaining?
- ($_ r.then!
- update-count!
- consume-input!)))
- (r.do! (@@ count)))))
+ (r.while input-remaining?
+ ($_ r.then
+ update-count!
+ consume-input!)))
+ (@@ count))))
(runtime: (bit//count input)
- (r.do! (int//from-float (r.+ (int64-high (@@ input))
- (int64-low (@@ input))))))
+ (int//from-float (r.+ (int64-high (@@ input))
+ (int64-low (@@ input)))))
(runtime: (bit//shift-right shift input)
- ($_ r.then!
+ ($_ r.then
(limit-shift! shift)
- (r.cond! (list (no-shift-clause shift input)
- [(|> (@@ shift) (r.< (r.int 32)))
- (let [mid (|> (int64-high (@@ input)) (r.bit-shl (|> (r.int 32) (r.- (@@ shift)))))
- high (|> (int64-high (@@ input)) (r.bit-ushr (@@ shift)))
- low (|> (int64-low (@@ input))
- (r.bit-ushr (@@ shift))
- (r.bit-or mid))]
- (r.do! (int//new high low)))]
- [(|> (@@ shift) (r.= (r.int 32)))
- (let [high (int64-high (@@ input))]
- (r.do! (int//new (r.int 0) high)))])
- (let [low (|> (int64-high (@@ input)) (r.bit-ushr (|> (@@ shift) (r.- (r.int 32)))))]
- (r.do! (int//new (r.int 0) low))))))
+ (r.cond (list (no-shift-clause shift input)
+ [(|> (@@ shift) (r.< (r.int 32)))
+ (let [mid (|> (int64-high (@@ input)) (r.bit-shl (|> (r.int 32) (r.- (@@ shift)))))
+ high (|> (int64-high (@@ input)) (r.bit-ushr (@@ shift)))
+ low (|> (int64-low (@@ input))
+ (r.bit-ushr (@@ shift))
+ (r.bit-or mid))]
+ (int//new high low))]
+ [(|> (@@ shift) (r.= (r.int 32)))
+ (let [high (int64-high (@@ input))]
+ (int//new (r.int 0) high))])
+ (let [low (|> (int64-high (@@ input)) (r.bit-ushr (|> (@@ shift) (r.- (r.int 32)))))]
+ (int//new (r.int 0) low)))))
(def: runtime//bit
Runtime
- ($_ r.then!
+ ($_ r.then
@@bit//and
@@bit//or
@@bit//xor
@@ -630,84 +627,84 @@
(runtime: (nat//< param subject)
(with-vars [pH sH]
- ($_ r.then!
+ ($_ r.then
(r.set! pH (..int64-high (@@ param)))
(r.set! sH (..int64-high (@@ subject)))
(let [lesser-high? (|> (@@ sH) (r.< (@@ pH)))
equal-high? (|> (@@ sH) (r.= (@@ pH)))
lesser-low? (|> (..int64-low (@@ subject)) (r.< (..int64-low (@@ param))))]
- (r.do! (|> lesser-high?
- (r.or (|> equal-high?
- (r.and lesser-low?)))))))))
+ (|> lesser-high?
+ (r.or (|> equal-high?
+ (r.and lesser-low?))))))))
(runtime: (nat/// parameter subject)
(let [negative? (int//< int//zero)
valid-division-check [(|> (@@ parameter) (int//= int//zero))
- (r.stop! (r.string "Cannot divide by zero!"))]
+ (r.stop (r.string "Cannot divide by zero!"))]
short-circuit-check [(|> (@@ subject) (nat//< (@@ parameter)))
- (r.do! int//zero)]]
- (r.cond! (list valid-division-check
- short-circuit-check
-
- [(|> (@@ parameter)
- (nat//< (|> (@@ subject) (bit//shift-right (r.int 1)))))
- (r.do! int//one)])
- (with-vars [result remainder approximate log2 approximate-result approximate-remainder delta]
- ($_ r.then!
- (r.set! result int//zero)
- (r.set! remainder (@@ subject))
- (r.while! (|> (|> (@@ remainder) (nat//< (@@ parameter)))
- (r.or (|> (@@ remainder) (int//= (@@ parameter)))))
- (let [rough-estimate (r.apply (list (|> (int//to-float (@@ parameter)) (r./ (int//to-float (@@ remainder)))))
- (r.global "floor"))
- calculate-approximate-result (int//from-float (@@ approximate))
- calculate-approximate-remainder (int//* (@@ parameter) (@@ approximate-result))
- delta (r.if (|> (r.float 48.0) (r.<= (@@ log2)))
- (r.float 1.0)
- (r.** (|> (r.float 48.0) (r.- (@@ log2)))
- (r.float 2.0)))
- update-approximates! ($_ r.then!
- (r.set! approximate-result calculate-approximate-result)
- (r.set! approximate-remainder calculate-approximate-remainder))]
- ($_ r.then!
- (r.set! approximate (r.apply (list (r.float 1.0) rough-estimate)
- (r.global "max")))
- (r.set! log2 (let [log (function (_ input)
- (r.apply (list input) (r.global "log")))]
- (r.apply (list (|> (log (r.int 2))
- (r./ (log (@@ approximate)))))
- (r.global "ceil"))))
- update-approximates!
- (r.while! (|> (negative? (@@ approximate-remainder))
- (r.or (|> (@@ approximate-remainder) (int//< (@@ remainder)))))
- ($_ r.then!
- (r.set! approximate (|> delta (r.- (@@ approximate))))
- update-approximates!))
- ($_ r.then!
- (r.set! result (|> (@@ result)
- (int//+ (r.if (|> (@@ approximate-result) (int//= int//zero))
- int//one
- (@@ approximate-result)))))
- (r.set! remainder (|> (@@ remainder) (int//- (@@ approximate-remainder))))))))
- (r.do! (@@ result))))
- )))
+ int//zero]]
+ (r.cond (list valid-division-check
+ short-circuit-check
+
+ [(|> (@@ parameter)
+ (nat//< (|> (@@ subject) (bit//shift-right (r.int 1)))))
+ int//one])
+ (with-vars [result remainder approximate log2 approximate-result approximate-remainder delta]
+ ($_ r.then
+ (r.set! result int//zero)
+ (r.set! remainder (@@ subject))
+ (r.while (|> (|> (@@ remainder) (nat//< (@@ parameter)))
+ (r.or (|> (@@ remainder) (int//= (@@ parameter)))))
+ (let [rough-estimate (r.apply (list (|> (int//to-float (@@ parameter)) (r./ (int//to-float (@@ remainder)))))
+ (r.global "floor"))
+ calculate-approximate-result (int//from-float (@@ approximate))
+ calculate-approximate-remainder (int//* (@@ parameter) (@@ approximate-result))
+ delta (r.if (|> (r.float 48.0) (r.<= (@@ log2)))
+ (r.float 1.0)
+ (r.** (|> (r.float 48.0) (r.- (@@ log2)))
+ (r.float 2.0)))
+ update-approximates! ($_ r.then
+ (r.set! approximate-result calculate-approximate-result)
+ (r.set! approximate-remainder calculate-approximate-remainder))]
+ ($_ r.then
+ (r.set! approximate (r.apply (list (r.float 1.0) rough-estimate)
+ (r.global "max")))
+ (r.set! log2 (let [log (function (_ input)
+ (r.apply (list input) (r.global "log")))]
+ (r.apply (list (|> (log (r.int 2))
+ (r./ (log (@@ approximate)))))
+ (r.global "ceil"))))
+ update-approximates!
+ (r.while (|> (negative? (@@ approximate-remainder))
+ (r.or (|> (@@ approximate-remainder) (int//< (@@ remainder)))))
+ ($_ r.then
+ (r.set! approximate (|> delta (r.- (@@ approximate))))
+ update-approximates!))
+ ($_ r.then
+ (r.set! result (|> (@@ result)
+ (int//+ (r.if (|> (@@ approximate-result) (int//= int//zero))
+ int//one
+ (@@ approximate-result)))))
+ (r.set! remainder (|> (@@ remainder) (int//- (@@ approximate-remainder))))))))
+ (@@ result)))
+ )))
(runtime: (nat//% param subject)
(let [flat (|> (@@ subject)
(nat/// (@@ param))
(int//* (@@ param)))]
- (r.do! (|> (@@ subject) (int//- flat)))))
+ (|> (@@ subject) (int//- flat))))
(def: runtime//nat
Runtime
- ($_ r.then!
+ ($_ r.then
@@nat//<
@@nat///
@@nat//%))
(runtime: (deg//* param subject)
(with-vars [sL sH pL pH bottom middle top]
- ($_ r.then!
+ ($_ r.then
(r.set! sL (int//from-float (int64-low (@@ subject))))
(r.set! sH (int//from-float (int64-high (@@ subject))))
(r.set! pL (int//from-float (int64-low (@@ param))))
@@ -717,57 +714,57 @@
middle (r.+ (r.* (@@ pL) (@@ sH))
(r.* (@@ pH) (@@ sL)))
top (r.* (@@ pH) (@@ sH))]
- (r.do! (|> bottom
- (r.+ middle)
- (bit//shift-right (r.int 32))
- (r.+ top)))))))
+ (|> bottom
+ (r.+ middle)
+ (bit//shift-right (r.int 32))
+ (r.+ top))))))
(runtime: (deg//leading-zeroes input)
(with-vars [zeroes remaining]
- ($_ r.then!
+ ($_ r.then
(r.set! zeroes (r.int 64))
(r.set! remaining (@@ input))
- (r.while! (|> (@@ remaining) (int//= int//zero) r.not)
- ($_ r.then!
- (r.set! zeroes (|> (@@ zeroes) (r.- (r.int 1))))
- (r.set! remaining (|> (@@ remaining) (bit//shift-right (r.int 1))))))
- (r.do! (@@ zeroes)))))
+ (r.while (|> (@@ remaining) (int//= int//zero) r.not)
+ ($_ r.then
+ (r.set! zeroes (|> (@@ zeroes) (r.- (r.int 1))))
+ (r.set! remaining (|> (@@ remaining) (bit//shift-right (r.int 1))))))
+ (@@ zeroes))))
(runtime: (deg/// param subject)
(with-vars [min-shift]
- (r.if! (|> (@@ subject) (int//= (@@ param)))
- (r.do! int//-one)
- ($_ r.then!
- (r.set! min-shift
- (r.apply (list (deg//leading-zeroes (@@ param))
- (deg//leading-zeroes (@@ subject)))
- (r.global "min")))
- (let [subject' (|> (@@ subject) (bit//shift-left (@@ min-shift)))
- param' (|> (@@ param) (bit//shift-left (@@ min-shift)) int64-low int//from-float)]
- (r.do! (|> subject'
- (int/// param')
- (bit//shift-left (r.int 32)))))))))
+ (r.if (|> (@@ subject) (int//= (@@ param)))
+ int//-one
+ ($_ r.then
+ (r.set! min-shift
+ (r.apply (list (deg//leading-zeroes (@@ param))
+ (deg//leading-zeroes (@@ subject)))
+ (r.global "min")))
+ (let [subject' (|> (@@ subject) (bit//shift-left (@@ min-shift)))
+ param' (|> (@@ param) (bit//shift-left (@@ min-shift)) int64-low int//from-float)]
+ (|> subject'
+ (int/// param')
+ (bit//shift-left (r.int 32))))))))
(runtime: (deg//from-frac input)
(with-vars [two32 shifted]
- ($_ r.then!
+ ($_ r.then
(r.set! two32 (|> (r.float 2.0) (r.** (r.float 32.0))))
(r.set! shifted (|> (@@ input) (r.%% (r.float 1.0)) (r.* (@@ two32))))
(let [low (|> (@@ shifted) (r.%% (r.float 1.0)) (r.* (@@ two32)) as-integer)
high (|> (@@ shifted) as-integer)]
- (r.do! (int//new high low))))))
+ (int//new high low)))))
(runtime: (deg//to-frac input)
(with-vars [two32]
- ($_ r.then!
+ ($_ r.then
(r.set! two32 f2^32)
(let [high (|> (int64-high (@@ input)) (r./ (@@ two32)))
low (|> (int64-low (@@ input)) (r./ (@@ two32)) (r./ (@@ two32)))]
- (r.do! (|> low (r.+ high)))))))
+ (|> low (r.+ high))))))
(def: runtime//deg
Runtime
- ($_ r.then!
+ ($_ r.then
@@deg//*
@@deg//leading-zeroes
@@deg///
@@ -776,15 +773,15 @@
(runtime: (frac//decode input)
(with-vars [output]
- ($_ r.then!
+ ($_ r.then
(r.set! output (r.apply (list (@@ input)) (r.global "as.numeric")))
- (r.do! (r.if (|> (@@ output) (r.= r.n/a))
- ..none
- (..some (@@ output)))))))
+ (r.if (|> (@@ output) (r.= r.n/a))
+ ..none
+ (..some (@@ output))))))
(def: runtime//frac
Runtime
- ($_ r.then!
+ ($_ r.then
@@frac//decode))
(def: inc (-> Expression Expression) (|>> (r.+ (r.int 1))))
@@ -810,37 +807,33 @@
(runtime: (text//index subject param start)
(with-vars [idx startF subjectL]
- ($_ r.then!
+ ($_ r.then
(r.set! startF (int//to-float (@@ start)))
(r.set! subjectL (text-length (@@ subject)))
- (r.do!
- (r.if (|> (@@ startF) (within? (@@ subjectL)))
- (r.block
- ($_ r.then!
- (r.set! idx (|> (r.apply-kw (list (@@ param) (r.if (|> (@@ startF) (r.= (r.int 0)))
- (@@ subject)
- (text-clip (inc (@@ startF))
- (inc (@@ subjectL))
- (@@ subject))))
- (list ["fixed" (r.bool true)])
- (r.global "regexpr"))
- (r.nth (r.int 1))))
- (r.do!
- (r.if (|> (@@ idx) (r.= (r.int -1)))
- ..none
- (..some (int//from-float (|> (@@ idx) (r.+ (@@ startF)))))))))
- ..none)))))
+ (r.if (|> (@@ startF) (within? (@@ subjectL)))
+ ($_ r.then
+ (r.set! idx (|> (r.apply-kw (list (@@ param) (r.if (|> (@@ startF) (r.= (r.int 0)))
+ (@@ subject)
+ (text-clip (inc (@@ startF))
+ (inc (@@ subjectL))
+ (@@ subject))))
+ (list ["fixed" (r.bool true)])
+ (r.global "regexpr"))
+ (r.nth (r.int 1))))
+ (r.if (|> (@@ idx) (r.= (r.int -1)))
+ ..none
+ (..some (int//from-float (|> (@@ idx) (r.+ (@@ startF)))))))
+ ..none))))
(runtime: (text//clip text from to)
(with-vars [length]
- ($_ r.then!
+ ($_ r.then
(r.set! length (r.length (@@ text)))
- (r.do!
- (r.if ($_ r.and
- (|> (@@ to) (within? (@@ length)))
- (|> (@@ from) (up-to? (@@ to))))
- (..some (text-clip (inc (@@ from)) (inc (@@ to)) (@@ text)))
- ..none)))))
+ (r.if ($_ r.and
+ (|> (@@ to) (within? (@@ length)))
+ (|> (@@ from) (up-to? (@@ to))))
+ (..some (text-clip (inc (@@ from)) (inc (@@ to)) (@@ text)))
+ ..none))))
(def: (char-at idx text)
(-> Expression Expression Expression)
@@ -848,66 +841,66 @@
(r.global "utf8ToInt")))
(runtime: (text//char text idx)
- (r.if! (|> (@@ idx) (within? (r.length (@@ text))))
- ($_ r.then!
- (r.set! idx (inc (@@ idx)))
- (r.do! (..some (int//from-float (char-at (@@ idx) (@@ text))))))
- (r.do! ..none)))
+ (r.if (|> (@@ idx) (within? (r.length (@@ text))))
+ ($_ r.then
+ (r.set! idx (inc (@@ idx)))
+ (..some (int//from-float (char-at (@@ idx) (@@ text)))))
+ ..none))
(runtime: (text//hash input)
(let [bits-32 (r.code "0xFFFFFFFF")]
(with-vars [idx hash]
- ($_ r.then!
+ ($_ r.then
(r.set! hash (r.int 0))
- (r.for-in! idx (r.range (r.int 1) (text-length (@@ input)))
- (r.set! hash (|> (@@ hash)
- (r.bit-shl (r.int 5))
- (r.- (@@ hash))
- (r.+ (char-at (@@ idx) (@@ input)))
- (r.bit-and bits-32))))
- (r.do! (int//from-float (@@ hash)))))))
+ (r.for-in idx (r.range (r.int 1) (text-length (@@ input)))
+ (r.set! hash (|> (@@ hash)
+ (r.bit-shl (r.int 5))
+ (r.- (@@ hash))
+ (r.+ (char-at (@@ idx) (@@ input)))
+ (r.bit-and bits-32))))
+ (int//from-float (@@ hash))))))
(def: runtime//text
Runtime
- ($_ r.then!
+ ($_ r.then
@@text//index
@@text//clip
@@text//char
@@text//hash))
-(def: (check-index-out-of-bounds array idx body!)
- (-> Expression Expression Statement Statement)
- (r.if! (|> idx (r.<= (r.length array)))
- body!
- (r.stop! (r.string "Array index out of bounds!"))))
+(def: (check-index-out-of-bounds array idx body)
+ (-> Expression Expression Expression Expression)
+ (r.if (|> idx (r.<= (r.length array)))
+ body
+ (r.stop (r.string "Array index out of bounds!"))))
(runtime: (array//new size)
(with-vars [output]
- ($_ r.then!
+ ($_ r.then
(r.set! output (r.list (list)))
(r.set-nth! (|> (@@ size) (r.+ (r.int 1)))
r.null
output)
- (r.do! (@@ output)))))
+ (@@ output))))
(runtime: (array//get array idx)
(with-vars [temp]
(<| (check-index-out-of-bounds (@@ array) (@@ idx))
- ($_ r.then!
+ ($_ r.then
(r.set! temp (|> (@@ array) (r.nth (@@ idx))))
- (r.if! (|> (@@ temp) (r.= r.null))
- (r.do! ..none)
- (r.do! (..some (@@ temp))))))))
+ (r.if (|> (@@ temp) (r.= r.null))
+ ..none
+ (..some (@@ temp)))))))
(runtime: (array//put array idx value)
(<| (check-index-out-of-bounds (@@ array) (@@ idx))
- ($_ r.then!
+ ($_ r.then
(r.set-nth! (@@ idx) (@@ value) array)
- (r.do! (@@ array)))))
+ (@@ array))))
(def: runtime//array
Runtime
- ($_ r.then!
+ ($_ r.then
@@array//new
@@array//get
@@array//put))
@@ -916,27 +909,25 @@
(runtime: (atom//compare-and-swap atom old new)
(let [atom//field (r.string atom//field)]
- (r.do!
- (r.if (|> (@@ atom) (r.nth atom//field) (r.= (@@ old)))
- (r.block
- ($_ r.then!
- (r.set-nth! atom//field (@@ new) atom)
- (r.do! (r.bool true))))
- (r.bool false)))))
+ (r.if (|> (@@ atom) (r.nth atom//field) (r.= (@@ old)))
+ ($_ r.then
+ (r.set-nth! atom//field (@@ new) atom)
+ (r.bool true))
+ (r.bool false))))
(def: runtime//atom
Runtime
- ($_ r.then!
+ ($_ r.then
@@atom//compare-and-swap))
(runtime: (box//write value box)
- ($_ r.then!
+ ($_ r.then
(r.set-nth! (r.int 1) (@@ value) box)
- (r.do! ..unit)))
+ ..unit))
(def: runtime//box
Runtime
- ($_ r.then!
+ ($_ r.then
@@box//write))
(def: process//incoming
@@ -944,51 +935,51 @@
(r.var (lang.normalize-name "process//incoming")))
(def: (list-append! value rlist)
- (-> Expression SVar Statement)
+ (-> Expression SVar Expression)
(r.set-nth! (r.length (@@ rlist)) value rlist))
(runtime: (process//loop _)
(let [empty (r.list (list))]
(with-vars [queue process]
- (let [migrate-incoming! ($_ r.then!
+ (let [migrate-incoming! ($_ r.then
(r.set! queue empty)
- (<| (r.for-in! process (@@ process//incoming))
+ (<| (r.for-in process (@@ process//incoming))
(list-append! (@@ process) queue))
(r.set! process//incoming empty))
- consume-queue! (<| (r.for-in! process (@@ queue))
- (r.do! (r.apply (list ..unit) (@@ process))))]
- ($_ r.then!
+ consume-queue! (<| (r.for-in process (@@ queue))
+ (r.apply (list ..unit) (@@ process)))]
+ ($_ r.then
migrate-incoming!
consume-queue!
- (r.when! (|> (r.length (@@ queue)) (r.> (r.int 0)))
- (r.do! (process//loop ..unit))))))))
+ (r.when (|> (r.length (@@ queue)) (r.> (r.int 0)))
+ (process//loop ..unit)))))))
(runtime: (process//future procedure)
- ($_ r.then!
+ ($_ r.then
(list-append! (@@ procedure) process//incoming)
- (r.do! ..unit)))
+ ..unit))
(runtime: (process//schedule milli-seconds procedure)
(let [to-seconds (|>> (r./ (r.float 1_000.0)))
to-millis (|>> (r.* (r.float 1_000.0)))]
(with-vars [start now seconds _arg elapsed-time]
- ($_ r.then!
+ ($_ r.then
(r.set! start current-time-float)
(r.set! seconds (to-seconds (@@ milli-seconds)))
(list-append! (r.function (list _arg)
- ($_ r.then!
+ ($_ r.then
(r.set! now current-time-float)
(r.set! elapsed-time (|> (@@ now) (r.- (@@ start))))
- (r.if! (|> (@@ elapsed-time) (r.>= (@@ seconds)))
- (r.do! (@@ procedure))
- (r.do! (process//schedule (to-millis (@@ elapsed-time))
- (@@ procedure))))))
+ (r.if (|> (@@ elapsed-time) (r.>= (@@ seconds)))
+ (@@ procedure)
+ (process//schedule (to-millis (@@ elapsed-time))
+ (@@ procedure)))))
process//incoming)
- (r.do! ..unit)))))
+ ..unit))))
(def: runtime//process
Runtime
- ($_ r.then!
+ ($_ r.then
(r.set! process//incoming (r.list (list)))
@@process//loop
@@process//future
@@ -997,7 +988,7 @@
(def: runtime
Runtime
- ($_ r.then!
+ ($_ r.then
runtime//int
runtime//lux
runtime//adt
diff --git a/new-luxc/source/luxc/lang/translation/r/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/r/statement.jvm.lux
index 317abcf73..04a31d687 100644
--- a/new-luxc/source/luxc/lang/translation/r/statement.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/r/statement.jvm.lux
@@ -4,7 +4,7 @@
[macro]
(data text/format))
(luxc (lang [".L" module]
- (host [r #+ Expression Statement @@])))
+ (host [r #+ Expression @@])))
[//]
(// [".T" runtime]
[".T" reference]
@@ -41,5 +41,5 @@
)))
(def: #export (translate-program programO)
- (-> Expression (Meta Statement))
+ (-> Expression (Meta Expression))
(macro.fail "translate-program NOT IMPLEMENTED YET"))
diff --git a/new-luxc/source/luxc/lang/translation/r/structure.jvm.lux b/new-luxc/source/luxc/lang/translation/r/structure.jvm.lux
index 16d144f93..bfe0a40a6 100644
--- a/new-luxc/source/luxc/lang/translation/r/structure.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/r/structure.jvm.lux
@@ -6,7 +6,7 @@
[macro])
(luxc ["&" lang]
(lang [synthesis #+ Synthesis]
- (host [r #+ Expression Statement])))
+ (host [r #+ Expression])))
[//]
(// [".T" runtime]))