diff options
Diffstat (limited to 'new-luxc/source')
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])) |