Split new-luxc into lux-jvm and lux-r.

16 files changed, 2595 insertions, 0 deletions

diff --git a/lux-r/source/luxc/lang/host/r.lux b/lux-r/source/luxc/lang/host/r.lux
new file mode 100644
index 000000000..6e4c7fb5b
--- /dev/null
+++ b/lux-r/source/luxc/lang/host/r.lux
@@ -0,0 +1,299 @@
+(.module:
+  [lux #- not or and list if function cond when]
+  (lux (control pipe)
+       (data [maybe "maybe/" Functor<Maybe>]
+             [text]
+             text/format
+             [number]
+             (coll [list "list/" Functor<List> Fold<List>]))
+       (type abstract)))
+
+(abstract: #export Single {} Any)
+(abstract: #export Poly {} Any)
+
+(abstract: #export (Var kind)
+  {}
+
+  Text
+
+  (def: name (All [k] (-> (Var k) Text)) (|>> :representation))
+
+  (def: #export var (-> Text (Var Single)) (|>> :abstraction))
+  (def: #export var-args (Var Poly) (:abstraction "..."))
+  )
+
+(type: #export SVar (Var Single))
+(type: #export PVar (Var Poly))
+
+(abstract: #export Expression
+  {}
+  
+  Text
+
+  (def: #export expression (-> Expression Text) (|>> :representation))
+
+  (def: #export code (-> Text Expression) (|>> :abstraction))
+
+  (def: (self-contained code)
+    (-> Text Expression)
+    (:abstraction
+     (format "(" code ")")))
+
+  (def: nest
+    (-> Text Text)
+    (|>> (format "\n")
+         (text.replace-all "\n" "\n  ")))
+
+  (def: (_block expression)
+    (-> Text Text)
+    (format "{" (nest expression) "\n" "}"))
+
+  (def: #export (block expression)
+    (-> Expression Expression)
+    (:abstraction
+     (format "{" (:representation expression) "}")))
+
+  (def: #export null
+    Expression
+    (|> "NULL" self-contained))
+
+  (def: #export n/a
+    Expression
+    (|> "NA" self-contained))
+
+  (def: #export not-available Expression n/a)
+  (def: #export not-applicable Expression n/a)
+  (def: #export no-answer Expression n/a)
+
+  (def: #export bool
+    (-> Bit Expression)
+    (|>> (case> #0 "FALSE"
+                #1 "TRUE")
+         self-contained))
+
+  (def: #export (int value)
+    (-> Int Expression)
+    (self-contained
+     (format "as.integer(" (%i value) ")")))
+
+  (def: #export float
+    (-> Frac Expression)
+    (|>> (cond> [(f/= number.positive-infinity)]
+                [(new> "1.0/0.0")]
+                
+                [(f/= number.negative-infinity)]
+                [(new> "-1.0/0.0")]
+                
+                [(f/= number.not-a-number)]
+                [(new> "0.0/0.0")]
+                
+                ## else
+                [%f])
+         self-contained))
+
+  (def: #export string
+    (-> Text Expression)
+    (|>> %t 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> "(") ")" expression))]
+
+    [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 expression 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 expression args)) ","
+                     (text.join-with "," (list/map (.function (_ [key val])
+                                                     (format key "=" (expression val)))
+                                                   kw-args))
+                     ")"))))
+
+  (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))
+             "\n" "}")))
+
+  (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     "&&"]
+    )
+
+  (def: #export @@
+    (All [k] (-> (Var k) Expression))
+    (|>> ..name self-contained))
+
+  (def: #export global
+    (-> Text Expression)
+    (|>> var @@))
+
+  (template [<name> <func>]
+    [(def: #export (<name> param subject)
+       (-> Expression Expression Expression)
+       (..apply (.list subject param) (..global <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) (..global "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) (..global "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 ..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 (for-in var inputs body)
+    (-> SVar Expression Expression Expression)
+    (self-contained
+     (format "for (" (..name var) " in " (..expression inputs) ")"
+             (.._block (:representation body)))))
+
+  (template [<name> <keyword>]
+    [(def: #export (<name> message)
+       (-> Expression Expression)
+       (..apply (.list message) (..global <keyword>)))]
+
+    [stop  "stop"]
+    [print "print"]
+    )
+
+  (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 (then pre post)
+    (-> Expression Expression Expression)
+    (:abstraction
+     (format (:representation pre)
+             "\n"
+             (:representation post))))
+  )
diff --git a/lux-r/source/luxc/lang/synthesis/variable.lux b/lux-r/source/luxc/lang/synthesis/variable.lux
new file mode 100644
index 000000000..f6a45b02e
--- /dev/null
+++ b/lux-r/source/luxc/lang/synthesis/variable.lux
@@ -0,0 +1,98 @@
+(.module:
+  lux
+  (lux (data [number]
+             (coll [list "list/" Fold<List> Monoid<List>]
+                   ["s" set])))
+  (luxc (lang ["la" analysis]
+              ["ls" synthesis]
+              [".L" variable #+ Variable])))
+
+(def: (bound-vars path)
+  (-> ls.Path (List Variable))
+  (case path
+    (#ls.BindP register)
+    (list (.int register))
+
+    (^or (#ls.SeqP pre post) (#ls.AltP pre post))
+    (list/compose (bound-vars pre) (bound-vars post))
+    
+    _
+    (list)))
+
+(def: (path-bodies path)
+  (-> ls.Path (List ls.Synthesis))
+  (case path
+    (#ls.ExecP body)
+    (list body)
+
+    (#ls.SeqP pre post)
+    (path-bodies post)
+
+    (#ls.AltP pre post)
+    (list/compose (path-bodies pre) (path-bodies post))
+    
+    _
+    (list)))
+
+(def: (non-arg? arity var)
+  (-> ls.Arity Variable Bit)
+  (and (variableL.local? var)
+       (n/> arity (.nat var))))
+
+(type: Tracker (s.Set Variable))
+
+(def: init-tracker Tracker (s.new number.Hash<Int>))
+
+(def: (unused-vars current-arity bound exprS)
+  (-> ls.Arity (List Variable) ls.Synthesis (List Variable))
+  (let [tracker (loop [exprS exprS
+                       tracker (list/fold s.add init-tracker bound)]
+                  (case exprS
+                    (#ls.Variable var)
+                    (if (non-arg? current-arity var)
+                      (s.remove var tracker)
+                      tracker)
+                    
+                    (#ls.Variant tag last? memberS)
+                    (recur memberS tracker)
+
+                    (#ls.Tuple membersS)
+                    (list/fold recur tracker membersS)
+
+                    (#ls.Call funcS argsS)
+                    (list/fold recur (recur funcS tracker) argsS)
+                    
+                    (^or (#ls.Recur argsS)
+                         (#ls.Procedure name argsS))
+                    (list/fold recur tracker argsS)
+
+                    (#ls.Let offset inputS outputS)
+                    (|> tracker (recur inputS) (recur outputS))
+
+                    (#ls.If testS thenS elseS)
+                    (|> tracker (recur testS) (recur thenS) (recur elseS))
+
+                    (#ls.Loop offset initsS bodyS)
+                    (recur bodyS (list/fold recur tracker initsS))
+
+                    (#ls.Case inputS outputPS)
+                    (let [tracker' (list/fold s.add
+                                              (recur inputS tracker)
+                                              (bound-vars outputPS))]
+                      (list/fold recur tracker' (path-bodies outputPS)))
+
+                    (#ls.Function arity env bodyS)
+                    (list/fold s.remove tracker env)
+
+                    _
+                    tracker
+                    ))]
+    (s.to-list tracker)))
+
+## (def: (optimize-register-use current-arity [pathS bodyS])
+##   (-> ls.Arity [ls.Path ls.Synthesis] [ls.Path ls.Synthesis])
+##   (let [bound (bound-vars pathS)
+##         unused (unused-vars current-arity bound bodyS)
+##         adjusted (adjust-vars unused bound)]
+##     [(|> pathS (clean-pattern adjusted) simplify-pattern)
+##      (clean-expression adjusted bodyS)]))
diff --git a/lux-r/source/luxc/lang/translation/r.lux b/lux-r/source/luxc/lang/translation/r.lux
new file mode 100644
index 000000000..a4a3db1f5
--- /dev/null
+++ b/lux-r/source/luxc/lang/translation/r.lux
@@ -0,0 +1,216 @@
+(.module:
+  lux
+  (lux (control ["ex" exception #+ exception:]
+                pipe
+                [monad #+ do])
+       (data [bit]
+             [maybe]
+             ["e" error #+ Error]
+             [text "text/" Eq<Text>]
+             text/format
+             (coll [array]))
+       [macro]
+       [io #+ IO Process io]
+       [host #+ class: interface: object]
+       (world [file #+ File]))
+  (luxc [lang]
+        (lang [".L" variable #+ Register]
+              (host [r #+ Expression]))
+        [".C" io]))
+
+(template [<name>]
+  [(exception: #export (<name> {message Text})
+     message)]
+
+  [No-Active-Module-Buffer]
+  [Cannot-Execute]
+
+  [No-Anchor]
+  )
+
+(host.import: java/lang/Object)
+
+(host.import: java/lang/String
+  (getBytes [String] #try [byte]))
+
+(host.import: java/lang/CharSequence)
+
+(host.import: java/lang/Appendable
+  (append [CharSequence] Appendable))
+
+(host.import: java/lang/StringBuilder
+  (new [])
+  (toString [] String))
+
+(host.import: javax/script/ScriptEngine
+  (eval [String] #try #? Object))
+
+(host.import: javax/script/ScriptEngineFactory
+  (getScriptEngine [] ScriptEngine))
+
+(type: #export Anchor [Text Register])
+
+(type: #export Host
+  {#context [Text Nat]
+   #anchor (Maybe Anchor)
+   #loader (-> Expression (Error Any))
+   #interpreter (-> Expression (Error Object))
+   #module-buffer (Maybe StringBuilder)
+   #program-buffer StringBuilder})
+
+(def: #export init
+  (IO Host)
+  (io (let [interpreter (|> (undefined)
+                            (ScriptEngineFactory::getScriptEngine []))]
+        {#context ["" +0]
+         #anchor #.None
+         #loader (function (_ code)
+                   (do e.Monad<Error>
+                     [_ (ScriptEngine::eval [(r.expression code)] interpreter)]
+                     (wrap [])))
+         #interpreter (function (_ code)
+                        (do e.Monad<Error>
+                          [output (ScriptEngine::eval [(r.expression code)] interpreter)]
+                          (wrap (maybe.default (:coerce Object [])
+                                               output))))
+         #module-buffer #.None
+         #program-buffer (StringBuilder::new [])})))
+
+(def: #export r-module-name Text "module.r")
+
+(def: #export init-module-buffer
+  (Meta Any)
+  (function (_ compiler)
+    (#e.Success [(update@ #.host
+                          (|>> (:coerce Host)
+                               (set@ #module-buffer (#.Some (StringBuilder::new [])))
+                               (:coerce Nothing))
+                          compiler)
+                 []])))
+
+(def: #export (with-sub-context expr)
+  (All [a] (-> (Meta a) (Meta [Text a])))
+  (function (_ compiler)
+    (let [old (:coerce Host (get@ #.host compiler))
+          [old-name old-sub] (get@ #context old)
+          new-name (format old-name "f___" (%i (.int old-sub)))]
+      (case (expr (set@ #.host
+                        (:coerce Nothing (set@ #context [new-name +0] old))
+                        compiler))
+        (#e.Success [compiler' output])
+        (#e.Success [(update@ #.host
+                              (|>> (:coerce Host)
+                                   (set@ #context [old-name (inc old-sub)])
+                                   (:coerce Nothing))
+                              compiler')
+                     [new-name output]])
+
+        (#e.Error error)
+        (#e.Error error)))))
+
+(def: #export context
+  (Meta Text)
+  (function (_ compiler)
+    (#e.Success [compiler
+                 (|> (get@ #.host compiler)
+                     (:coerce Host)
+                     (get@ #context)
+                     (let> [name sub]
+                           name))])))
+
+(def: #export (with-anchor anchor expr)
+  (All [a] (-> Anchor (Meta a) (Meta a)))
+  (function (_ compiler)
+    (let [old (:coerce Host (get@ #.host compiler))]
+      (case (expr (set@ #.host
+                        (:coerce Nothing (set@ #anchor (#.Some anchor) old))
+                        compiler))
+        (#e.Success [compiler' output])
+        (#e.Success [(update@ #.host
+                              (|>> (:coerce Host)
+                                   (set@ #anchor (get@ #anchor old))
+                                   (:coerce Nothing))
+                              compiler')
+                     output])
+
+        (#e.Error error)
+        (#e.Error error)))))
+
+(def: #export anchor
+  (Meta Anchor)
+  (function (_ compiler)
+    (case (|> compiler (get@ #.host) (:coerce Host) (get@ #anchor))
+      (#.Some anchor)
+      (#e.Success [compiler anchor])
+
+      #.None
+      ((lang.throw No-Anchor "") compiler))))
+
+(def: #export module-buffer
+  (Meta StringBuilder)
+  (function (_ compiler)
+    (case (|> compiler (get@ #.host) (:coerce Host) (get@ #module-buffer))
+      #.None
+      ((lang.throw No-Active-Module-Buffer "") compiler)
+      
+      (#.Some module-buffer)
+      (#e.Success [compiler module-buffer]))))
+
+(def: #export program-buffer
+  (Meta StringBuilder)
+  (function (_ compiler)
+    (#e.Success [compiler (|> compiler (get@ #.host) (:coerce Host) (get@ #program-buffer))])))
+
+(template [<name> <field> <outputT>]
+  [(def: (<name> code)
+     (-> Expression (Meta <outputT>))
+     (function (_ compiler)
+       (let [runner (|> compiler (get@ #.host) (:coerce Host) (get@ <field>))]
+         (case (runner code)
+           (#e.Error error)
+           ((lang.throw Cannot-Execute error) compiler)
+           
+           (#e.Success output)
+           (#e.Success [compiler output])))))]
+
+  [load!     #loader      Any]
+  [interpret #interpreter Object]
+  )
+
+(def: #export variant-tag-field "luxVT")
+(def: #export variant-flag-field "luxVF")
+(def: #export variant-value-field "luxVV")
+
+(def: #export int-high-field "luxIH")
+(def: #export int-low-field "luxIL")
+
+(def: #export unit Text "")
+
+(def: #export (definition-name [module name])
+  (-> Name Text)
+  (lang.normalize-name (format module "$" name)))
+
+(def: #export (save code)
+  (-> Expression (Meta Any))
+  (do macro.Monad<Meta>
+    [module-buffer module-buffer
+     #let [_ (Appendable::append [(:coerce CharSequence (r.expression code))]
+                                 module-buffer)]]
+    (load! code)))
+
+(def: #export run interpret)
+
+(def: #export (save-module! target)
+  (-> File (Meta (Process Any)))
+  (do macro.Monad<Meta>
+    [module macro.current-module-name
+     module-buffer module-buffer
+     program-buffer program-buffer
+     #let [module-code (StringBuilder::toString [] module-buffer)
+           _ (Appendable::append [(:coerce CharSequence (format module-code "\n"))]
+                                 program-buffer)]]
+    (wrap (ioC.write target
+                     (format (lang.normalize-name module) "/" r-module-name)
+                     (|> module-code
+                         (String::getBytes ["UTF-8"])
+                         e.assume)))))
diff --git a/lux-r/source/luxc/lang/translation/r/case.jvm.lux b/lux-r/source/luxc/lang/translation/r/case.jvm.lux
new file mode 100644
index 000000000..42460b620
--- /dev/null
+++ b/lux-r/source/luxc/lang/translation/r/case.jvm.lux
@@ -0,0 +1,195 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:])
+       (data [number]
+             [text]
+             text/format
+             (coll [list "list/" Functor<List> Fold<List>]
+                   (set ["set" unordered #+ Set])))
+       [macro #+ "meta/" Monad<Meta>]
+       (macro [code]))
+  (luxc [lang]
+        (lang [".L" variable #+ Register Variable]
+              ["ls" synthesis #+ Synthesis Path]
+              (host [r #+ Expression SVar @@])))
+  [//]
+  (// [".T" runtime]
+      [".T" primitive]
+      [".T" reference]))
+
+(def: #export (translate-let translate register valueS bodyS)
+  (-> (-> Synthesis (Meta Expression)) Register Synthesis Synthesis
+      (Meta Expression))
+  (do macro.Monad<Meta>
+    [valueO (translate valueS)
+     bodyO (translate bodyS)
+     #let [$register (referenceT.variable register)]]
+    (wrap (r.block
+           ($_ r.then
+               (r.set! $register valueO)
+               bodyO)))))
+
+(def: #export (translate-record-get translate valueS pathP)
+  (-> (-> Synthesis (Meta Expression)) Synthesis (List [Nat Bit])
+      (Meta Expression))
+  (do macro.Monad<Meta>
+    [valueO (translate valueS)]
+    (wrap (list/fold (function (_ [idx tail?] source)
+                       (let [method (if tail?
+                                      runtimeT.product//right
+                                      runtimeT.product//left)]
+                         (method source (r.int (:coerce Int idx)))))
+                     valueO
+                     pathP))))
+
+(def: #export (translate-if testO thenO elseO)
+  (-> Expression Expression Expression Expression)
+  (r.if testO thenO elseO))
+
+(def: $savepoint (r.var "lux_pm_cursor_savepoint"))
+(def: $cursor (r.var "lux_pm_cursor"))
+
+(def: top r.length)
+(def: next (|>> r.length (r.+ (r.int 1))))
+(def: (push! value var)
+  (-> Expression SVar Expression)
+  (r.set-nth! (next (@@ var)) value var))
+(def: (pop! var)
+  (-> SVar Expression)
+  (r.set-nth! (top (@@ var)) r.null var))
+
+(def: (push-cursor! value)
+  (-> Expression Expression)
+  (push! value $cursor))
+
+(def: save-cursor!
+  Expression
+  (push! (r.slice (r.float 1.0) (r.length (@@ $cursor)) (@@ $cursor))
+         $savepoint))
+
+(def: restore-cursor!
+  Expression
+  (r.set! $cursor (r.nth (top (@@ $savepoint)) (@@ $savepoint))))
+
+(def: cursor-top
+  Expression
+  (|> (@@ $cursor) (r.nth (top (@@ $cursor)))))
+
+(def: pop-cursor!
+  Expression
+  (pop! $cursor))
+
+(def: pm-error (r.string "PM-ERROR"))
+
+(def: fail-pm! (r.stop pm-error))
+
+(def: $temp (r.var "lux_pm_temp"))
+
+(exception: #export (Unrecognized-Path {message Text})
+  message)
+
+(def: $alt_error (r.var "alt_error"))
+
+(def: (pm-catch handler)
+  (-> Expression Expression)
+  (r.function (list $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 Expression))
+  (case pathP
+    (^code ("lux case exec" (~ bodyS)))
+    (do macro.Monad<Meta>
+      [bodyO (translate bodyS)]
+      (wrap bodyO))
+
+    (^code ("lux case pop"))
+    (meta/wrap pop-cursor!)
+
+    (^code ("lux case bind" (~ [_ (#.Nat register)])))
+    (meta/wrap (r.set! (referenceT.variable register) cursor-top))
+
+    (^template [<tag> <format>]
+      [_ (<tag> value)]
+      (meta/wrap (r.when (r.not (r.= (|> value <format>) cursor-top))
+                         fail-pm!)))
+    ([#.Bit  r.bool]
+     [#.Frac r.float]
+     [#.Text r.string])
+
+    (^template [<tag> <format>]
+      [_ (<tag> value)]
+      (meta/wrap (r.when (r.not (runtimeT.int//= (|> value <format>) cursor-top))
+                         fail-pm!)))
+    ([#.Nat  (<| runtimeT.int (:coerce Int))]
+     [#.Int  runtimeT.int]
+     [#.Rev  (<| runtimeT.int (:coerce Int))])
+
+    (^template [<pm> <getter>]
+      (^code (<pm> (~ [_ (#.Nat idx)])))
+      (meta/wrap (push-cursor! (<getter> cursor-top (r.int (:coerce Int idx))))))
+    (["lux case tuple left" runtimeT.product//left]
+     ["lux case tuple right" runtimeT.product//right])
+
+    (^template [<pm> <flag>]
+      (^code (<pm> (~ [_ (#.Nat idx)])))
+      (meta/wrap ($_ r.then
+                     (r.set! $temp (runtimeT.sum//get cursor-top (r.int (:coerce Int idx)) <flag>))
+                     (r.if (r.= r.null (@@ $temp))
+                       fail-pm!
+                       (push-cursor! (@@ $temp))))))
+    (["lux case variant left" r.null]
+     ["lux case variant right" (r.string "")])
+
+    (^code ("lux case seq" (~ leftP) (~ rightP)))
+    (do macro.Monad<Meta>
+      [leftO (translate-pattern-matching' translate leftP)
+       rightO (translate-pattern-matching' translate rightP)]
+      (wrap ($_ r.then
+                leftO
+                rightO)))
+
+    (^code ("lux case alt" (~ leftP) (~ rightP)))
+    (do macro.Monad<Meta>
+      [leftO (translate-pattern-matching' translate leftP)
+       rightO (translate-pattern-matching' translate rightP)]
+      (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 Expression))
+  (do macro.Monad<Meta>
+    [pattern-matching! (translate-pattern-matching' translate pathP)]
+    (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 Expression)
+  ($_ r.then
+      (r.set! $cursor (r.list (list stack-init)))
+      (r.set! $savepoint (r.list (list)))))
+
+(def: #export (translate-case translate valueS pathP)
+  (-> (-> Synthesis (Meta Expression)) Synthesis Path (Meta Expression))
+  (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!)))))
diff --git a/lux-r/source/luxc/lang/translation/r/expression.jvm.lux b/lux-r/source/luxc/lang/translation/r/expression.jvm.lux
new file mode 100644
index 000000000..3c41fbe63
--- /dev/null
+++ b/lux-r/source/luxc/lang/translation/r/expression.jvm.lux
@@ -0,0 +1,88 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:]
+                ["p" parser])
+       (data ["e" error]
+             text/format)
+       [macro]
+       (macro ["s" syntax]))
+  (luxc ["&" lang]
+        (lang [".L" variable #+ Variable Register]
+              [".L" extension]
+              ["ls" synthesis]
+              (host [r #+ Expression])))
+  [//]
+  (// [".T" runtime]
+      [".T" primitive]
+      [".T" structure]
+      [".T" reference]
+      [".T" function]
+      [".T" case]
+      [".T" procedure])
+  )
+
+(template [<name>]
+  [(exception: #export (<name> {message Text})
+     message)]
+
+  [Invalid-Function-Syntax]
+  [Unrecognized-Synthesis]
+  )
+
+(def: #export (translate synthesis)
+  (-> ls.Synthesis (Meta Expression))
+  (case synthesis
+    (^code [])
+    (:: macro.Monad<Meta> wrap runtimeT.unit)
+
+    (^template [<tag> <generator>]
+      [_ (<tag> value)]
+      (<generator> value))
+    ([#.Bit primitiveT.translate-bit]
+     [#.Nat  primitiveT.translate-nat]
+     [#.Int  primitiveT.translate-int]
+     [#.Rev  primitiveT.translate-rev]
+     [#.Frac primitiveT.translate-frac]
+     [#.Text primitiveT.translate-text])
+
+    (^code ((~ [_ (#.Nat tag)]) (~ [_ (#.Bit last?)]) (~ valueS)))
+    (structureT.translate-variant translate tag last? valueS)
+
+    (^code [(~ singleton)])
+    (translate singleton)
+
+    (^code [(~+ members)])
+    (structureT.translate-tuple translate members)
+
+    (^ [_ (#.Form (list [_ (#.Int var)]))])
+    (referenceT.translate-variable var)
+
+    [_ (#.Identifier definition)]
+    (referenceT.translate-definition definition)
+
+    (^code ("lux let" (~ [_ (#.Nat register)]) (~ inputS) (~ exprS)))
+    (caseT.translate-let translate register inputS exprS)
+
+    (^code ("lux case" (~ inputS) (~ pathPS)))
+    (caseT.translate-case translate inputS pathPS)
+
+    (^code ("lux function" (~ [_ (#.Nat arity)]) [(~+ environment)] (~ bodyS)))
+    (case (s.run environment (p.some s.int))
+      (#e.Success environment)
+      (functionT.translate-function translate environment arity bodyS)
+
+      _
+      (&.throw Invalid-Function-Syntax (%code synthesis)))
+
+    (^code ("lux call" (~ functionS) (~+ argsS)))
+    (functionT.translate-apply translate functionS argsS)
+
+    (^code ((~ [_ (#.Text procedure)]) (~+ argsS)))
+    (procedureT.translate-procedure translate procedure argsS)
+    ## (do macro.Monad<Meta>
+    ##   [translation (extensionL.find-translation procedure)]
+    ##   (translation argsS))
+
+    _
+    (&.throw Unrecognized-Synthesis (%code synthesis))))
diff --git a/lux-r/source/luxc/lang/translation/r/function.jvm.lux b/lux-r/source/luxc/lang/translation/r/function.jvm.lux
new file mode 100644
index 000000000..f39a5e1a2
--- /dev/null
+++ b/lux-r/source/luxc/lang/translation/r/function.jvm.lux
@@ -0,0 +1,94 @@
+(.module:
+  lux
+  (lux (control [monad #+ do]
+                pipe)
+       (data [product]
+             [text]
+             text/format
+             (coll [list "list/" Functor<List> Fold<List>]))
+       [macro])
+  (luxc ["&" lang]
+        (lang ["ls" synthesis]
+              [".L" variable #+ Variable]
+              (host [r #+ Expression @@])))
+  [//]
+  (// [".T" reference]))
+
+(def: #export (translate-apply translate functionS argsS+)
+  (-> (-> ls.Synthesis (Meta Expression)) ls.Synthesis (List ls.Synthesis) (Meta Expression))
+  (do {@ macro.Monad<Meta>}
+    [functionO (translate functionS)
+     argsO+ (monad.map @ translate argsS+)]
+    (wrap (r.apply argsO+ functionO))))
+
+(def: $curried (r.var "curried"))
+
+(def: (input-declaration register)
+  (r.set! (referenceT.variable (inc register))
+          (|> (@@ $curried) (r.nth (|> register inc .int r.int)))))
+
+(def: (with-closure function-name inits function-definition)
+  (-> Text (List Expression) Expression (Meta Expression))
+  (let [$closure (r.var (format function-name "___CLOSURE"))]
+    (case inits
+      #.Nil
+      (do macro.Monad<Meta>
+        [_ (//.save function-definition)]
+        (wrap (r.global function-name)))
+
+      _
+      (do macro.Monad<Meta>
+        [_ (//.save (r.set! $closure
+                            (r.function (|> (list.enumerate inits)
+                                            (list/map (|>> product.left referenceT.closure)))
+                              ($_ r.then
+                                  function-definition
+                                  (r.global function-name)))))]
+        (wrap (r.apply inits (@@ $closure)))))))
+
+(def: #export (translate-function translate env arity bodyS)
+  (-> (-> ls.Synthesis (Meta Expression))
+      (List Variable) ls.Arity ls.Synthesis
+      (Meta Expression))
+  (do {@ macro.Monad<Meta>}
+    [[function-name bodyO] (//.with-sub-context
+                             (do @
+                               [function-name //.context]
+                               (//.with-anchor [function-name +1]
+                                 (translate bodyS))))
+     closureO+ (monad.map @ referenceT.translate-variable env)
+     #let [arityO (|> arity .int r.int)
+           $num_args (r.var "num_args")
+           $function (r.var function-name)
+           var-args (r.code (format "list" (r.expression (@@ r.var-args))))
+           apply-poly (function (_ args func)
+                        (r.apply (list func args) (r.global "do.call")))]]
+    (with-closure function-name closureO+
+      (r.set! $function
+              (r.function (list r.var-args)
+                ($_ r.then
+                    (r.set! $curried var-args)
+                    (r.set! $num_args (r.length (@@ $curried)))
+                    (r.cond (list [(|> (@@ $num_args) (r.= arityO))
+                                   ($_ r.then
+                                       (r.set! (referenceT.variable +0) (@@ $function))
+                                       (|> (list.n/range +0 (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 (r.+ (r.int 1)))
+                                                                   (@@ $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 var-args)
+                                    (|> (@@ $function)
+                                        (apply-poly (r.apply (list (@@ $curried) (@@ $missing))
+                                                             (r.global "append"))))))))))))
+    ))
diff --git a/lux-r/source/luxc/lang/translation/r/loop.jvm.lux b/lux-r/source/luxc/lang/translation/r/loop.jvm.lux
new file mode 100644
index 000000000..f1197e5ce
--- /dev/null
+++ b/lux-r/source/luxc/lang/translation/r/loop.jvm.lux
@@ -0,0 +1,37 @@
+(.module:
+  lux
+  (lux (control [monad #+ do])
+       (data [text]
+             text/format
+             (coll [list "list/" Functor<List>]))
+       [macro])
+  (luxc [lang]
+        (lang ["ls" synthesis]
+              (host [r #+ Expression @@])))
+  [//]
+  (// [".T" reference]))
+
+(def: #export (translate-loop translate offset initsS+ bodyS)
+  (-> (-> ls.Synthesis (Meta Expression)) Nat (List ls.Synthesis) ls.Synthesis
+      (Meta Expression))
+  (do {@ macro.Monad<Meta>}
+    [loop-name (|> (macro.gensym "loop")
+                   (:: @ map (|>> %code lang.normalize-name)))
+     initsO+ (monad.map @ translate initsS+)
+     bodyO (//.with-anchor [loop-name offset]
+             (translate bodyS))
+     #let [$loop-name (r.var loop-name)
+           @loop-name (@@ $loop-name)]
+     _ (//.save (r.set! $loop-name
+                        (r.function (|> (list.n/range +0 (dec (list.size initsS+)))
+                                        (list/map (|>> (n/+ offset) referenceT.variable)))
+                          bodyO)))]
+    (wrap (r.apply initsO+ @loop-name))))
+
+(def: #export (translate-recur translate argsS+)
+  (-> (-> ls.Synthesis (Meta Expression)) (List ls.Synthesis)
+      (Meta Expression))
+  (do {@ macro.Monad<Meta>}
+    [[loop-name offset] //.anchor
+     argsO+ (monad.map @ translate argsS+)]
+    (wrap (r.apply argsO+ (r.global loop-name)))))
diff --git a/lux-r/source/luxc/lang/translation/r/primitive.jvm.lux b/lux-r/source/luxc/lang/translation/r/primitive.jvm.lux
new file mode 100644
index 000000000..8bc7da848
--- /dev/null
+++ b/lux-r/source/luxc/lang/translation/r/primitive.jvm.lux
@@ -0,0 +1,22 @@
+(.module:
+  lux
+  (lux [macro "meta/" Monad<Meta>])
+  (luxc (lang (host [r #+ Expression])))
+  [//]
+  (// [".T" runtime]))
+
+(def: #export translate-bit
+  (-> Bit (Meta Expression))
+  (|>> r.bool meta/wrap))
+
+(def: #export translate-int
+  (-> Int (Meta Expression))
+  (|>> runtimeT.int meta/wrap))
+
+(def: #export translate-frac
+  (-> Frac (Meta Expression))
+  (|>> r.float meta/wrap))
+
+(def: #export translate-text
+  (-> Text (Meta Expression))
+  (|>> r.string meta/wrap))
diff --git a/lux-r/source/luxc/lang/translation/r/procedure/common.jvm.lux b/lux-r/source/luxc/lang/translation/r/procedure/common.jvm.lux
new file mode 100644
index 000000000..85ccd90dc
--- /dev/null
+++ b/lux-r/source/luxc/lang/translation/r/procedure/common.jvm.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/lux-r/source/luxc/lang/translation/r/procedure/host.jvm.lux b/lux-r/source/luxc/lang/translation/r/procedure/host.jvm.lux
new file mode 100644
index 000000000..3bd33955f
--- /dev/null
+++ b/lux-r/source/luxc/lang/translation/r/procedure/host.jvm.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/lux-r/source/luxc/lang/translation/r/reference.jvm.lux b/lux-r/source/luxc/lang/translation/r/reference.jvm.lux
new file mode 100644
index 000000000..7de1c74ee
--- /dev/null
+++ b/lux-r/source/luxc/lang/translation/r/reference.jvm.lux
@@ -0,0 +1,42 @@
+(.module:
+  lux
+  (lux [macro]
+       (data [text]
+             text/format))
+  (luxc ["&" lang]
+        (lang [".L" variable #+ Variable Register]
+              (host [r #+ Expression SVar @@])))
+  [//]
+  (// [".T" runtime]))
+
+(template [<register> <translation> <prefix>]
+  [(def: #export (<register> register)
+     (-> Register SVar)
+     (r.var (format <prefix> (%i (.int register)))))
+   
+   (def: #export (<translation> register)
+     (-> Register (Meta Expression))
+     (:: macro.Monad<Meta> wrap (@@ (<register> register))))]
+
+  [closure  translate-captured "c"]
+  [variable translate-local    "v"])
+
+(def: #export (local var)
+  (-> Variable SVar)
+  (if (variableL.captured? var)
+    (closure (variableL.captured-register var))
+    (variable (.nat var))))
+
+(def: #export (translate-variable var)
+  (-> Variable (Meta Expression))
+  (if (variableL.captured? var)
+    (translate-captured (variableL.captured-register var))
+    (translate-local (.nat var))))
+
+(def: #export global
+  (-> Name SVar)
+  (|>> //.definition-name r.var))
+
+(def: #export (translate-definition name)
+  (-> Name (Meta Expression))
+  (:: macro.Monad<Meta> wrap (@@ (global name))))
diff --git a/lux-r/source/luxc/lang/translation/r/runtime.jvm.lux b/lux-r/source/luxc/lang/translation/r/runtime.jvm.lux
new file mode 100644
index 000000000..d641041d2
--- /dev/null
+++ b/lux-r/source/luxc/lang/translation/r/runtime.jvm.lux
@@ -0,0 +1,802 @@
+(.module:
+  lux
+  (lux (control ["p" parser "p/" Monad<Parser>]
+                [monad #+ do])
+       (data [bit]
+             [number (#+ hex) ("int/" Interval<Int>)]
+             text/format
+             (coll [list "list/" Monad<List>]))
+       [macro]
+       (macro [code]
+              ["s" syntax #+ syntax:])
+       [io #+ Process])
+  [//]
+  (luxc [lang]
+        (lang (host [r #+ SVar Expression @@]))))
+
+(def: prefix Text "LuxRuntime")
+
+(def: #export unit Expression (r.string //.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 (bit.and full-32) cap-32)
+        
+        (n/> half-32 input)
+        (|> post-32 (n/- input) .int (i/* -1))
+        
+        ## else
+        (.int input)))
+
+(def: high-32 (bit.logical-right-shift +32))
+(def: low-32 (|>> (bit.and (hex "+FFFFFFFF"))))
+
+(def: #export (int value)
+  (-> Int Expression)
+  (let [value (.nat value)
+        high (|> value ..high-32 cap-32)
+        low (|> value ..low-32 cap-32)]
+    (r.named-list (list [//.int-high-field (r.int high)]
+                        [//.int-low-field (r.int low)]))))
+
+(def: (flag value)
+  (-> Bit Expression)
+  (if value
+    (r.string "")
+    r.null))
+
+(def: (variant' tag last? value)
+  (-> Expression Expression Expression Expression)
+  (r.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' (r.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))
+
+(type: Runtime Expression)
+
+(def: declaration
+  (s.Syntax [Text (List Text)])
+  (p.either (p.seq s.local-identifier (p/wrap (list)))
+            (s.form (p.seq s.local-identifier (p.some s.local-identifier)))))
+
+(syntax: (runtime: {[name args] declaration}
+           definition)
+  (let [implementation (code.local-identifier (format "@@" name))
+        runtime (format prefix "__" (lang.normalize-name name))
+        $runtime (` (r.var (~ (code.text runtime))))
+        @runtime (` (@@ (~ $runtime)))
+        argsC+ (list/map code.local-identifier args)
+        argsLC+ (list/map (|>> lang.normalize-name (format "LRV__") code.text (~) (r.var) (`))
+                          args)
+        declaration (` ((~ (code.local-identifier name))
+                        (~+ argsC+)))
+        type (` (-> (~+ (list.repeat (list.size argsC+) (` r.Expression)))
+                    r.Expression))]
+    (wrap (list (` (def: (~' #export) (~ declaration)
+                     (~ type)
+                     (~ (case argsC+
+                          #.Nil
+                          @runtime
+
+                          _
+                          (` (r.apply (list (~+ argsC+)) (~ @runtime)))))))
+                (` (def: (~ implementation)
+                     r.Expression
+                     (~ (case argsC+
+                          #.Nil
+                          (` (r.set! (~ $runtime) (~ definition)))
+
+                          _
+                          (` (let [(~+ (|> (list.zip2 argsC+ argsLC+)
+                                           (list/map (function (_ [left right])
+                                                       (list left right)))
+                                           list/join))]
+                               (r.set! (~ $runtime)
+                                       (r.function (list (~+ argsLC+))
+                                         (~ definition)))))))))))))
+
+(syntax: #export (with-vars {vars (s.tuple (p.many s.local-identifier))}
+                   body)
+  (wrap (list (` (let [(~+ (|> vars
+                               (list/map (function (_ var)
+                                           (list (code.local-identifier var)
+                                                 (` (r.var (~ (code.text (format "LRV__" (lang.normalize-name var)))))))))
+                               list/join))]
+                   (~ body))))))
+
+(def: high-shift (r.bit-shl (r.int 32)))
+
+(runtime: f2^32 (|> (r.int 2) (r.** (r.int 32))))
+(runtime: f2^63 (|> (r.int 2) (r.** (r.int 63))))
+
+(def: (as-double value)
+  (-> Expression Expression)
+  (r.apply (list value) (r.global "as.double")))
+
+(def: (as-integer value)
+  (-> Expression Expression)
+  (r.apply (list value) (r.global "as.integer")))
+
+(runtime: (int//unsigned-low input)
+  (with-vars [low]
+    ($_ r.then
+        (r.set! low (|> (@@ input) (r.nth (r.string //.int-low-field))))
+        (r.if (|> (@@ low) (r.>= (r.int 0)))
+          (@@ low)
+          (|> (@@ low) (r.+ f2^32))))))
+
+(runtime: (int//to-float input)
+  (let [high (|> (@@ input)
+                 (r.nth (r.string //.int-high-field))
+                 high-shift)
+        low (|> (@@ input)
+                int//unsigned-low)]
+    (|> high (r.+ low) as-double)))
+
+(runtime: (int//new high low)
+  (r.named-list (list [//.int-high-field (as-integer (@@ high))]
+                      [//.int-low-field (as-integer (@@ low))])))
+
+(template [<name> <value>]
+  [(runtime: <name>
+     (..int <value>))]
+
+  [int//zero 0]
+  [int//one 1]
+  [int//min int/bottom]
+  [int//max int/top]
+  )
+
+(def: #export int64-high (r.nth (r.string //.int-high-field)))
+(def: #export int64-low (r.nth (r.string //.int-low-field)))
+
+(runtime: (bit//not input)
+  (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.set! sH (|> (@@ subject) int64-high))
+        (r.set! sL (|> (@@ subject) int64-low))
+        (r.set! pH (|> (@@ param) int64-high))
+        (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)])
+              
+              [[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
+                             (r.bit-or (bottom-16 bottom))))]
+          ($_ 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)))
+              (int//new (new-half (@@ x48) (@@ x32))
+                        (new-half (@@ x16) (@@ x00))))))))
+
+(runtime: (int//= reference sample)
+  (let [n/a? (function (_ value)
+               (r.apply (list value) (r.global "is.na")))
+        isTRUE? (function (_ value)
+                  (r.apply (list value) (r.global "isTRUE")))
+        comparison (: (-> (-> Expression Expression) Expression)
+                      (function (_ field)
+                        (|> (|> (field (@@ sample)) (r.= (field (@@ reference))))
+                            (r.or (|> (n/a? (field (@@ sample)))
+                                      (r.and (n/a? (field (@@ reference)))))))))]
+    (|> (comparison int64-high)
+        (r.and (comparison int64-low))
+        isTRUE?)))
+
+(runtime: (int//negate input)
+  (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)
+  (int//+ (int//negate (@@ param)) (@@ subject)))
+
+(runtime: (int//< reference sample)
+  (with-vars [r-? s-?]
+    ($_ r.then
+        (r.set! s-? (|> (@@ sample) int64-high (r.< (r.int 0))))
+        (r.set! r-? (|> (@@ 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.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.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?
+                           (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 Expression)
+  (r.set! shift (|> (@@ shift) (r.bit-and (r.int 63)))))
+
+(def: (no-shift-clause shift input)
+  (-> SVar SVar [Expression Expression])
+  [(|> (@@ shift) (r.= (r.int 0)))
+   (@@ input)])
+
+(runtime: (bit//left-shift shift input)
+  ($_ 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)))]
+                       (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//arithmetic-right-shift-32 shift input)
+  (let [top-bit (|> (@@ input) (r.bit-and (r.int (hex "80000000"))))]
+    (|> (@@ input)
+        (r.bit-ushr (@@ shift))
+        (r.bit-or top-bit))))
+
+(runtime: (bit//arithmetic-right-shift shift input)
+  ($_ 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//arithmetic-right-shift-32 (@@ shift)))
+                           low (|> (int64-low (@@ input))
+                                   (r.bit-ushr (@@ shift))
+                                   (r.bit-or mid))]
+                       (int//new high low))])
+              (let [low (|> (int64-high (@@ input))
+                            (bit//arithmetic-right-shift-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!"))]
+        short-circuit-check [(|> (@@ subject) (int//= int//zero))
+                             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//arithmetic-right-shift (r.int 1))
+                                             (int/// (@@ param))
+                                             (bit//left-shift (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)))]
+    (|> (@@ subject) (int//- flat))))
+
+(def: runtime//int
+  Runtime
+  ($_ r.then
+      @@int//zero
+      @@int//one
+      @@int//min
+      @@int//max
+      @@int//=
+      @@int//<
+      @@int//+
+      @@int//-
+      @@int//negate
+      @@int//-one
+      @@int//unsigned-low
+      @@int//to-float
+      @@int//*
+      @@int///
+      @@int//%))
+
+(runtime: (lux//try op)
+  (with-vars [error value]
+    (r.try ($_ r.then
+               (r.set! value (r.apply (list ..unit) (@@ op)))
+               (..right (@@ value)))
+           #.None
+           (#.Some (r.function (list error)
+                     (..left (r.nth (r.string "message")
+                                    (@@ error)))))
+           #.None)))
+
+(runtime: (lux//program-args program-args)
+  (with-vars [inputs value]
+    ($_ r.then
+        (r.set! inputs ..none)
+        (<| (r.for-in value (@@ program-args))
+            (r.set! inputs (..some (r.list (list (@@ value) (@@ inputs))))))
+        (@@ inputs))))
+
+(def: runtime//lux
+  Runtime
+  ($_ r.then
+      @@lux//try
+      @@lux//program-args))
+
+(def: current-time-float
+  Expression
+  (let [raw-time (r.apply (list) (r.global "Sys.time"))]
+    (r.apply (list raw-time) (r.global "as.numeric"))))
+
+(runtime: (io//current-time! _)
+  (|> current-time-float
+      (r.* (r.float 1,000.0))
+      int//from-float))
+
+(def: runtime//io
+  Runtime
+  ($_ r.then
+      @@io//current-time!))
+
+(def: minimum-index-length
+  (-> SVar Expression)
+  (|>> @@ (r.+ (r.int 1))))
+
+(def: (product-element product index)
+  (-> Expression Expression Expression)
+  (|> product (r.nth (|> index (r.+ (r.int 1))))))
+
+(def: (product-tail product)
+  (-> SVar Expression)
+  (|> (@@ product) (r.nth (r.length (@@ product)))))
+
+(def: (updated-index min-length product)
+  (-> Expression Expression Expression)
+  (|> min-length (r.- (r.length product))))
+
+(runtime: (product//left product index)
+  (let [$index_min_length (r.var "index_min_length")]
+    ($_ r.then
+        (r.set! $index_min_length (minimum-index-length index))
+        (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.set! $index_min_length (minimum-index-length 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
+        sum-tag (|> (@@ sum) (r.nth (r.string //.variant-tag-field)))
+        sum-flag (|> (@@ sum) (r.nth (r.string //.variant-flag-field)))
+        sum-value (|> (@@ sum) (r.nth (r.string //.variant-value-field)))
+        is-last? (|> sum-flag (r.= (r.string "")))
+        test-recursion (r.if is-last?
+                         ## Must recurse.
+                         (sum//get sum-value
+                                   (|> (@@ wanted_tag) (r.- sum-tag))
+                                   (@@ wants_last))
+                         no-match)]
+    (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]
+
+                  [(|> (|> (@@ wants_last) (r.= (r.string "")))
+                       (r.and (|> (@@ wanted_tag) (r.< sum-tag))))
+                   (variant' (|> sum-tag (r.- (@@ wanted_tag))) sum-flag sum-value)])
+
+            no-match)))
+
+(def: runtime//adt
+  Runtime
+  ($_ r.then
+      @@product//left
+      @@product//right
+      @@sum//get
+      ))
+
+(template [<name> <op>]
+  [(runtime: (<name> mask 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]
+  [bit//xor r.bit-xor]
+  )
+
+(runtime: (bit//logical-right-shift shift input)
+  ($_ r.then
+      (limit-shift! shift)
+      (r.cond (list (no-shift-clause shift input)
+                    [(|> (@@ shift) (r.< (r.int 32)))
+                     (with-vars [$mid]
+                       (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 (r.if (r.apply (list (@@ $mid)) (r.global "is.na"))
+                                                 (r.int 0)
+                                                 (@@ $mid))))]
+                         ($_ r.then
+                             (r.set! $mid 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
+      @@bit//and
+      @@bit//or
+      @@bit//xor
+      @@bit//not
+      @@bit//left-shift
+      @@bit//arithmetic-right-shift-32
+      @@bit//arithmetic-right-shift
+      @@bit//logical-right-shift
+      ))
+
+(runtime: (frac//decode input)
+  (with-vars [output]
+    ($_ r.then
+        (r.set! output (r.apply (list (@@ input)) (r.global "as.numeric")))
+        (r.if (|> (@@ output) (r.= r.n/a))
+          ..none
+          (..some (@@ output))))))
+
+(def: runtime//frac
+  Runtime
+  ($_ r.then
+      @@frac//decode))
+
+(def: inc (-> Expression Expression) (|>> (r.+ (r.int 1))))
+
+(template [<name> <top-cmp>]
+  [(def: (<name> top value)
+     (-> Expression Expression Expression)
+     (|> (|> value (r.>= (r.int 0)))
+         (r.and (|> value (<top-cmp> top)))))]
+
+  [within? r.<]
+  [up-to?  r.<=]
+  )
+
+(def: (text-clip start end text)
+  (-> Expression Expression Expression Expression)
+  (r.apply (list text start end)
+           (r.global "substr")))
+
+(def: (text-length text)
+  (-> Expression Expression)
+  (r.apply (list text) (r.global "nchar")))
+
+(runtime: (text//index subject param start)
+  (with-vars [idx startF subjectL]
+    ($_ r.then
+        (r.set! startF (int//to-float (@@ start)))
+        (r.set! subjectL (text-length (@@ subject)))
+        (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 #1)])
+                                          (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.set! length (r.length (@@ text)))
+        (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)
+  (r.apply (list (text-clip idx idx text))
+           (r.global "utf8ToInt")))
+
+(runtime: (text//char text idx)
+  (r.if (|> (@@ idx) (within? (r.length (@@ text))))
+    ($_ r.then
+        (r.set! idx (inc (@@ idx)))
+        (..some (int//from-float (char-at (@@ idx) (@@ text)))))
+    ..none))
+
+(def: runtime//text
+  Runtime
+  ($_ r.then
+      @@text//index
+      @@text//clip
+      @@text//char))
+
+(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.set! output (r.list (list)))
+        (r.set-nth! (|> (@@ size) (r.+ (r.int 1)))
+                    r.null
+                    output)
+        (@@ output))))
+
+(runtime: (array//get array idx)
+  (with-vars [temp]
+    (<| (check-index-out-of-bounds (@@ array) (@@ idx))
+        ($_ r.then
+            (r.set! temp (|> (@@ array) (r.nth (@@ idx))))
+            (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.set-nth! (@@ idx) (@@ value) array)
+          (@@ array))))
+
+(def: runtime//array
+  Runtime
+  ($_ r.then
+      @@array//new
+      @@array//get
+      @@array//put))
+
+(runtime: (box//write value box)
+  ($_ r.then
+      (r.set-nth! (r.int 1) (@@ value) box)
+      ..unit))
+
+(def: runtime//box
+  Runtime
+  ($_ r.then
+      @@box//write))
+
+(def: runtime
+  Runtime
+  ($_ r.then
+      runtime//lux
+      @@f2^32
+      @@f2^63
+      @@int//new
+      @@int//from-float
+      runtime//bit
+      runtime//int
+      runtime//adt
+      runtime//frac
+      runtime//text
+      runtime//array
+      runtime//box
+      runtime//io
+      ))
+
+(def: #export artifact Text (format prefix ".r"))
+
+(def: #export translate
+  (Meta (Process Any))
+  (do macro.Monad<Meta>
+    [_ //.init-module-buffer
+     _ (//.save runtime)]
+    (//.save-module! artifact)))
diff --git a/lux-r/source/luxc/lang/translation/r/statement.jvm.lux b/lux-r/source/luxc/lang/translation/r/statement.jvm.lux
new file mode 100644
index 000000000..1798cb56d
--- /dev/null
+++ b/lux-r/source/luxc/lang/translation/r/statement.jvm.lux
@@ -0,0 +1,45 @@
+(.module:
+  lux
+  (lux (control [monad #+ do])
+       [macro]
+       (data text/format))
+  (luxc (lang [".L" module]
+              (host [r #+ Expression @@])))
+  [//]
+  (// [".T" runtime]
+      [".T" reference]
+      [".T" eval]))
+
+(def: #export (translate-def name expressionT expressionO metaV)
+  (-> Text Type Expression Code (Meta Any))
+  (do {@ macro.Monad<Meta>}
+    [current-module macro.current-module-name
+     #let [def-name [current-module name]]]
+    (case (macro.get-identifier-ann (name-of #.alias) metaV)
+      (#.Some real-def)
+      (do @
+        [[realT realA realV] (macro.find-def real-def)
+         _ (moduleL.define def-name [realT metaV realV])]
+        (wrap []))
+
+      _
+      (do @
+        [#let [def-name (referenceT.global def-name)]
+         _ (//.save (r.set! def-name expressionO))
+         expressionV (evalT.eval (@@ def-name))
+         _ (moduleL.define def-name [expressionT metaV expressionV])
+         _ (if (macro.type? metaV)
+             (case (macro.declared-tags metaV)
+               #.Nil
+               (wrap [])
+
+               tags
+               (moduleL.declare-tags tags (macro.export? metaV) (:coerce Type expressionV)))
+             (wrap []))
+         #let [_ (log! (format "DEF " (%name def-name)))]]
+        (wrap []))
+      )))
+
+(def: #export (translate-program programO)
+  (-> Expression (Meta Expression))
+  (macro.fail "translate-program NOT IMPLEMENTED YET"))
diff --git a/lux-r/source/luxc/lang/translation/r/structure.jvm.lux b/lux-r/source/luxc/lang/translation/r/structure.jvm.lux
new file mode 100644
index 000000000..cea8fcd59
--- /dev/null
+++ b/lux-r/source/luxc/lang/translation/r/structure.jvm.lux
@@ -0,0 +1,31 @@
+(.module:
+  lux
+  (lux (control [monad #+ do])
+       (data [text]
+             text/format)
+       [macro])
+  (luxc ["&" lang]
+        (lang [synthesis #+ Synthesis]
+              (host [r #+ Expression])))
+  [//]
+  (// [".T" runtime]))
+
+(def: #export (translate-tuple translate elemsS+)
+  (-> (-> Synthesis (Meta Expression)) (List Synthesis) (Meta Expression))
+  (case elemsS+
+    #.Nil
+    (:: macro.Monad<Meta> wrap runtimeT.unit)
+
+    (#.Cons singletonS #.Nil)
+    (translate singletonS)
+
+    _
+    (do {@ macro.Monad<Meta>}
+      [elemsT+ (monad.map @ translate elemsS+)]
+      (wrap (r.list elemsT+)))))
+
+(def: #export (translate-variant translate tag tail? valueS)
+  (-> (-> Synthesis (Meta Expression)) Nat Bit Synthesis (Meta Expression))
+  (do macro.Monad<Meta>
+    [valueT (translate valueS)]
+    (wrap (runtimeT.variant tag tail? valueT))))
diff --git a/lux-r/source/program.lux b/lux-r/source/program.lux
new file mode 100644
index 000000000..e2cf047e9
--- /dev/null
+++ b/lux-r/source/program.lux
@@ -0,0 +1,180 @@
+(.module:
+  [lux (#- Definition)
+   ["@" target]
+   ["." host (#+ import:)]
+   [abstract
+    [monad (#+ do)]]
+   [control
+    ["." io (#+ IO)]
+    ["." try (#+ Try)]
+    [parser
+     [cli (#+ program:)]]
+    [concurrency
+     ["." promise (#+ Promise)]]]
+   [data
+    ["." product]
+    [text
+     ["%" format (#+ format)]]
+    [collection
+     [array (#+ Array)]
+     ["." dictionary]]]
+   [world
+    ["." file]]
+   [target
+    [jvm
+     [bytecode (#+ Bytecode)]]]
+   [tool
+    [compiler
+     [default
+      ["." platform (#+ Platform)]]
+     [language
+      [lux
+       [analysis
+        ["." macro (#+ Expander)]]
+       [phase
+        [extension (#+ Phase Bundle Operation Handler Extender)
+         ["." analysis #_
+          ["#" jvm]]
+         ["." generation #_
+          ["#" jvm]]
+         ## ["." directive #_
+         ##  ["#" jvm]]
+         ]
+        [generation
+         ["." jvm #_
+          ## ["." runtime (#+ Anchor Definition)]
+          ["." packager]
+          ## ["#/." host]
+          ]]]]]]]]
+  [program
+   ["/" compositor
+    ["/." cli]
+    ["/." static]]]
+  [luxc
+   [lang
+    [host
+     ["_" jvm]]
+    ["." directive #_
+     ["#" jvm]]
+    [translation
+     ["." jvm
+      ["." runtime]
+      ["." expression]
+      ["#/." program]
+      ["translation" extension]]]]])
+
+(import: #long java/lang/reflect/Method
+  (invoke [java/lang/Object [java/lang/Object]] #try java/lang/Object))
+
+(import: #long (java/lang/Class c)
+  (getMethod [java/lang/String [(java/lang/Class java/lang/Object)]] #try java/lang/reflect/Method))
+
+(import: #long java/lang/Object
+  (getClass [] (java/lang/Class java/lang/Object)))
+
+(def: _object-class
+  (java/lang/Class java/lang/Object)
+  (host.class-for java/lang/Object))
+
+(def: _apply2-args
+  (Array (java/lang/Class java/lang/Object))
+  (|> (host.array (java/lang/Class java/lang/Object) 2)
+      (host.array-write 0 _object-class)
+      (host.array-write 1 _object-class)))
+
+(def: _apply4-args
+  (Array (java/lang/Class java/lang/Object))
+  (|> (host.array (java/lang/Class java/lang/Object) 4)
+      (host.array-write 0 _object-class)
+      (host.array-write 1 _object-class)
+      (host.array-write 2 _object-class)
+      (host.array-write 3 _object-class)))
+
+(def: #export (expander macro inputs lux)
+  Expander
+  (do try.monad
+    [apply-method (|> macro
+                      (:coerce java/lang/Object)
+                      (java/lang/Object::getClass)
+                      (java/lang/Class::getMethod "apply" _apply2-args))]
+    (:coerce (Try (Try [Lux (List Code)]))
+             (java/lang/reflect/Method::invoke
+              (:coerce java/lang/Object macro)
+              (|> (host.array java/lang/Object 2)
+                  (host.array-write 0 (:coerce java/lang/Object inputs))
+                  (host.array-write 1 (:coerce java/lang/Object lux)))
+              apply-method))))
+
+(def: #export platform
+  ## (IO (Platform Anchor (Bytecode Any) Definition))
+  (IO (Platform _.Anchor _.Inst _.Definition))
+  (do io.monad
+    [## host jvm/host.host
+     host jvm.host]
+    (wrap {#platform.&file-system (file.async file.system)
+           #platform.host host
+           ## #platform.phase jvm.generate
+           #platform.phase expression.translate
+           ## #platform.runtime runtime.generate
+           #platform.runtime runtime.translate
+           #platform.write product.right})))
+
+(def: extender
+  Extender
+  ## TODO: Stop relying on coercions ASAP.
+  (<| (:coerce Extender)
+      (function (@self handler))
+      (:coerce Handler)
+      (function (@self name phase))
+      (:coerce Phase)
+      (function (@self parameters))
+      (:coerce Operation)
+      (function (@self state))
+      (:coerce Try)
+      try.assume
+      (:coerce Try)
+      (do try.monad
+        [method (|> handler
+                    (:coerce java/lang/Object)
+                    (java/lang/Object::getClass)
+                    (java/lang/Class::getMethod "apply" _apply4-args))]
+        (java/lang/reflect/Method::invoke
+         (:coerce java/lang/Object handler)
+         (|> (host.array java/lang/Object 4)
+             (host.array-write 0 (:coerce java/lang/Object name))
+             (host.array-write 1 (:coerce java/lang/Object phase))
+             (host.array-write 2 (:coerce java/lang/Object parameters))
+             (host.array-write 3 (:coerce java/lang/Object state)))
+         method))))
+
+(def: (target service)
+  (-> /cli.Service /cli.Target)
+  (case service
+    (^or (#/cli.Compilation [sources libraries target module])
+         (#/cli.Interpretation [sources libraries target module])
+         (#/cli.Export [sources target]))
+    target))
+
+(def: (declare-success! _)
+  (-> Any (Promise Any))
+  (promise.future (io.exit +0)))
+
+(program: [{service /cli.service}]
+  (let [jar-path (format (..target service) (:: file.system separator) "program.jar")]
+    (exec (do promise.monad
+            [_ (/.compiler {#/static.host @.jvm
+                            #/static.host-module-extension ".jvm"
+                            #/static.target (..target service)
+                            #/static.artifact-extension ".class"}
+                           ..expander
+                           analysis.bundle
+                           ..platform
+                           ## generation.bundle
+                           translation.bundle
+                           (directive.bundle ..extender)
+                           jvm/program.program
+                           ..extender
+                           service
+                           [(packager.package jvm/program.class) jar-path])]
+            (..declare-success! []))
+      (io.io []))))
diff --git a/lux-r/source/test/program.lux b/lux-r/source/test/program.lux
new file mode 100644
index 000000000..270f9005d
--- /dev/null
+++ b/lux-r/source/test/program.lux
@@ -0,0 +1,18 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [control
+    ["." io]
+    [parser
+     [cli (#+ program:)]]]]
+  [spec
+   ["." compositor]]
+  {1
+   ["." /]})
+
+(program: args
+  (<| io.io
+      _.run!
+      ## (_.times 100)
+      (_.seed 1985013625126912890)
+      (compositor.spec /.jvm /.bundle /.expander /.program)))