aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux/target/r.lux378
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/r.lux34
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/r.lux17
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux179
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/r/host.lux39
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/r.lux58
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/case.lux239
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/function.lux116
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/loop.lux64
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/primitive.lux17
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/procedure/common.lux339
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/procedure/host.lux89
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/reference.lux12
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux848
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/structure.lux39
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux3
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux5
-rw-r--r--stdlib/source/lux/tool/compiler/meta/io/context.lux5
-rw-r--r--stdlib/source/lux/tool/compiler/meta/packager/script.lux7
21 files changed, 2480 insertions, 12 deletions
diff --git a/stdlib/source/lux/target/r.lux b/stdlib/source/lux/target/r.lux
new file mode 100644
index 000000000..c60456ad2
--- /dev/null
+++ b/stdlib/source/lux/target/r.lux
@@ -0,0 +1,378 @@
+(.module:
+ [lux (#- Code or and list if function cond not int)
+ [control
+ [pipe (#+ case> cond> new>)]
+ ["." function]
+ [parser
+ ["<.>" code]]]
+ [data
+ ["." maybe ("#\." functor)]
+ ["." text
+ ["%" format (#+ format)]]
+ [collection
+ ["." list ("#\." functor fold)]]]
+ [macro
+ [syntax (#+ syntax:)]
+ ["." template]
+ ["." code]]
+ [math
+ [number
+ ["f" frac]]]
+ [type
+ abstract]])
+
+(abstract: #export (Code kind)
+ Text
+
+ {}
+
+ (template [<type> <super>+]
+ [(with_expansions [<kind> (template.identifier [<type> "'"])]
+ (abstract: #export (<kind> kind) Any)
+ (`` (type: #export <type> (|> Any <kind> (~~ (template.splice <super>+))))))]
+
+ [Expression [Code]]
+ )
+
+ (template [<type> <super>+]
+ [(with_expansions [<kind> (template.identifier [<type> "'"])]
+ (abstract: #export (<kind> kind) Any)
+ (`` (type: #export (<type> <brand>) (|> <brand> <kind> (~~ (template.splice <super>+))))))]
+
+ [Var [Expression' Code]]
+ )
+
+ (template [<var> <kind>]
+ [(abstract: #export <kind> Any)
+ (type: #export <var> (Var <kind>))]
+
+ [SVar Single]
+ [PVar Poly]
+ )
+
+ (def: #export var
+ (-> Text SVar)
+ (|>> :abstraction))
+
+ (def: #export var_args
+ PVar
+ (:abstraction "..."))
+
+ (def: #export manual
+ (-> Text Code)
+ (|>> :abstraction))
+
+ (def: #export code
+ (-> (Code Any) Text)
+ (|>> :representation))
+
+ (def: (self_contained code)
+ (-> Text Expression)
+ (:abstraction
+ (format "(" code ")")))
+
+ (def: nest
+ (-> Text Text)
+ (let [nested_new_line (format text.new_line text.tab)]
+ (|>> (format text.new_line)
+ (text.replace_all text.new_line nested_new_line))))
+
+ (def: (_block expression)
+ (-> Text Text)
+ (format "{" (nest expression) text.new_line "}"))
+
+ (def: #export (block expression)
+ (-> Expression Expression)
+ (:abstraction
+ (format "{" (:representation expression) "}")))
+
+ (template [<name> <r>]
+ [(def: #export <name>
+ Expression
+ (..self_contained <r>))]
+
+ [null "NULL"]
+ [n/a "NA"]
+ )
+
+ (template [<name>]
+ [(def: #export <name> Expression n/a)]
+
+ [not_available]
+ [not_applicable]
+ [no_answer]
+ )
+
+ (def: #export bool
+ (-> Bit Expression)
+ (|>> (case> #0 "FALSE"
+ #1 "TRUE")
+ ..self_contained))
+
+ (def: #export (int value)
+ (-> Int Expression)
+ (..self_contained (format "as.integer(" (%.int value) ")")))
+
+ (def: #export float
+ (-> Frac Expression)
+ (|>> (cond> [(f.= f.positive_infinity)]
+ [(new> "1.0/0.0" [])]
+
+ [(f.= f.negative_infinity)]
+ [(new> "-1.0/0.0" [])]
+
+ [(f.= f.not_a_number)]
+ [(new> "0.0/0.0" [])]
+
+ ## else
+ [%.frac])
+ ..self_contained))
+
+ (def: sanitize
+ (-> Text Text)
+ (`` (|>> (~~ (template [<find> <replace>]
+ [(text.replace_all <find> <replace>)]
+
+ ["\" "\\"]
+ ["|" "\|"]
+ [text.alarm "\a"]
+ [text.back_space "\b"]
+ [text.tab "\t"]
+ [text.new_line "\n"]
+ [text.carriage_return "\r"]
+ [text.double_quote (format "\" text.double_quote)]
+ ))
+ )))
+
+ (def: #export string
+ (-> Text Expression)
+ (|>> %.text ..sanitize ..self_contained))
+
+ (def: (composite_literal left_delimiter right_delimiter entry_serializer)
+ (All [a] (-> Text Text (-> a Text)
+ (-> (List a) Expression)))
+ (.function (_ entries)
+ (..self_contained
+ (format left_delimiter
+ (|> entries (list\map entry_serializer) (text.join_with ","))
+ right_delimiter))))
+
+ (def: #export named_list
+ (-> (List [Text Expression]) Expression)
+ (composite_literal "list(" ")" (.function (_ [key value])
+ (format key "=" (:representation value)))))
+
+ (template [<name> <function>]
+ [(def: #export <name>
+ (-> (List Expression) Expression)
+ (composite_literal (format <function> "(") ")" ..code))]
+
+ [vector "c"]
+ [list "list"]
+ )
+
+ (def: #export (slice from to list)
+ (-> Expression Expression Expression Expression)
+ (..self_contained
+ (format (:representation list)
+ "[" (:representation from) ":" (:representation to) "]")))
+
+ (def: #export (slice_from from list)
+ (-> Expression Expression Expression)
+ (..self_contained
+ (format (:representation list)
+ "[-1" ":-" (:representation from) "]")))
+
+ (def: #export (apply args func)
+ (-> (List Expression) Expression Expression)
+ (..self_contained
+ (format (:representation func) "(" (text.join_with "," (list\map ..code args)) ")")))
+
+ (def: #export (apply_kw args kw_args func)
+ (-> (List Expression) (List [Text Expression]) Expression Expression)
+ (..self_contained
+ (format (:representation func)
+ (format "("
+ (text.join_with "," (list\map ..code args)) ","
+ (text.join_with "," (list\map (.function (_ [key val])
+ (format key "=" (:representation val)))
+ kw_args))
+ ")"))))
+
+ (syntax: (arity_inputs {arity <code>.nat})
+ (wrap (case arity
+ 0 (.list)
+ _ (|> arity
+ list.indices
+ (list\map (|>> %.nat code.local_identifier))))))
+
+ (syntax: (arity_types {arity <code>.nat})
+ (wrap (list.repeat arity (` ..Expression))))
+
+ (template [<arity> <function>+]
+ [(with_expansions [<apply> (template.identifier ["apply/" <arity>])
+ <inputs> (arity_inputs <arity>)
+ <types> (arity_types <arity>)
+ <definitions> (template.splice <function>+)]
+ (def: #export (<apply> function [<inputs>])
+ (-> Expression [<types>] Expression)
+ (..apply (.list <inputs>) function))
+
+ (template [<function>]
+ [(`` (def: #export (~~ (template.identifier [<function> "/" <arity>]))
+ (-> [<types>] Expression)
+ (<apply> (..var <function>))))]
+
+ <definitions>))]
+
+ [0
+ [["commandArgs"]]]
+ [1
+ []]
+ [2
+ []]
+ )
+
+ (def: #export (nth idx list)
+ (-> Expression Expression Expression)
+ (..self_contained
+ (format (:representation list) "[[" (:representation idx) "]]")))
+
+ (def: #export (if test then else)
+ (-> Expression Expression Expression Expression)
+ (..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))
+ text.new_line "}")))
+
+ (def: #export (cond clauses else)
+ (-> (List [Expression Expression]) Expression Expression)
+ (list\fold (.function (_ [test then] next)
+ (if test then next))
+ else
+ (list.reverse clauses)))
+
+ (template [<name> <op>]
+ [(def: #export (<name> param subject)
+ (-> Expression Expression Expression)
+ (..self_contained
+ (format (:representation subject)
+ " " <op> " "
+ (:representation param))))]
+
+ [= "=="]
+ [< "<"]
+ [<= "<="]
+ [> ">"]
+ [>= ">="]
+ [+ "+"]
+ [- "-"]
+ [* "*"]
+ [/ "/"]
+ [%% "%%"]
+ [** "**"]
+ [or "||"]
+ [and "&&"]
+ )
+
+ (template [<name> <func>]
+ [(def: #export (<name> param subject)
+ (-> Expression Expression Expression)
+ (..apply (.list subject param) (..var <func>)))]
+
+ [bit_or "bitwOr"]
+ [bit_and "bitwAnd"]
+ [bit_xor "bitwXor"]
+ [bit_shl "bitwShiftL"]
+ [bit_ushr "bitwShiftR"]
+ )
+
+ (def: #export (bit_not subject)
+ (-> Expression Expression)
+ (..apply (.list subject) (..var "bitwNot")))
+
+ (template [<name> <op>]
+ [(def: #export <name>
+ (-> Expression Expression)
+ (|>> :representation (format <op>) ..self_contained))]
+
+ [not "!"]
+ [negate "-"]
+ )
+
+ (def: #export (length list)
+ (-> Expression Expression)
+ (..apply (.list list) (..var "length")))
+
+ (def: #export (range from to)
+ (-> Expression 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 ..code) (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 function.identity)
+ (optional "error" error function.identity)
+ (optional "finally" finally .._block)
+ ")"))))
+
+ (def: #export (while test body)
+ (-> Expression Expression Expression)
+ (..self_contained
+ (format "while (" (:representation test) ") "
+ (.._block (:representation body)))))
+
+ (def: #export (for_in var inputs body)
+ (-> SVar Expression Expression Expression)
+ (..self_contained
+ (format "for (" (:representation var) " in " (:representation inputs) ")"
+ (.._block (:representation body)))))
+
+ (template [<name> <keyword>]
+ [(def: #export (<name> message)
+ (-> Expression Expression)
+ (..apply (.list message) (..var <keyword>)))]
+
+ [stop "stop"]
+ [print "print"]
+ )
+
+ (def: #export (set! var value)
+ (-> SVar Expression Expression)
+ (..self_contained
+ (format (:representation var) " <- " (:representation value))))
+
+ (def: #export (set_nth! idx value list)
+ (-> Expression Expression SVar Expression)
+ (..self_contained
+ (format (:representation list) "[[" (:representation idx) "]] <- " (:representation value))))
+
+ (def: #export (then pre post)
+ (-> Expression Expression Expression)
+ (:abstraction
+ (format (:representation pre)
+ text.new_line
+ (:representation post))))
+ )
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/r.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/r.lux
new file mode 100644
index 000000000..12f578ed2
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/analysis/r.lux
@@ -0,0 +1,34 @@
+(.module:
+ [lux #*
+ ["." ffi]
+ [abstract
+ ["." monad (#+ do)]]
+ [control
+ ["<>" parser
+ ["<c>" code (#+ Parser)]]]
+ [data
+ [collection
+ ["." array (#+ Array)]
+ ["." dictionary]
+ ["." list]]]
+ ["." type
+ ["." check]]
+ ["@" target
+ ["_" r]]]
+ [//
+ ["/" lux (#+ custom)]
+ [//
+ ["." bundle]
+ [//
+ ["." analysis #_
+ ["#/." type]]
+ [//
+ ["." analysis (#+ Analysis Operation Phase Handler Bundle)]
+ [///
+ ["." phase]]]]]])
+
+(def: #export bundle
+ Bundle
+ (<| (bundle.prefix "r")
+ (|> bundle.empty
+ )))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/r.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/r.lux
new file mode 100644
index 000000000..cd0f6b7cc
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/r.lux
@@ -0,0 +1,17 @@
+(.module:
+ [lux #*
+ [data
+ [collection
+ ["." dictionary]]]]
+ ["." / #_
+ ["#." common]
+ ["#." host]
+ [////
+ [generation
+ [r
+ [runtime (#+ Bundle)]]]]])
+
+(def: #export bundle
+ Bundle
+ (dictionary.merge /common.bundle
+ /host.bundle))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux
new file mode 100644
index 000000000..cb82c6cb4
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux
@@ -0,0 +1,179 @@
+(.module:
+ [lux #*
+ [abstract
+ ["." monad (#+ do)]]
+ [control
+ ["." function]
+ ["." try]
+ ["<>" parser
+ ["<s>" synthesis (#+ Parser)]]]
+ [data
+ ["." product]
+ ["." text
+ ["%" format (#+ format)]]
+ [collection
+ ["." dictionary]
+ ["." set]
+ ["." list ("#\." functor fold)]]]
+ [math
+ [number
+ ["f" frac]]]
+ ["@" target
+ ["_" r (#+ Expression)]]]
+ ["." //// #_
+ ["/" bundle]
+ ["/#" // #_
+ ["." extension]
+ [generation
+ [extension (#+ Nullary Unary Binary Trinary
+ nullary unary binary trinary)]
+ ["." reference]
+ ["//" r #_
+ ["#." runtime (#+ Operation Phase Handler Bundle Generator)]
+ ["#." case]]]
+ [//
+ ["." synthesis (#+ %synthesis)]
+ ["." generation]
+ [///
+ ["#" phase]]]]])
+
+(def: #export (custom [parser handler])
+ (All [s]
+ (-> [(Parser s)
+ (-> Text (Generator s))]
+ Handler))
+ (function (_ extension_name phase archive input)
+ (case (<s>.run parser input)
+ (#try.Success input')
+ (handler extension_name phase archive input')
+
+ (#try.Failure error)
+ (/////.throw extension.invalid_syntax [extension_name %synthesis input]))))
+
+## (template: (!unary function)
+## (|>> list _.apply/* (|> (_.constant function))))
+
+## ## ## TODO: Get rid of this ASAP
+## ## (def: lux::syntax_char_case!
+## ## (..custom [($_ <>.and
+## ## <s>.any
+## ## <s>.any
+## ## (<>.some (<s>.tuple ($_ <>.and
+## ## (<s>.tuple (<>.many <s>.i64))
+## ## <s>.any))))
+## ## (function (_ extension_name phase archive [input else conditionals])
+## ## (do {! /////.monad}
+## ## [@input (\ ! map _.var (generation.gensym "input"))
+## ## inputG (phase archive input)
+## ## elseG (phase archive else)
+## ## conditionalsG (: (Operation (List [Expression Expression]))
+## ## (monad.map ! (function (_ [chars branch])
+## ## (do !
+## ## [branchG (phase archive branch)]
+## ## (wrap [(|> chars (list\map (|>> .int _.int (_.=/2 @input))) _.or)
+## ## branchG])))
+## ## conditionals))]
+## ## (wrap (_.let (list [@input inputG])
+## ## (list (list\fold (function (_ [test then] else)
+## ## (_.if test then else))
+## ## elseG
+## ## conditionalsG))))))]))
+
+## (def: lux_procs
+## Bundle
+## (|> /.empty
+## ## (/.install "syntax char case!" lux::syntax_char_case!)
+## (/.install "is" (binary _.eq/2))
+## ## (/.install "try" (unary //runtime.lux//try))
+## ))
+
+## ## (def: (capped operation parameter subject)
+## ## (-> (-> Expression Expression Expression)
+## ## (-> Expression Expression Expression))
+## ## (//runtime.i64//64 (operation parameter subject)))
+
+## (def: i64_procs
+## Bundle
+## (<| (/.prefix "i64")
+## (|> /.empty
+## (/.install "and" (binary _.logand/2))
+## (/.install "or" (binary _.logior/2))
+## (/.install "xor" (binary _.logxor/2))
+## (/.install "left-shift" (binary _.ash/2))
+## (/.install "right-shift" (binary (product.uncurry //runtime.i64//right_shift)))
+## (/.install "=" (binary _.=/2))
+## (/.install "<" (binary _.</2))
+## (/.install "+" (binary _.+/2))
+## (/.install "-" (binary _.-/2))
+## (/.install "*" (binary _.*/2))
+## (/.install "/" (binary _.floor/2))
+## (/.install "%" (binary _.rem/2))
+## ## (/.install "f64" (unary (_.//2 (_.float +1.0))))
+## (/.install "char" (unary (|>> _.code-char/1 _.string/1)))
+## )))
+
+## (def: f64_procs
+## Bundle
+## (<| (/.prefix "f64")
+## (|> /.empty
+## ## (/.install "=" (binary (product.uncurry _.=/2)))
+## ## (/.install "<" (binary (product.uncurry _.</2)))
+## ## (/.install "+" (binary (product.uncurry _.+/2)))
+## ## (/.install "-" (binary (product.uncurry _.-/2)))
+## ## (/.install "*" (binary (product.uncurry _.*/2)))
+## ## (/.install "/" (binary (product.uncurry _.//2)))
+## ## (/.install "%" (binary (product.uncurry _.rem/2)))
+## ## (/.install "i64" (unary _.truncate/1))
+## (/.install "encode" (unary _.write-to-string/1))
+## ## (/.install "decode" (unary //runtime.f64//decode))
+## )))
+
+## (def: (text//index [offset sub text])
+## (Trinary (Expression Any))
+## (//runtime.text//index offset sub text))
+
+## (def: (text//clip [offset length text])
+## (Trinary (Expression Any))
+## (//runtime.text//clip offset length text))
+
+## (def: (text//char [index text])
+## (Binary (Expression Any))
+## (_.char-code/1 (_.char/2 [text index])))
+
+## (def: text_procs
+## Bundle
+## (<| (/.prefix "text")
+## (|> /.empty
+## (/.install "=" (binary _.string=/2))
+## ## (/.install "<" (binary (product.uncurry _.string<?/2)))
+## (/.install "concat" (binary (function (_ [left right])
+## (_.concatenate/3 [(_.symbol "string") left right]))))
+## (/.install "index" (trinary ..text//index))
+## (/.install "size" (unary _.length/1))
+## (/.install "char" (binary ..text//char))
+## (/.install "clip" (trinary ..text//clip))
+## )))
+
+## (def: (io//log! message)
+## (Unary (Expression Any))
+## (_.progn (list (_.write-line/1 message)
+## //runtime.unit)))
+
+## (def: io_procs
+## Bundle
+## (<| (/.prefix "io")
+## (|> /.empty
+## (/.install "log" (unary ..io//log!))
+## (/.install "error" (unary _.error/1))
+## )))
+
+(def: #export bundle
+ Bundle
+ (<| (/.prefix "lux")
+ (|> /.empty
+ ## (dictionary.merge lux_procs)
+ ## (dictionary.merge i64_procs)
+ ## (dictionary.merge f64_procs)
+ ## (dictionary.merge text_procs)
+ ## (dictionary.merge io_procs)
+ )))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/r/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/r/host.lux
new file mode 100644
index 000000000..2d9148dda
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/r/host.lux
@@ -0,0 +1,39 @@
+(.module:
+ [lux #*
+ [abstract
+ ["." monad (#+ do)]]
+ [control
+ ["." function]
+ ["<>" parser
+ ["<s>" synthesis (#+ Parser)]]]
+ [data
+ [collection
+ ["." dictionary]
+ ["." list]]
+ [text
+ ["%" format (#+ format)]]]
+ [target
+ ["_" r (#+ Var Expression)]]]
+ ["." // #_
+ ["#." common (#+ custom)]
+ ["//#" /// #_
+ ["/" bundle]
+ ["/#" // #_
+ ["." extension]
+ [generation
+ [extension (#+ Nullary Unary Binary Trinary
+ nullary unary binary trinary)]
+ ["." reference]
+ ["//" r #_
+ ["#." runtime (#+ Operation Phase Handler Bundle
+ with_vars)]]]
+ ["/#" // #_
+ ["." generation]
+ ["//#" /// #_
+ ["#." phase]]]]]])
+
+(def: #export bundle
+ Bundle
+ (<| (/.prefix "r")
+ (|> /.empty
+ )))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r.lux
new file mode 100644
index 000000000..b4b3e6423
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r.lux
@@ -0,0 +1,58 @@
+(.module:
+ [lux #*
+ [abstract
+ [monad (#+ do)]]
+ [target
+ ["_" r]]]
+ ["." / #_
+ [runtime (#+ Phase)]
+ ["#." primitive]
+ ["#." structure]
+ ["#." reference]
+ ["#." case]
+ ["#." loop]
+ ["#." function]
+ ["/#" // #_
+ ["#." reference]
+ ["/#" // #_
+ ["#." extension]
+ ["/#" // #_
+ [analysis (#+)]
+ ["#." synthesis]
+ ["//#" /// #_
+ ["#." phase ("#\." monad)]
+ [reference (#+)
+ [variable (#+)]]]]]]])
+
+(def: #export (generate archive synthesis)
+ Phase
+ (case synthesis
+ (^template [<tag> <generator>]
+ [(^ (<tag> value))
+ (//////phase\wrap (<generator> value))])
+ ([////synthesis.bit /primitive.bit]
+ [////synthesis.i64 /primitive.i64]
+ [////synthesis.f64 /primitive.f64]
+ [////synthesis.text /primitive.text])
+
+ (#////synthesis.Reference value)
+ (//reference.reference /reference.system archive value)
+
+ (^template [<tag> <generator>]
+ [(^ (<tag> value))
+ (<generator> generate archive value)])
+ ([////synthesis.variant /structure.variant]
+ [////synthesis.tuple /structure.tuple]
+ [////synthesis.branch/let /case.let]
+ [////synthesis.branch/if /case.if]
+ [////synthesis.branch/get /case.get]
+ [////synthesis.function/apply /function.apply]
+
+ [////synthesis.branch/case /case.case]
+ [////synthesis.loop/scope /loop.scope]
+ [////synthesis.loop/recur /loop.recur]
+ [////synthesis.function/abstraction /function.function])
+
+ (#////synthesis.Extension extension)
+ (///extension.apply archive generate extension)
+ ))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/case.lux
new file mode 100644
index 000000000..fe4e4a7c2
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/case.lux
@@ -0,0 +1,239 @@
+(.module:
+ [lux (#- case let if)
+ [abstract
+ ["." monad (#+ do)]]
+ [data
+ ["." product]
+ ["." text
+ ["%" format (#+ format)]]
+ [collection
+ ["." list ("#\." functor fold)]
+ ["." set]]]
+ [macro
+ ["." template]]
+ [math
+ [number
+ ["i" int]]]
+ [target
+ ["_" r (#+ Expression SVar)]]]
+ ["." // #_
+ ["#." runtime (#+ Operation Phase Generator)]
+ ["#." reference]
+ ["#." primitive]
+ ["/#" // #_
+ ["#." reference]
+ ["/#" // #_
+ ["#." synthesis #_
+ ["#/." case]]
+ ["/#" // #_
+ ["#." synthesis (#+ Member Synthesis Path)]
+ ["#." generation]
+ ["//#" /// #_
+ [reference
+ ["#." variable (#+ Register)]]
+ ["#." phase ("#\." monad)]
+ [meta
+ [archive (#+ Archive)]]]]]]])
+
+(def: #export register
+ (-> Register SVar)
+ (|>> (///reference.local //reference.system) :assume))
+
+(def: #export capture
+ (-> Register SVar)
+ (|>> (///reference.foreign //reference.system) :assume))
+
+(def: #export (let expression archive [valueS register bodyS])
+ (Generator [Synthesis Register Synthesis])
+ (do ///////phase.monad
+ [valueO (expression archive valueS)
+ bodyO (expression archive bodyS)]
+ (wrap (_.block
+ ($_ _.then
+ (_.set! (..register register) valueO)
+ bodyO)))))
+
+(def: #export (if expression archive [testS thenS elseS])
+ (Generator [Synthesis Synthesis Synthesis])
+ (do ///////phase.monad
+ [testO (expression archive testS)
+ thenO (expression archive thenS)
+ elseO (expression archive elseS)]
+ (wrap (_.if testO thenO elseO))))
+
+(def: #export (get expression archive [pathP valueS])
+ (Generator [(List Member) Synthesis])
+ (do ///////phase.monad
+ [valueO (expression archive valueS)]
+ (wrap (list\fold (function (_ side source)
+ (.let [method (.case side
+ (^template [<side> <accessor>]
+ [(<side> lefts)
+ (<accessor> (_.int (.int lefts)))])
+ ([#.Left //runtime.tuple::left]
+ [#.Right //runtime.tuple::right]))]
+ (method source)))
+ valueO
+ (list.reverse pathP)))))
+
+(def: $savepoint (_.var "lux_pm_cursor_savepoint"))
+(def: $cursor (_.var "lux_pm_cursor"))
+(def: $temp (_.var "lux_pm_temp"))
+(def: $alt_error (_.var "alt_error"))
+
+(def: top
+ _.length)
+
+(def: next
+ (|>> _.length (_.+ (_.int +1))))
+
+(def: (push! value var)
+ (-> Expression SVar Expression)
+ (_.set_nth! (next var) value var))
+
+(def: (pop! var)
+ (-> SVar Expression)
+ (_.set_nth! (top var) _.null var))
+
+(def: (push_cursor! value)
+ (-> Expression Expression)
+ (push! value $cursor))
+
+(def: save_cursor!
+ Expression
+ (push! (_.slice (_.float +1.0) (_.length $cursor) $cursor)
+ $savepoint))
+
+(def: restore_cursor!
+ Expression
+ (_.set! $cursor (_.nth (top $savepoint) $savepoint)))
+
+(def: peek
+ Expression
+ (|> $cursor (_.nth (top $cursor))))
+
+(def: pop_cursor!
+ Expression
+ (pop! $cursor))
+
+(def: error
+ (_.string (template.with_locals [error]
+ (template.text [error]))))
+
+(def: fail!
+ (_.stop ..error))
+
+(def: (catch handler)
+ (-> Expression Expression)
+ (_.function (list $alt_error)
+ (_.if (|> $alt_error (_.= ..error))
+ handler
+ (_.stop $alt_error))))
+
+(def: (pattern_matching' expression archive)
+ (Generator Path)
+ (function (recur pathP)
+ (.case pathP
+ (#/////synthesis.Then bodyS)
+ (expression archive bodyS)
+
+ #/////synthesis.Pop
+ (///////phase\wrap ..pop_cursor!)
+
+ (#/////synthesis.Bind register)
+ (///////phase\wrap (_.set! (..register register) ..peek))
+
+ (#/////synthesis.Bit_Fork when thenP elseP)
+ (do {! ///////phase.monad}
+ [then! (recur thenP)
+ else! (.case elseP
+ (#.Some elseP)
+ (recur elseP)
+
+ #.None
+ (wrap ..fail!))]
+ (wrap (.if when
+ (_.if ..peek
+ then!
+ else!)
+ (_.if ..peek
+ else!
+ then!))))
+
+ (^template [<tag> <format> <=>]
+ [(<tag> cons)
+ (do {! ///////phase.monad}
+ [clauses (monad.map ! (function (_ [match then])
+ (do !
+ [then! (recur then)]
+ (wrap [(<=> (|> match <format>)
+ ..peek)
+ then!])))
+ (#.Cons cons))]
+ (wrap (list\fold (function (_ [when then] else)
+ (_.if when then else))
+ ..fail!
+ clauses)))])
+ ([#/////synthesis.I64_Fork //primitive.i64 //runtime.i64::=]
+ [#/////synthesis.F64_Fork //primitive.f64 _.=]
+ [#/////synthesis.Text_Fork //primitive.text _.=])
+
+ (^template [<pm> <flag> <prep>]
+ [(^ (<pm> idx))
+ (///////phase\wrap ($_ _.then
+ (_.set! $temp (|> idx <prep> .int _.int (//runtime.sum::get ..peek (//runtime.flag <flag>))))
+ (_.if (_.= _.null $temp)
+ ..fail!
+ (..push_cursor! $temp))))])
+ ([/////synthesis.side/left false (<|)]
+ [/////synthesis.side/right true inc])
+
+ (^ (/////synthesis.member/left 0))
+ (///////phase\wrap (_.nth (_.int +1) ..peek))
+
+ (^template [<pm> <getter>]
+ [(^ (<pm> lefts))
+ (///////phase\wrap (|> ..peek (<getter> (_.int (.int lefts))) ..push_cursor!))])
+ ([/////synthesis.member/left //runtime.tuple::left]
+ [/////synthesis.member/right //runtime.tuple::right])
+
+ (^ (/////synthesis.path/seq leftP rightP))
+ (do ///////phase.monad
+ [leftO (recur leftP)
+ rightO (recur rightP)]
+ (wrap ($_ _.then
+ leftO
+ rightO)))
+
+ (^ (/////synthesis.path/alt leftP rightP))
+ (do {! ///////phase.monad}
+ [leftO (recur leftP)
+ rightO (recur rightP)]
+ (wrap (_.try ($_ _.then
+ ..save_cursor!
+ leftO)
+ #.None
+ (#.Some (..catch ($_ _.then
+ ..restore_cursor!
+ rightO)))
+ #.None)))
+ )))
+
+(def: (pattern_matching expression archive pathP)
+ (Generator Path)
+ (do ///////phase.monad
+ [pattern_matching! (pattern_matching' expression archive pathP)]
+ (wrap (_.try pattern_matching!
+ #.None
+ (#.Some (..catch (_.stop (_.string "Invalid expression for pattern-matching."))))
+ #.None))))
+
+(def: #export (case expression archive [valueS pathP])
+ (Generator [Synthesis Path])
+ (do {! ///////phase.monad}
+ [valueO (expression archive valueS)]
+ (<| (\ ! map (|>> ($_ _.then
+ (_.set! $cursor (_.list (list valueO)))
+ (_.set! $savepoint (_.list (list))))
+ _.block))
+ (pattern_matching expression archive pathP))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/function.lux
new file mode 100644
index 000000000..c89ffaf0a
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/function.lux
@@ -0,0 +1,116 @@
+(.module:
+ [lux (#- function)
+ [abstract
+ ["." monad (#+ do)]]
+ [control
+ pipe]
+ [data
+ ["." product]
+ ["." text
+ ["%" format (#+ format)]]
+ [collection
+ ["." list ("#\." functor fold)]]]
+ [target
+ ["_" r (#+ Expression SVar)]]]
+ ["." // #_
+ ["#." runtime (#+ Operation Phase Generator)]
+ ["#." reference]
+ ["#." case]
+ ["/#" // #_
+ ["#." reference]
+ ["//#" /// #_
+ [analysis (#+ Variant Tuple Abstraction Application Analysis)]
+ [synthesis (#+ Synthesis)]
+ ["#." generation (#+ Context)]
+ ["//#" /// #_
+ [arity (#+ Arity)]
+ ["#." phase ("#\." monad)]
+ [reference
+ [variable (#+ Register Variable)]]
+ [meta
+ [archive
+ ["." artifact]]]]]]])
+
+(def: #export (apply expression archive [functionS argsS+])
+ (Generator (Application Synthesis))
+ (do {! ///////phase.monad}
+ [functionO (expression archive functionS)
+ argsO+ (monad.map ! (expression archive) argsS+)]
+ (wrap (_.apply argsO+ functionO))))
+
+(def: (with_closure function_id $function inits function_definition)
+ (-> artifact.ID SVar (List Expression) Expression (Operation Expression))
+ (case inits
+ #.Nil
+ (do ///////phase.monad
+ [_ (/////generation.execute! function_definition)
+ _ (/////generation.save! (%.nat function_id)
+ function_definition)]
+ (wrap $function))
+
+ _
+ (do ///////phase.monad
+ [#let [closure_definition (_.set! $function
+ (_.function (|> inits
+ list.size
+ list.indices
+ (list\map //case.capture))
+ ($_ _.then
+ function_definition
+ $function)))]
+ _ (/////generation.execute! closure_definition)
+ _ (/////generation.save! (%.nat function_id) closure_definition)]
+ (wrap (_.apply inits $function)))))
+
+(def: $curried (_.var "curried"))
+(def: $missing (_.var "missing"))
+
+(def: (input_declaration register)
+ (-> Register Expression)
+ (_.set! (|> register inc //case.register)
+ (|> $curried (_.nth (|> register inc .int _.int)))))
+
+(def: #export (function expression archive [environment arity bodyS])
+ (Generator (Abstraction Synthesis))
+ (do {! ///////phase.monad}
+ [[[function_module function_artifact] bodyO] (/////generation.with_new_context archive
+ (do !
+ [$self (\ ! map (|>> ///reference.artifact _.var)
+ (/////generation.context archive))]
+ (/////generation.with_anchor $self
+ (expression archive bodyS))))
+ closureO+ (monad.map ! (expression archive) environment)
+ #let [arityO (|> arity .int _.int)
+ $num_args (_.var "num_args")
+ $self (_.var (///reference.artifact [function_module function_artifact]))
+ apply_poly (.function (_ args func)
+ (_.apply (list func args) (_.var "do.call")))]]
+ (with_closure function_artifact $self closureO+
+ (_.set! $self (_.function (list _.var_args)
+ ($_ _.then
+ (_.set! $curried (_.list (list _.var_args)))
+ (_.set! $num_args (_.length $curried))
+ (_.cond (list [(|> $num_args (_.= arityO))
+ ($_ _.then
+ (_.set! (//case.register 0) $self)
+ (|> arity
+ list.indices
+ (list\map input_declaration)
+ (list\fold _.then bodyO)))]
+ [(|> $num_args (_.> arityO))
+ (let [arity_args (_.slice (_.int +1) arityO $curried)
+ output_func_args (_.slice (|> arityO (_.+ (_.int +1)))
+ $num_args
+ $curried)]
+ (|> $self
+ (apply_poly arity_args)
+ (apply_poly output_func_args)))])
+ ## (|> $num_args (_.< arityO))
+ (let [$missing (_.var "missing")]
+ (_.function (list _.var_args)
+ ($_ _.then
+ (_.set! $missing (_.list (list _.var_args)))
+ (|> $self
+ (apply_poly (_.apply (list $curried $missing)
+ (_.var "append"))))))))))))
+ ))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/loop.lux
new file mode 100644
index 000000000..c8f8bd1d5
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/loop.lux
@@ -0,0 +1,64 @@
+(.module:
+ [lux (#- Scope)
+ [abstract
+ ["." monad (#+ do)]]
+ [data
+ ["." product]
+ ["." text
+ ["%" format (#+ format)]]
+ [collection
+ ["." list ("#\." functor fold)]
+ ["." set (#+ Set)]]]
+ [math
+ [number
+ ["n" nat]]]
+ [target
+ ["_" r]]]
+ ["." // #_
+ [runtime (#+ Operation Phase Generator)]
+ ["#." case]
+ ["/#" // #_
+ ["#." reference]
+ ["/#" // #_
+ [synthesis
+ ["." case]]
+ ["/#" // #_
+ ["."synthesis (#+ Scope Synthesis)]
+ ["#." generation]
+ ["//#" /// #_
+ ["#." phase]
+ [meta
+ [archive (#+ Archive)]]
+ [reference
+ [variable (#+ Register)]]]]]]])
+
+(def: #export (scope expression archive [offset initsS+ bodyS])
+ (Generator (Scope Synthesis))
+ (case initsS+
+ ## function/false/non-independent loop
+ #.Nil
+ (expression archive bodyS)
+
+ ## true loop
+ _
+ (do {! ///////phase.monad}
+ [$scope (\ ! map _.var (/////generation.gensym "loop_scope"))
+ initsO+ (monad.map ! (expression archive) initsS+)
+ bodyO (/////generation.with_anchor $scope
+ (expression archive bodyS))]
+ (wrap (_.block
+ ($_ _.then
+ (_.set! $scope
+ (_.function (|> initsS+
+ list.size
+ list.indices
+ (list\map (|>> (n.+ offset) //case.register)))
+ bodyO))
+ (_.apply initsO+ $scope)))))))
+
+(def: #export (recur expression archive argsS+)
+ (Generator (List Synthesis))
+ (do {! ///////phase.monad}
+ [$scope /////generation.anchor
+ argsO+ (monad.map ! (expression archive) argsS+)]
+ (wrap (_.apply argsO+ $scope))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/primitive.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/primitive.lux
new file mode 100644
index 000000000..efbd569f4
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/primitive.lux
@@ -0,0 +1,17 @@
+(.module:
+ [lux (#- i64)
+ [target
+ ["_" r (#+ Expression)]]]
+ ["." // #_
+ ["#." runtime]])
+
+(template [<name> <type> <code>]
+ [(def: #export <name>
+ (-> <type> Expression)
+ <code>)]
+
+ [bit Bit _.bool]
+ [i64 (I64 Any) (|>> .int //runtime.i64)]
+ [f64 Frac _.float]
+ [text Text _.string]
+ )
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/procedure/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/procedure/common.lux
new file mode 100644
index 000000000..85ccd90dc
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/procedure/common.lux
@@ -0,0 +1,339 @@
+(.module:
+ lux
+ (lux (control [monad #+ do]
+ ["ex" exception #+ exception:]
+ ["p" parser])
+ (data ["e" error]
+ [text]
+ text/format
+ [number]
+ (coll [list "list/" Functor<List>]
+ (dictionary ["dict" unordered #+ Dict])))
+ [macro #+ with-gensyms]
+ (macro [code]
+ ["s" syntax #+ syntax:])
+ [host])
+ (luxc ["&" lang]
+ (lang ["la" analysis]
+ ["ls" synthesis]
+ (host [r #+ Expression])))
+ [///]
+ (/// [".T" runtime]
+ [".T" case]
+ [".T" function]
+ [".T" loop]))
+
+## [Types]
+(type: #export Translator
+ (-> ls.Synthesis (Meta Expression)))
+
+(type: #export Proc
+ (-> Translator (List ls.Synthesis) (Meta Expression)))
+
+(type: #export Bundle
+ (Dict Text Proc))
+
+(syntax: (Vector {size s.nat} elemT)
+ (wrap (list (` [(~+ (list.repeat size elemT))]))))
+
+(type: #export Nullary (-> (Vector +0 Expression) Expression))
+(type: #export Unary (-> (Vector +1 Expression) Expression))
+(type: #export Binary (-> (Vector +2 Expression) Expression))
+(type: #export Trinary (-> (Vector +3 Expression) Expression))
+(type: #export Variadic (-> (List Expression) Expression))
+
+## [Utils]
+(def: #export (install name unnamed)
+ (-> Text (-> Text Proc)
+ (-> Bundle Bundle))
+ (dict.put name (unnamed name)))
+
+(def: #export (prefix prefix bundle)
+ (-> Text Bundle Bundle)
+ (|> bundle
+ dict.entries
+ (list/map (function (_ [key val]) [(format prefix " " key) val]))
+ (dict.from-list text.Hash<Text>)))
+
+(def: (wrong-arity proc expected actual)
+ (-> Text Nat Nat Text)
+ (format "Wrong number of arguments for " (%t proc) "\n"
+ "Expected: " (|> expected .int %i) "\n"
+ " Actual: " (|> actual .int %i)))
+
+(syntax: (arity: {name s.local-identifier} {arity s.nat})
+ (with-gensyms [g!_ g!proc g!name g!translate g!inputs]
+ (do {@ macro.monad}
+ [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input")))]
+ (wrap (list (` (def: #export ((~ (code.local-identifier name)) (~ g!proc))
+ (-> (-> (..Vector (~ (code.nat arity)) Expression) Expression)
+ (-> Text ..Proc))
+ (function ((~ g!_) (~ g!name))
+ (function ((~ g!_) (~ g!translate) (~ g!inputs))
+ (case (~ g!inputs)
+ (^ (list (~+ g!input+)))
+ (do macro.Monad<Meta>
+ [(~+ (|> g!input+
+ (list/map (function (_ g!input)
+ (list g!input (` ((~ g!translate) (~ g!input))))))
+ list.concat))]
+ ((~' wrap) ((~ g!proc) [(~+ g!input+)])))
+
+ (~' _)
+ (macro.fail (wrong-arity (~ g!name) +1 (list.size (~ g!inputs))))))))))))))
+
+(arity: nullary +0)
+(arity: unary +1)
+(arity: binary +2)
+(arity: trinary +3)
+
+(def: #export (variadic proc)
+ (-> Variadic (-> Text Proc))
+ (function (_ proc-name)
+ (function (_ translate inputsS)
+ (do {@ macro.Monad<Meta>}
+ [inputsI (monad.map @ translate inputsS)]
+ (wrap (proc inputsI))))))
+
+## [Procedures]
+## [[Lux]]
+(def: (lux//is [leftO rightO])
+ Binary
+ (r.apply (list leftO rightO)
+ (r.global "identical")))
+
+(def: (lux//if [testO thenO elseO])
+ Trinary
+ (caseT.translate-if testO thenO elseO))
+
+(def: (lux//try riskyO)
+ Unary
+ (runtimeT.lux//try riskyO))
+
+(exception: #export (Wrong-Syntax {message Text})
+ message)
+
+(def: #export (wrong-syntax procedure args)
+ (-> Text (List ls.Synthesis) Text)
+ (format "Procedure: " procedure "\n"
+ "Arguments: " (%code (code.tuple args))))
+
+(def: lux//loop
+ (-> Text Proc)
+ (function (_ proc-name)
+ (function (_ translate inputsS)
+ (case (s.run inputsS ($_ p.seq s.nat (s.tuple (p.many s.any)) s.any))
+ (#e.Success [offset initsS+ bodyS])
+ (loopT.translate-loop translate offset initsS+ bodyS)
+
+ (#e.Error error)
+ (&.throw Wrong-Syntax (wrong-syntax proc-name inputsS)))
+ )))
+
+(def: lux//recur
+ (-> Text Proc)
+ (function (_ proc-name)
+ (function (_ translate inputsS)
+ (loopT.translate-recur translate inputsS))))
+
+(def: lux-procs
+ Bundle
+ (|> (dict.new text.Hash<Text>)
+ (install "is" (binary lux//is))
+ (install "try" (unary lux//try))
+ (install "if" (trinary lux//if))
+ (install "loop" lux//loop)
+ (install "recur" lux//recur)
+ ))
+
+## [[Bits]]
+(template [<name> <op>]
+ [(def: (<name> [subjectO paramO])
+ Binary
+ (<op> paramO subjectO))]
+
+ [bit//and runtimeT.bit//and]
+ [bit//or runtimeT.bit//or]
+ [bit//xor runtimeT.bit//xor]
+ )
+
+(template [<name> <op>]
+ [(def: (<name> [subjectO paramO])
+ Binary
+ (<op> (runtimeT.int64-low paramO) subjectO))]
+
+ [bit//left-shift runtimeT.bit//left-shift]
+ [bit//arithmetic-right-shift runtimeT.bit//arithmetic-right-shift]
+ [bit//logical-right-shift runtimeT.bit//logical-right-shift]
+ )
+
+(def: bit-procs
+ Bundle
+ (<| (prefix "bit")
+ (|> (dict.new text.Hash<Text>)
+ (install "and" (binary bit//and))
+ (install "or" (binary bit//or))
+ (install "xor" (binary bit//xor))
+ (install "left-shift" (binary bit//left-shift))
+ (install "logical-right-shift" (binary bit//logical-right-shift))
+ (install "arithmetic-right-shift" (binary bit//arithmetic-right-shift))
+ )))
+
+## [[Numbers]]
+(host.import: java/lang/Double
+ (#static MIN_VALUE Double)
+ (#static MAX_VALUE Double))
+
+(template [<name> <const> <encode>]
+ [(def: (<name> _)
+ Nullary
+ (<encode> <const>))]
+
+ [frac//smallest Double::MIN_VALUE r.float]
+ [frac//min (f/* -1.0 Double::MAX_VALUE) r.float]
+ [frac//max Double::MAX_VALUE r.float]
+ )
+
+(template [<name> <op>]
+ [(def: (<name> [subjectO paramO])
+ Binary
+ (|> subjectO (<op> paramO)))]
+
+ [int//add runtimeT.int//+]
+ [int//sub runtimeT.int//-]
+ [int//mul runtimeT.int//*]
+ [int//div runtimeT.int///]
+ [int//rem runtimeT.int//%]
+ )
+
+(template [<name> <op>]
+ [(def: (<name> [subjectO paramO])
+ Binary
+ (<op> paramO subjectO))]
+
+ [frac//add r.+]
+ [frac//sub r.-]
+ [frac//mul r.*]
+ [frac//div r./]
+ [frac//rem r.%%]
+ [frac//= r.=]
+ [frac//< r.<]
+
+ [text//= r.=]
+ [text//< r.<]
+ )
+
+(template [<name> <cmp>]
+ [(def: (<name> [subjectO paramO])
+ Binary
+ (<cmp> paramO subjectO))]
+
+ [int//= runtimeT.int//=]
+ [int//< runtimeT.int//<]
+ )
+
+(def: (apply1 func)
+ (-> Expression (-> Expression Expression))
+ (function (_ value)
+ (r.apply (list value) func)))
+
+(def: int//char (|>> runtimeT.int64-low (apply1 (r.global "intToUtf8"))))
+
+(def: int-procs
+ Bundle
+ (<| (prefix "int")
+ (|> (dict.new text.Hash<Text>)
+ (install "+" (binary int//add))
+ (install "-" (binary int//sub))
+ (install "*" (binary int//mul))
+ (install "/" (binary int//div))
+ (install "%" (binary int//rem))
+ (install "=" (binary int//=))
+ (install "<" (binary int//<))
+ (install "to-frac" (unary runtimeT.int//to-float))
+ (install "char" (unary int//char)))))
+
+(def: (frac//encode value)
+ (-> Expression Expression)
+ (r.apply (list (r.string "%f") value) (r.global "sprintf")))
+
+(def: frac-procs
+ Bundle
+ (<| (prefix "frac")
+ (|> (dict.new text.Hash<Text>)
+ (install "+" (binary frac//add))
+ (install "-" (binary frac//sub))
+ (install "*" (binary frac//mul))
+ (install "/" (binary frac//div))
+ (install "%" (binary frac//rem))
+ (install "=" (binary frac//=))
+ (install "<" (binary frac//<))
+ (install "smallest" (nullary frac//smallest))
+ (install "min" (nullary frac//min))
+ (install "max" (nullary frac//max))
+ (install "to-int" (unary (apply1 (r.global "as.integer"))))
+ (install "encode" (unary frac//encode))
+ (install "decode" (unary runtimeT.frac//decode)))))
+
+## [[Text]]
+(def: (text//concat [subjectO paramO])
+ Binary
+ (r.apply (list subjectO paramO) (r.global "paste0")))
+
+(def: (text//char [subjectO paramO])
+ Binary
+ (runtimeT.text//char subjectO paramO))
+
+(def: (text//clip [subjectO paramO extraO])
+ Trinary
+ (runtimeT.text//clip subjectO paramO extraO))
+
+(def: (text//index [textO partO startO])
+ Trinary
+ (runtimeT.text//index textO partO startO))
+
+(def: text-procs
+ Bundle
+ (<| (prefix "text")
+ (|> (dict.new text.Hash<Text>)
+ (install "=" (binary text//=))
+ (install "<" (binary text//<))
+ (install "concat" (binary text//concat))
+ (install "index" (trinary text//index))
+ (install "size" (unary (|>> (apply1 (r.global "nchar")) runtimeT.int//from-float)))
+ (install "char" (binary text//char))
+ (install "clip" (trinary text//clip))
+ )))
+
+## [[IO]]
+(def: (io//exit input)
+ Unary
+ (r.apply-kw (list)
+ (list ["status" (runtimeT.int//to-float input)])
+ (r.global "quit")))
+
+(def: (void code)
+ (-> Expression Expression)
+ (r.block (r.then code runtimeT.unit)))
+
+(def: io-procs
+ Bundle
+ (<| (prefix "io")
+ (|> (dict.new text.Hash<Text>)
+ (install "log" (unary (|>> r.print ..void)))
+ (install "error" (unary r.stop))
+ (install "exit" (unary io//exit))
+ (install "current-time" (nullary (function (_ _)
+ (runtimeT.io//current-time! runtimeT.unit)))))))
+
+## [Bundles]
+(def: #export procedures
+ Bundle
+ (<| (prefix "lux")
+ (|> lux-procs
+ (dict.merge bit-procs)
+ (dict.merge int-procs)
+ (dict.merge frac-procs)
+ (dict.merge text-procs)
+ (dict.merge io-procs)
+ )))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/procedure/host.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/procedure/host.lux
new file mode 100644
index 000000000..3bd33955f
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/procedure/host.lux
@@ -0,0 +1,89 @@
+(.module:
+ lux
+ (lux (control [monad #+ do])
+ (data [text]
+ text/format
+ (coll [list "list/" Functor<List>]
+ (dictionary ["dict" unordered #+ Dict])))
+ [macro "macro/" Monad<Meta>])
+ (luxc ["&" lang]
+ (lang ["la" analysis]
+ ["ls" synthesis]
+ (host [ruby #+ Ruby Expression Statement])))
+ [///]
+ (/// [".T" runtime])
+ (// ["@" common]))
+
+## (template [<name> <lua>]
+## [(def: (<name> _) @.Nullary <lua>)]
+
+## [lua//nil "nil"]
+## [lua//table "{}"]
+## )
+
+## (def: (lua//global proc translate inputs)
+## (-> Text @.Proc)
+## (case inputs
+## (^ (list [_ (#.Text name)]))
+## (do macro.Monad<Meta>
+## []
+## (wrap name))
+
+## _
+## (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
+
+## (def: (lua//call proc translate inputs)
+## (-> Text @.Proc)
+## (case inputs
+## (^ (list& functionS argsS+))
+## (do {@ macro.Monad<Meta>}
+## [functionO (translate functionS)
+## argsO+ (monad.map @ translate argsS+)]
+## (wrap (lua.apply functionO argsO+)))
+
+## _
+## (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
+
+## (def: lua-procs
+## @.Bundle
+## (|> (dict.new text.Hash<Text>)
+## (@.install "nil" (@.nullary lua//nil))
+## (@.install "table" (@.nullary lua//table))
+## (@.install "global" lua//global)
+## (@.install "call" lua//call)))
+
+## (def: (table//call proc translate inputs)
+## (-> Text @.Proc)
+## (case inputs
+## (^ (list& tableS [_ (#.Text field)] argsS+))
+## (do {@ macro.Monad<Meta>}
+## [tableO (translate tableS)
+## argsO+ (monad.map @ translate argsS+)]
+## (wrap (lua.method field tableO argsO+)))
+
+## _
+## (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))
+
+## (def: (table//get [fieldO tableO])
+## @.Binary
+## (runtimeT.lua//get tableO fieldO))
+
+## (def: (table//set [fieldO valueO tableO])
+## @.Trinary
+## (runtimeT.lua//set tableO fieldO valueO))
+
+## (def: table-procs
+## @.Bundle
+## (<| (@.prefix "table")
+## (|> (dict.new text.Hash<Text>)
+## (@.install "call" table//call)
+## (@.install "get" (@.binary table//get))
+## (@.install "set" (@.trinary table//set)))))
+
+(def: #export procedures
+ @.Bundle
+ (<| (@.prefix "lua")
+ (dict.new text.Hash<Text>)
+ ## (|> lua-procs
+ ## (dict.merge table-procs))
+ ))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/reference.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/reference.lux
new file mode 100644
index 000000000..c3f2e8289
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/reference.lux
@@ -0,0 +1,12 @@
+(.module:
+ [lux #*
+ [target
+ ["_" r (#+ Expression)]]]
+ [///
+ [reference (#+ System)]])
+
+(structure: #export system
+ (System Expression)
+
+ (def: constant _.var)
+ (def: variable _.var))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux
new file mode 100644
index 000000000..1b7119378
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux
@@ -0,0 +1,848 @@
+(.module:
+ [lux (#- Location inc i64)
+ ["." meta]
+ [abstract
+ ["." monad (#+ do)]]
+ [control
+ ["." function]
+ ["<>" parser
+ ["<.>" code]]]
+ [data
+ ["." product]
+ ["." text ("#\." hash)
+ ["%" format (#+ format)]
+ [encoding
+ ["." utf8]]]
+ [collection
+ ["." list ("#\." functor)]
+ ["." row]]]
+ ["." macro
+ [syntax (#+ syntax:)]
+ ["." code]]
+ [math
+ [number (#+ hex)
+ ["n" nat]
+ ["i" int ("#\." interval)]
+ ["." i64]]]
+ ["@" target
+ ["_" r (#+ SVar Expression)]]]
+ ["." /// #_
+ ["#." reference]
+ ["//#" /// #_
+ [analysis (#+ Variant)]
+ ["#." synthesis (#+ Synthesis)]
+ ["#." generation]
+ ["//#" ///
+ ["#." phase]
+ [reference
+ [variable (#+ Register)]]
+ [meta
+ [archive (#+ Output Archive)
+ ["." artifact (#+ Registry)]]]]]])
+
+(def: module_id
+ 0)
+
+(template [<name> <base>]
+ [(type: #export <name>
+ (<base> _.SVar _.Expression _.Expression))]
+
+ [Operation /////generation.Operation]
+ [Phase /////generation.Phase]
+ [Handler /////generation.Handler]
+ [Bundle /////generation.Bundle]
+ )
+
+(type: #export (Generator i)
+ (-> Phase Archive i (Operation Expression)))
+
+(def: #export unit
+ Expression
+ (_.string /////synthesis.unit))
+
+(def: full_32 (hex "FFFFFFFF"))
+(def: half_32 (hex "7FFFFFFF"))
+(def: post_32 (hex "100000000"))
+
+(def: (cap_32 input)
+ (-> Nat Int)
+ (cond (n.> full_32 input)
+ (|> input (i64.and full_32) cap_32)
+
+ (n.> half_32 input)
+ (|> post_32 (n.- input) .int (i.* -1))
+
+ ## else
+ (.int input)))
+
+(def: high_32
+ (-> Nat Nat)
+ (i64.right_shift 32))
+
+(def: low_32
+ (-> Nat Nat)
+ (|>> (i64.and (hex "FFFFFFFF"))))
+
+(def: #export i64_high_field "luxIH")
+(def: #export i64_low_field "luxIL")
+
+(def: #export (i64 value)
+ (-> Int Expression)
+ (let [value (.nat value)
+ high (|> value ..high_32 ..cap_32)
+ low (|> value ..low_32 ..cap_32)]
+ (_.named_list (list [..i64_high_field (_.int high)]
+ [..i64_low_field (_.int low)]))))
+
+(def: #export variant_tag_field "luxVT")
+(def: #export variant_flag_field "luxVF")
+(def: #export variant_value_field "luxVV")
+
+(def: #export (flag value)
+ (-> Bit Expression)
+ (if value
+ (_.string "")
+ _.null))
+
+(def: (variant' tag last? value)
+ (-> Expression Expression Expression Expression)
+ (_.named_list (list [..variant_tag_field tag]
+ [..variant_flag_field last?]
+ [..variant_value_field value])))
+
+(def: #export (variant tag last? value)
+ (-> Nat Bit Expression Expression)
+ (variant' (_.int (.int tag))
+ (flag last?)
+ value))
+
+(def: #export none
+ Expression
+ (variant 0 #0 ..unit))
+
+(def: #export some
+ (-> Expression Expression)
+ (variant 1 #1))
+
+(def: #export left
+ (-> Expression Expression)
+ (variant 0 #0))
+
+(def: #export right
+ (-> Expression Expression)
+ (variant 1 #1))
+
+(syntax: #export (with_vars {vars (<code>.tuple (<>.some <code>.local_identifier))}
+ body)
+ (do {! meta.monad}
+ [ids (monad.seq ! (list.repeat (list.size vars) meta.count))]
+ (wrap (list (` (let [(~+ (|> vars
+ (list.zip/2 ids)
+ (list\map (function (_ [id var])
+ (list (code.local_identifier var)
+ (` (_.var (~ (code.text (format "v" (%.nat id)))))))))
+ list.concat))]
+ (~ body)))))))
+
+(syntax: (runtime: {declaration (<>.or <code>.local_identifier
+ (<code>.form (<>.and <code>.local_identifier
+ (<>.some <code>.local_identifier))))}
+ code)
+ (do meta.monad
+ [runtime_id meta.count]
+ (macro.with_gensyms [g!_]
+ (let [runtime (code.local_identifier (///reference.artifact [..module_id runtime_id]))
+ runtime_name (` (_.var (~ (code.text (%.code runtime)))))]
+ (case declaration
+ (#.Left name)
+ (let [g!name (code.local_identifier name)]
+ (wrap (list (` (def: #export (~ g!name)
+ _.SVar
+ (~ runtime_name)))
+
+ (` (def: (~ (code.local_identifier (format "@" name)))
+ _.Expression
+ (_.set! (~ runtime_name) (~ code)))))))
+
+ (#.Right [name inputs])
+ (let [g!name (code.local_identifier name)
+ inputsC (list\map code.local_identifier inputs)
+ inputs_typesC (list\map (function.constant (` _.Expression))
+ inputs)]
+ (wrap (list (` (def: #export ((~ g!name) (~+ inputsC))
+ (-> (~+ inputs_typesC) _.Expression)
+ (_.apply (list (~+ inputsC)) (~ runtime_name))))
+
+ (` (def: (~ (code.local_identifier (format "@" name)))
+ _.Expression
+ (..with_vars [(~+ inputsC)]
+ (_.set! (~ runtime_name)
+ (_.function (list (~+ inputsC))
+ (~ code))))))))))))))
+
+(def: high_shift (_.bit_shl (_.int +32)))
+
+(runtime: f2^32 (|> (_.int +2) (_.** (_.int +32))))
+(runtime: f2^63 (|> (_.int +2) (_.** (_.int +63))))
+
+(def: (as_double value)
+ (-> Expression Expression)
+ (_.apply (list value) (_.var "as.double")))
+
+(def: (as_integer value)
+ (-> Expression Expression)
+ (_.apply (list value) (_.var "as.integer")))
+
+(runtime: (i64::unsigned_low input)
+ (with_vars [low]
+ ($_ _.then
+ (_.set! low (|> input (_.nth (_.string ..i64_low_field))))
+ (_.if (|> low (_.>= (_.int +0)))
+ low
+ (|> low (_.+ f2^32))))))
+
+(runtime: (i64::to_float input)
+ (let [high (|> input
+ (_.nth (_.string ..i64_high_field))
+ high_shift)
+ low (|> input
+ i64::unsigned_low)]
+ (|> high (_.+ low) as_double)))
+
+(runtime: (i64::new high low)
+ (_.named_list (list [..i64_high_field (as_integer high)]
+ [..i64_low_field (as_integer low)])))
+
+(template [<name> <value>]
+ [(runtime: <name>
+ (..i64 <value>))]
+
+ [i64::zero +0]
+ [i64::one +1]
+ [i64::min i\bottom]
+ [i64::max i\top]
+ )
+
+(def: #export i64_high (_.nth (_.string ..i64_high_field)))
+(def: #export i64_low (_.nth (_.string ..i64_low_field)))
+
+(runtime: (i64::not input)
+ (i64::new (|> input i64_high _.bit_not)
+ (|> input i64_low _.bit_not)))
+
+(runtime: (i64::+ param subject)
+ (with_vars [sH sL pH pL
+ x00 x16 x32 x48]
+ ($_ _.then
+ (_.set! sH (|> subject i64_high))
+ (_.set! sL (|> subject i64_low))
+ (_.set! pH (|> param i64_high))
+ (_.set! pL (|> param i64_low))
+ (let [bits16 (_.manual "0xFFFF")
+ move_top_16 (_.bit_shl (_.int +16))
+ top_16 (_.bit_ushr (_.int +16))
+ bottom_16 (_.bit_and bits16)
+ split_16 (function (_ source)
+ [(|> source top_16)
+ (|> source bottom_16)])
+ split_int (function (_ high low)
+ [(split_16 high)
+ (split_16 low)])
+
+ [[s48 s32] [s16 s00]] (split_int sH sL)
+ [[p48 p32] [p16 p00]] (split_int pH pL)
+ new_half (function (_ top bottom)
+ (|> top bottom_16 move_top_16
+ (_.bit_or (bottom_16 bottom))))]
+ ($_ _.then
+ (_.set! x00 (|> s00 (_.+ p00)))
+ (_.set! x16 (|> x00 top_16 (_.+ s16) (_.+ p16)))
+ (_.set! x32 (|> x16 top_16 (_.+ s32) (_.+ p32)))
+ (_.set! x48 (|> x32 top_16 (_.+ s48) (_.+ p48)))
+ (i64::new (new_half x48 x32)
+ (new_half x16 x00)))))))
+
+(runtime: (i64::= reference sample)
+ (let [n/a? (function (_ value)
+ (_.apply (list value) (_.var "is.na")))
+ isTRUE? (function (_ value)
+ (_.apply (list value) (_.var "isTRUE")))
+ comparison (: (-> (-> Expression Expression) Expression)
+ (function (_ field)
+ (|> (|> (field sample) (_.= (field reference)))
+ (_.or (|> (n/a? (field sample))
+ (_.and (n/a? (field reference))))))))]
+ (|> (comparison i64_high)
+ (_.and (comparison i64_low))
+ isTRUE?)))
+
+(runtime: (i64::negate input)
+ (_.if (|> input (i64::= i64::min))
+ i64::min
+ (|> input i64::not (i64::+ i64::one))))
+
+(runtime: i64::-one
+ (i64::negate i64::one))
+
+(runtime: (i64::- param subject)
+ (i64::+ (i64::negate param) subject))
+
+(runtime: (i64::< reference sample)
+ (with_vars [r_? s_?]
+ ($_ _.then
+ (_.set! s_? (|> sample i64_high (_.< (_.int +0))))
+ (_.set! r_? (|> reference i64_high (_.< (_.int +0))))
+ (|> (|> s_? (_.and (_.not r_?)))
+ (_.or (|> (_.not s_?) (_.and r_?) _.not))
+ (_.or (|> sample
+ (i64::- reference)
+ i64_high
+ (_.< (_.int +0))))))))
+
+(runtime: (i64::from_float input)
+ (_.cond (list [(_.apply (list input) (_.var "is.nan"))
+ i64::zero]
+ [(|> input (_.<= (_.negate f2^63)))
+ i64::min]
+ [(|> input (_.+ (_.float +1.0)) (_.>= f2^63))
+ i64::max]
+ [(|> input (_.< (_.float +0.0)))
+ (|> input _.negate i64::from_float i64::negate)])
+ (i64::new (|> input (_./ f2^32))
+ (|> input (_.%% f2^32)))))
+
+(runtime: (i64::* param subject)
+ (with_vars [sH sL pH pL
+ x00 x16 x32 x48]
+ ($_ _.then
+ (_.set! sH (|> subject i64_high))
+ (_.set! pH (|> param i64_high))
+ (let [negative_subject? (|> sH (_.< (_.int +0)))
+ negative_param? (|> pH (_.< (_.int +0)))]
+ (_.cond (list [negative_subject?
+ (_.if negative_param?
+ (i64::* (i64::negate param)
+ (i64::negate subject))
+ (i64::negate (i64::* param
+ (i64::negate subject))))]
+
+ [negative_param?
+ (i64::negate (i64::* (i64::negate param)
+ subject))])
+ ($_ _.then
+ (_.set! sL (|> subject i64_low))
+ (_.set! pL (|> param i64_low))
+ (let [bits16 (_.manual "0xFFFF")
+ move_top_16 (_.bit_shl (_.int +16))
+ top_16 (_.bit_ushr (_.int +16))
+ bottom_16 (_.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
+ (_.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! ($_ _.then (_.set! s48 _s48) (_.set! s32 _s32) (_.set! s16 _s16) (_.set! s00 _s00))
+ set_param_chunks! ($_ _.then (_.set! p48 _p48) (_.set! p32 _p32) (_.set! p16 _p16) (_.set! p00 _p00))]
+ ($_ _.then
+ set_subject_chunks!
+ set_param_chunks!
+ (_.set! x00 (|> s00 (_.* p00)))
+ (_.set! x16 (|> x00 top_16 (_.+ (|> s16 (_.* p00)))))
+ (_.set! x32 x16_top)
+ (_.set! x16 (|> x16 bottom_16 (_.+ (|> s00 (_.* p16)))))
+ (_.set! x32 (|> x32 (_.+ x16_top) (_.+ (|> s32 (_.* p00)))))
+ (_.set! x48 x32_top)
+ (_.set! x32 (|> x32 bottom_16 (_.+ (|> s16 (_.* p16)))))
+ (_.set! x48 (|> x48 (_.+ x32_top)))
+ (_.set! x32 (|> x32 bottom_16 (_.+ (|> s00 (_.* p32)))))
+ (_.set! x48 (|> x48 (_.+ x32_top)
+ (_.+ (|> s48 (_.* p00)))
+ (_.+ (|> s32 (_.* p16)))
+ (_.+ (|> s16 (_.* p32)))
+ (_.+ (|> s00 (_.* p48)))))
+ (i64::new (new_half x48 x32)
+ (new_half x16 x00)))))
+ )))))))
+
+(def: (limit_shift! shift)
+ (-> SVar Expression)
+ (_.set! shift (|> shift (_.bit_and (_.int +63)))))
+
+(def: (no_shift_clause shift input)
+ (-> SVar SVar [Expression Expression])
+ [(|> shift (_.= (_.int +0)))
+ input])
+
+(runtime: (i64::left_shift shift input)
+ ($_ _.then
+ (limit_shift! shift)
+ (_.cond (list (no_shift_clause shift input)
+ [(|> shift (_.< (_.int +32)))
+ (let [mid (|> (i64_low input) (_.bit_ushr (|> (_.int +32) (_.- shift))))
+ high (|> (i64_high input)
+ (_.bit_shl shift)
+ (_.bit_or mid))
+ low (|> (i64_low input)
+ (_.bit_shl shift))]
+ (i64::new high low))])
+ (let [high (|> (i64_high input)
+ (_.bit_shl (|> shift (_.- (_.int +32)))))]
+ (i64::new high (_.int +0))))))
+
+(runtime: (i64::arithmetic_right_shift_32 shift input)
+ (let [top_bit (|> input (_.bit_and (_.int (hex "+80000000"))))]
+ (|> input
+ (_.bit_ushr shift)
+ (_.bit_or top_bit))))
+
+(runtime: (i64::arithmetic_right_shift shift input)
+ ($_ _.then
+ (limit_shift! shift)
+ (_.cond (list (no_shift_clause shift input)
+ [(|> shift (_.< (_.int +32)))
+ (let [mid (|> (i64_high input) (_.bit_shl (|> (_.int +32) (_.- shift))))
+ high (|> (i64_high input)
+ (i64::arithmetic_right_shift_32 shift))
+ low (|> (i64_low input)
+ (_.bit_ushr shift)
+ (_.bit_or mid))]
+ (i64::new high low))])
+ (let [low (|> (i64_high input)
+ (i64::arithmetic_right_shift_32 (|> shift (_.- (_.int +32)))))
+ high (_.if (|> (i64_high input) (_.>= (_.int +0)))
+ (_.int +0)
+ (_.int -1))]
+ (i64::new high low)))))
+
+(runtime: (i64::/ param subject)
+ (let [negative? (|>> (i64::< i64::zero))
+ valid_division_check [(|> param (i64::= i64::zero))
+ (_.stop (_.string "Cannot divide by zero!"))]
+ short_circuit_check [(|> subject (i64::= i64::zero))
+ i64::zero]]
+ (_.cond (list valid_division_check
+ short_circuit_check
+
+ [(|> subject (i64::= i64::min))
+ (_.cond (list [(|> (|> param (i64::= i64::one))
+ (_.or (|> param (i64::= i64::-one))))
+ i64::min]
+ [(|> param (i64::= i64::min))
+ i64::one])
+ (with_vars [approximation]
+ ($_ _.then
+ (_.set! approximation
+ (|> subject
+ (i64::arithmetic_right_shift (_.int +1))
+ (i64::/ param)
+ (i64::left_shift (_.int +1))))
+ (_.if (|> approximation (i64::= i64::zero))
+ (_.if (negative? param)
+ i64::one
+ i64::-one)
+ (let [remainder (i64::- (i64::* param approximation)
+ subject)]
+ (|> remainder
+ (i64::/ param)
+ (i64::+ approximation)))))))]
+ [(|> param (i64::= i64::min))
+ i64::zero]
+
+ [(negative? subject)
+ (_.if (negative? param)
+ (|> (i64::negate subject)
+ (i64::/ (i64::negate param)))
+ (|> (i64::negate subject)
+ (i64::/ param)
+ i64::negate))]
+
+ [(negative? param)
+ (|> param
+ i64::negate
+ (i64::/ subject)
+ i64::negate)])
+ (with_vars [result remainder approximate approximate_result log2 approximate_remainder]
+ ($_ _.then
+ (_.set! result i64::zero)
+ (_.set! remainder subject)
+ (_.while (|> (|> remainder (i64::< param))
+ (_.or (|> remainder (i64::= param))))
+ (let [calc_rough_estimate (_.apply (list (|> (i64::to_float remainder) (_./ (i64::to_float param))))
+ (_.var "floor"))
+ calc_approximate_result (i64::from_float approximate)
+ calc_approximate_remainder (|> approximate_result (i64::* param))
+ delta (_.if (|> (_.float +48.0) (_.<= log2))
+ (_.float +1.0)
+ (_.** (|> log2 (_.- (_.float +48.0)))
+ (_.float +2.0)))]
+ ($_ _.then
+ (_.set! approximate (_.apply (list (_.float +1.0) calc_rough_estimate)
+ (_.var "max")))
+ (_.set! log2 (let [log (function (_ input)
+ (_.apply (list input) (_.var "log")))]
+ (_.apply (list (|> (log (_.int +2))
+ (_./ (log approximate))))
+ (_.var "ceil"))))
+ (_.set! approximate_result calc_approximate_result)
+ (_.set! approximate_remainder calc_approximate_remainder)
+ (_.while (|> (negative? approximate_remainder)
+ (_.or (|> approximate_remainder (i64::< remainder))))
+ ($_ _.then
+ (_.set! approximate (|> delta (_.- approximate)))
+ (_.set! approximate_result calc_approximate_result)
+ (_.set! approximate_remainder calc_approximate_remainder)))
+ (_.set! result (|> (_.if (|> approximate_result (i64::= i64::zero))
+ i64::one
+ approximate_result)
+ (i64::+ result)))
+ (_.set! remainder (|> remainder (i64::- approximate_remainder))))))
+ result))
+ )))
+
+(runtime: (i64::% param subject)
+ (let [flat (|> subject (i64::/ param) (i64::* param))]
+ (|> subject (i64::- flat))))
+
+(runtime: (lux::try op)
+ (with_vars [error value]
+ (_.try ($_ _.then
+ (_.set! value (_.apply (list ..unit) op))
+ (..right value))
+ #.None
+ (#.Some (_.function (list error)
+ (..left (_.nth (_.string "message")
+ error))))
+ #.None)))
+
+(runtime: (lux::program_args program_args)
+ (with_vars [inputs value]
+ ($_ _.then
+ (_.set! inputs ..none)
+ (<| (_.for_in value program_args)
+ (_.set! inputs (..some (_.list (list value inputs)))))
+ inputs)))
+
+(def: runtime::lux
+ Expression
+ ($_ _.then
+ @lux::try
+ @lux::program_args
+ ))
+
+(def: current_time_float
+ Expression
+ (let [raw_time (_.apply (list) (_.var "Sys.time"))]
+ (_.apply (list raw_time) (_.var "as.numeric"))))
+
+(runtime: (io::current_time! _)
+ (|> current_time_float
+ (_.* (_.float +1,000.0))
+ i64::from_float))
+
+(def: runtime::io
+ Expression
+ ($_ _.then
+ @io::current_time!
+ ))
+
+(def: minimum_index_length
+ (-> SVar Expression)
+ (|>> (_.+ (_.int +1))))
+
+(def: (product_element product index)
+ (-> Expression Expression Expression)
+ (|> product (_.nth (|> index (_.+ (_.int +1))))))
+
+(def: (product_tail product)
+ (-> SVar Expression)
+ (|> product (_.nth (_.length product))))
+
+(def: (updated_index min_length product)
+ (-> Expression Expression Expression)
+ (|> min_length (_.- (_.length product))))
+
+(runtime: (tuple::left index product)
+ (let [$index_min_length (_.var "index_min_length")]
+ ($_ _.then
+ (_.set! $index_min_length (minimum_index_length index))
+ (_.if (|> (_.length product) (_.> $index_min_length))
+ ## No need for recursion
+ (product_element product index)
+ ## Needs recursion
+ (tuple::left (updated_index $index_min_length product)
+ (product_tail product))))))
+
+(runtime: (tuple::right index product)
+ (let [$index_min_length (_.var "index_min_length")]
+ ($_ _.then
+ (_.set! $index_min_length (minimum_index_length index))
+ (_.cond (list [## Last element.
+ (|> (_.length product) (_.= $index_min_length))
+ (product_element product index)]
+ [## Needs recursion
+ (|> (_.length product) (_.< $index_min_length))
+ (tuple::right (updated_index $index_min_length product)
+ (product_tail product))])
+ ## Must slice
+ (|> product (_.slice_from index))))))
+
+(runtime: (sum::get sum wants_last? wanted_tag)
+ (let [no_match _.null
+ sum_tag (|> sum (_.nth (_.string ..variant_tag_field)))
+ sum_flag (|> sum (_.nth (_.string ..variant_flag_field)))
+ sum_value (|> sum (_.nth (_.string ..variant_value_field)))
+ is_last? (|> sum_flag (_.= (_.string "")))
+ test_recursion (_.if is_last?
+ ## Must recurse.
+ (|> wanted_tag
+ (_.- sum_tag)
+ (sum::get sum_value wants_last?))
+ no_match)]
+ (_.cond (list [(_.= sum_tag wanted_tag)
+ (_.if (_.= wants_last? sum_flag)
+ sum_value
+ test_recursion)]
+
+ [(|> wanted_tag (_.> sum_tag))
+ test_recursion]
+
+ [(|> (|> wants_last? (_.= (_.string "")))
+ (_.and (|> wanted_tag (_.< sum_tag))))
+ (variant' (|> sum_tag (_.- wanted_tag)) sum_flag sum_value)])
+
+ no_match)))
+
+(def: runtime::adt
+ Expression
+ ($_ _.then
+ @tuple::left
+ @tuple::right
+ @sum::get
+ ))
+
+(template [<name> <op>]
+ [(runtime: (<name> mask input)
+ (i64::new (<op> (i64_high mask)
+ (i64_high input))
+ (<op> (i64_low mask)
+ (i64_low input))))]
+
+ [i64::and _.bit_and]
+ [i64::or _.bit_or]
+ [i64::xor _.bit_xor]
+ )
+
+(runtime: (i64::right_shift shift input)
+ ($_ _.then
+ (limit_shift! shift)
+ (_.cond (list (no_shift_clause shift input)
+ [(|> shift (_.< (_.int +32)))
+ (with_vars [$mid]
+ (let [mid (|> (i64_high input) (_.bit_shl (|> (_.int +32) (_.- shift))))
+ high (|> (i64_high input) (_.bit_ushr shift))
+ low (|> (i64_low input)
+ (_.bit_ushr shift)
+ (_.bit_or (_.if (_.apply (list $mid) (_.var "is.na"))
+ (_.int +0)
+ $mid)))]
+ ($_ _.then
+ (_.set! $mid mid)
+ (i64::new high low))))]
+ [(|> shift (_.= (_.int +32)))
+ (let [high (i64_high input)]
+ (i64::new (_.int +0) high))])
+ (let [low (|> (i64_high input) (_.bit_ushr (|> shift (_.- (_.int +32)))))]
+ (i64::new (_.int +0) low)))))
+
+(def: runtime::i64
+ Expression
+ ($_ _.then
+ @i64::zero
+ @i64::one
+ @i64::min
+ @i64::max
+ @i64::=
+ @i64::<
+ @i64::+
+ @i64::-
+ @i64::negate
+ @i64::-one
+ @i64::unsigned_low
+ @i64::to_float
+ @i64::*
+ @i64::/
+ @i64::%
+
+ @i64::and
+ @i64::or
+ @i64::xor
+ @i64::not
+ @i64::left_shift
+ @i64::arithmetic_right_shift_32
+ @i64::arithmetic_right_shift
+ @i64::right_shift
+ ))
+
+(runtime: (frac::decode input)
+ (with_vars [output]
+ ($_ _.then
+ (_.set! output (_.apply (list input) (_.var "as.numeric")))
+ (_.if (|> output (_.= _.n/a))
+ ..none
+ (..some output)))))
+
+(def: runtime::frac
+ Expression
+ ($_ _.then
+ @frac::decode
+ ))
+
+(def: inc
+ (-> Expression Expression)
+ (|>> (_.+ (_.int +1))))
+
+(template [<name> <top_cmp>]
+ [(def: (<name> top value)
+ (-> Expression Expression Expression)
+ (|> (|> value (_.>= (_.int +0)))
+ (_.and (|> value (<top_cmp> top)))))]
+
+ [within? _.<]
+ [up_to? _.<=]
+ )
+
+(def: (text_clip start end text)
+ (-> Expression Expression Expression Expression)
+ (_.apply (list text start end)
+ (_.var "substr")))
+
+(def: (text_length text)
+ (-> Expression Expression)
+ (_.apply (list text) (_.var "nchar")))
+
+(runtime: (text::index subject param start)
+ (with_vars [idx startF subjectL]
+ ($_ _.then
+ (_.set! startF (i64::to_float start))
+ (_.set! subjectL (text_length subject))
+ (_.if (|> startF (within? subjectL))
+ ($_ _.then
+ (_.set! idx (|> (_.apply_kw (list param (_.if (|> startF (_.= (_.int +0)))
+ subject
+ (text_clip (inc startF)
+ (inc subjectL)
+ subject)))
+ (list ["fixed" (_.bool #1)])
+ (_.var "regexpr"))
+ (_.nth (_.int +1))))
+ (_.if (|> idx (_.= (_.int -1)))
+ ..none
+ (..some (i64::from_float (|> idx (_.+ startF))))))
+ ..none))))
+
+(runtime: (text::clip text from to)
+ (with_vars [length]
+ ($_ _.then
+ (_.set! length (_.length text))
+ (_.if ($_ _.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)
+ (_.apply (list (text_clip idx idx text))
+ (_.var "utf8ToInt")))
+
+(runtime: (text::char text idx)
+ (_.if (|> idx (within? (_.length text)))
+ ($_ _.then
+ (_.set! idx (inc idx))
+ (..some (i64::from_float (char_at idx text))))
+ ..none))
+
+(def: runtime::text
+ Expression
+ ($_ _.then
+ @text::index
+ @text::clip
+ @text::char
+ ))
+
+(def: (check_index_out_of_bounds array idx body)
+ (-> Expression Expression Expression Expression)
+ (_.if (|> idx (_.<= (_.length array)))
+ body
+ (_.stop (_.string "Array index out of bounds!"))))
+
+(runtime: (array::new size)
+ (with_vars [output]
+ ($_ _.then
+ (_.set! output (_.list (list)))
+ (_.set_nth! (|> size (_.+ (_.int +1)))
+ _.null
+ output)
+ output)))
+
+(runtime: (array::get array idx)
+ (with_vars [temp]
+ (<| (check_index_out_of_bounds array idx)
+ ($_ _.then
+ (_.set! temp (|> array (_.nth (_.+ (_.int +1) idx))))
+ (_.if (|> temp (_.= _.null))
+ ..none
+ (..some temp))))))
+
+(runtime: (array::put array idx value)
+ (<| (check_index_out_of_bounds array idx)
+ ($_ _.then
+ (_.set_nth! (_.+ (_.int +1) idx) value array)
+ array)))
+
+(def: runtime::array
+ Expression
+ ($_ _.then
+ @array::new
+ @array::get
+ @array::put
+ ))
+
+(def: runtime
+ Expression
+ ($_ _.then
+ runtime::lux
+ @f2^32
+ @f2^63
+ @i64::new
+ @i64::from_float
+ runtime::i64
+ runtime::adt
+ runtime::frac
+ runtime::text
+ runtime::array
+ runtime::io
+ ))
+
+(def: #export generate
+ (Operation [Registry Output])
+ (do ///////phase.monad
+ [_ (/////generation.execute! ..runtime)
+ _ (/////generation.save! (%.nat ..module_id) ..runtime)]
+ (wrap [(|> artifact.empty
+ artifact.resource
+ product.right)
+ (row.row [(%.nat ..module_id)
+ (|> ..runtime
+ _.code
+ (\ utf8.codec encode))])])))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/structure.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/structure.lux
new file mode 100644
index 000000000..5f4703836
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/r/structure.lux
@@ -0,0 +1,39 @@
+(.module:
+ [lux #*
+ [abstract
+ ["." monad (#+ do)]]
+ [data
+ [collection
+ ["." list]]]
+ [target
+ ["_" r (#+ Expression)]]]
+ ["." // #_
+ ["#." runtime (#+ Operation Phase Generator)]
+ ["#." primitive]
+ ["///#" //// #_
+ [analysis (#+ Variant Tuple)]
+ ["#." synthesis (#+ Synthesis)]
+ ["//#" /// #_
+ ["#." phase ("#\." monad)]]]])
+
+(def: #export (tuple expression archive elemsS+)
+ (Generator (Tuple Synthesis))
+ (case elemsS+
+ #.Nil
+ (///////phase\wrap (//primitive.text /////synthesis.unit))
+
+ (#.Cons singletonS #.Nil)
+ (expression archive singletonS)
+
+ _
+ (|> elemsS+
+ (monad.map ///////phase.monad (expression archive))
+ (///////phase\map _.list))))
+
+(def: #export (variant expression archive [lefts right? valueS])
+ (Generator (Variant Synthesis))
+ (let [tag (if right?
+ (inc lefts)
+ lefts)]
+ (///////phase\map (|>> (//runtime.variant tag right?))
+ (expression archive valueS))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme.lux
index be476cf74..1a36df4e0 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme.lux
@@ -2,8 +2,6 @@
[lux #*
[abstract
[monad (#+ do)]]
- [control
- ["." exception (#+ exception:)]]
[target
["_" scheme]]]
["." / #_
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux
index 380352c5b..65c674ded 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/function.lux
@@ -89,8 +89,7 @@
output_func_args (//runtime.slice arityO
(|> @num_args (_.-/2 arityO))
@curried)]
- (_.begin (list ## (_.display/1 (_.string (format "!!! PRE [slice]" text.new_line)))
- (|> @self
+ (_.begin (list (|> @self
(apply_poly arity_args)
(apply_poly output_func_args))))))
## (|> @num_args (_.</2 arityO))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux
index 633b0da5a..d4b964910 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/loop.lux
@@ -13,7 +13,7 @@
[number
["n" nat]]]
[target
- ["_" scheme (#+ Computation Var)]]]
+ ["_" scheme]]]
["." // #_
[runtime (#+ Operation Phase Generator)]
["#." case]
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux
index 612cb3153..7f55df9a9 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux
@@ -11,7 +11,8 @@
["." product]
["." text ("#\." hash)
["%" format (#+ format)]
- ["." encoding]]
+ [encoding
+ ["." utf8]]]
[collection
["." list ("#\." functor)]
["." row]]]
@@ -365,4 +366,4 @@
(row.row [(%.nat ..module_id)
(|> ..runtime
_.code
- (\ encoding.utf8 encode))])])))
+ (\ utf8.codec encode))])])))
diff --git a/stdlib/source/lux/tool/compiler/meta/io/context.lux b/stdlib/source/lux/tool/compiler/meta/io/context.lux
index 6c44c026a..3bb388f5e 100644
--- a/stdlib/source/lux/tool/compiler/meta/io/context.lux
+++ b/stdlib/source/lux/tool/compiler/meta/io/context.lux
@@ -15,7 +15,8 @@
[binary (#+ Binary)]
["." text ("#\." hash)
["%" format (#+ format)]
- ["." encoding]]
+ [encoding
+ ["." utf8]]]
[collection
["." dictionary (#+ Dictionary)]]]
[world
@@ -127,7 +128,7 @@
(Promise (Try Input)))
(do (try.with promise.monad)
[[path binary] (..find_any_source_file system import contexts partial_host_extension module)]
- (case (\ encoding.utf8 decode binary)
+ (case (\ utf8.codec decode binary)
(#try.Success code)
(wrap {#////.module module
#////.file path
diff --git a/stdlib/source/lux/tool/compiler/meta/packager/script.lux b/stdlib/source/lux/tool/compiler/meta/packager/script.lux
index e8685ce2b..c23688a9e 100644
--- a/stdlib/source/lux/tool/compiler/meta/packager/script.lux
+++ b/stdlib/source/lux/tool/compiler/meta/packager/script.lux
@@ -12,7 +12,8 @@
["." product]
[text
["%" format (#+ format)]
- ["." encoding]]
+ [encoding
+ ["." utf8]]]
[collection
["." row]
["." list ("#\." functor)]]]
@@ -49,7 +50,7 @@
(monad.fold try.monad
(function (_ content so_far)
(|> content
- (\ encoding.utf8 decode)
+ (\ utf8.codec decode)
(\ try.monad map
(function (_ content)
(sequence so_far
@@ -75,4 +76,4 @@
(list\map (function (_ [module [module_id [descriptor document output]]])
[module_id output]))
(monad.fold ! (..write_module sequence) header)
- (\ ! map (|>> scope to_code (\ encoding.utf8 encode)))))))
+ (\ ! map (|>> scope to_code (\ utf8.codec encode)))))))