16 files changed, 296 insertions, 0 deletions
diff --git a/new-luxc/source/luxc/lang/host/r.lux b/lux-r/source/luxc/lang/host/r.lux
index 6e4c7fb5b..6e4c7fb5b 100644
--- a/new-luxc/source/luxc/lang/host/r.lux
+++ b/lux-r/source/luxc/lang/host/r.lux
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/new-luxc/source/luxc/lang/translation/r.lux b/lux-r/source/luxc/lang/translation/r.lux
index a4a3db1f5..a4a3db1f5 100644
--- a/new-luxc/source/luxc/lang/translation/r.lux
+++ b/lux-r/source/luxc/lang/translation/r.lux
diff --git a/new-luxc/source/luxc/lang/translation/r/case.jvm.lux b/lux-r/source/luxc/lang/translation/r/case.jvm.lux
index 42460b620..42460b620 100644
--- a/new-luxc/source/luxc/lang/translation/r/case.jvm.lux
+++ b/lux-r/source/luxc/lang/translation/r/case.jvm.lux
diff --git a/new-luxc/source/luxc/lang/translation/r/expression.jvm.lux b/lux-r/source/luxc/lang/translation/r/expression.jvm.lux
index 3c41fbe63..3c41fbe63 100644
--- a/new-luxc/source/luxc/lang/translation/r/expression.jvm.lux
+++ b/lux-r/source/luxc/lang/translation/r/expression.jvm.lux
diff --git a/new-luxc/source/luxc/lang/translation/r/function.jvm.lux b/lux-r/source/luxc/lang/translation/r/function.jvm.lux
index f39a5e1a2..f39a5e1a2 100644
--- a/new-luxc/source/luxc/lang/translation/r/function.jvm.lux
+++ b/lux-r/source/luxc/lang/translation/r/function.jvm.lux
diff --git a/new-luxc/source/luxc/lang/translation/r/loop.jvm.lux b/lux-r/source/luxc/lang/translation/r/loop.jvm.lux
index f1197e5ce..f1197e5ce 100644
--- a/new-luxc/source/luxc/lang/translation/r/loop.jvm.lux
+++ b/lux-r/source/luxc/lang/translation/r/loop.jvm.lux
diff --git a/new-luxc/source/luxc/lang/translation/r/primitive.jvm.lux b/lux-r/source/luxc/lang/translation/r/primitive.jvm.lux
index 8bc7da848..8bc7da848 100644
--- a/new-luxc/source/luxc/lang/translation/r/primitive.jvm.lux
+++ b/lux-r/source/luxc/lang/translation/r/primitive.jvm.lux
diff --git a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux b/lux-r/source/luxc/lang/translation/r/procedure/common.jvm.lux
index 85ccd90dc..85ccd90dc 100644
--- a/new-luxc/source/luxc/lang/translation/r/procedure/common.jvm.lux
+++ b/lux-r/source/luxc/lang/translation/r/procedure/common.jvm.lux
diff --git a/new-luxc/source/luxc/lang/translation/r/procedure/host.jvm.lux b/lux-r/source/luxc/lang/translation/r/procedure/host.jvm.lux
index 3bd33955f..3bd33955f 100644
--- a/new-luxc/source/luxc/lang/translation/r/procedure/host.jvm.lux
+++ b/lux-r/source/luxc/lang/translation/r/procedure/host.jvm.lux
diff --git a/new-luxc/source/luxc/lang/translation/r/reference.jvm.lux b/lux-r/source/luxc/lang/translation/r/reference.jvm.lux
index 7de1c74ee..7de1c74ee 100644
--- a/new-luxc/source/luxc/lang/translation/r/reference.jvm.lux
+++ b/lux-r/source/luxc/lang/translation/r/reference.jvm.lux
diff --git a/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux b/lux-r/source/luxc/lang/translation/r/runtime.jvm.lux
index d641041d2..d641041d2 100644
--- a/new-luxc/source/luxc/lang/translation/r/runtime.jvm.lux
+++ b/lux-r/source/luxc/lang/translation/r/runtime.jvm.lux
diff --git a/new-luxc/source/luxc/lang/translation/r/statement.jvm.lux b/lux-r/source/luxc/lang/translation/r/statement.jvm.lux
index 1798cb56d..1798cb56d 100644
--- a/new-luxc/source/luxc/lang/translation/r/statement.jvm.lux
+++ b/lux-r/source/luxc/lang/translation/r/statement.jvm.lux
diff --git a/new-luxc/source/luxc/lang/translation/r/structure.jvm.lux b/lux-r/source/luxc/lang/translation/r/structure.jvm.lux
index cea8fcd59..cea8fcd59 100644
--- a/new-luxc/source/luxc/lang/translation/r/structure.jvm.lux
+++ b/lux-r/source/luxc/lang/translation/r/structure.jvm.lux
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)))