From eb59547eae1753c9aed1ee887e44c825c1b32c05 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Tue, 21 May 2019 19:51:14 -0400
Subject: WIP: Separate Scheme compiler.

---
 .gitignore                                         |   6 +
 commands                                           |  13 +-
 documentation/research/debugging.md                |   1 +
 lux-scheme/project.clj                             |  30 ++
 lux-scheme/source/program.lux                      | 355 +++++++++++++++++++++
 new-luxc/project.clj                               |   5 +-
 new-luxc/source/luxc/lang/translation/scheme.lux   | 214 -------------
 .../luxc/lang/translation/scheme/eval.jvm.lux      | 154 ---------
 .../luxc/lang/translation/scheme/statement.jvm.lux |  45 ---
 stdlib/source/lux/target/scheme.lux                | 112 ++++---
 .../tool/compiler/phase/generation/scheme/case.lux |  42 +--
 .../phase/generation/scheme/extension/common.lux   | 123 ++++---
 .../compiler/phase/generation/scheme/runtime.lux   | 133 +++-----
 .../compiler/phase/generation/scheme/structure.lux |   6 +-
 14 files changed, 590 insertions(+), 649 deletions(-)
 create mode 100644 lux-scheme/project.clj
 create mode 100644 lux-scheme/source/program.lux
 delete mode 100644 new-luxc/source/luxc/lang/translation/scheme.lux
 delete mode 100644 new-luxc/source/luxc/lang/translation/scheme/eval.jvm.lux
 delete mode 100644 new-luxc/source/luxc/lang/translation/scheme/statement.jvm.lux

diff --git a/.gitignore b/.gitignore
index 15b96b13d..ef15d6b25 100644
--- a/.gitignore
+++ b/.gitignore
@@ -57,3 +57,9 @@ pom.xml.asc
 /lux-cl/source/program
 /lux-cl/source/spec
 
+/lux-scheme/target
+/lux-scheme/source/lux.lux
+/lux-scheme/source/lux
+/lux-scheme/source/program
+/lux-scheme/source/spec
+
diff --git a/commands b/commands
index 84ccc9cc4..9e55eeec6 100644
--- a/commands
+++ b/commands
@@ -10,7 +10,8 @@ cd ~/lux/lux-python/ && lein clean && \
 cd ~/lux/lux-lua/ && lein clean && \
 cd ~/lux/lux-ruby/ && lein clean && \
 cd ~/lux/lux-php/ && lein clean && \
-cd ~/lux/lux-cl/ && lein clean
+cd ~/lux/lux-cl/ && lein clean && \
+cd ~/lux/lux-scheme/ && lein clean
 
 # Old Lux compiler
 	# Re-build and re-install
@@ -99,6 +100,16 @@ cd ~/lux/lux-cl/ && lein clean
 	# Try
 		cd ~/lux/lux-cl/ && java -jar target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux
 
+# Scheme compiler
+	# Test
+		cd ~/lux/lux-scheme/ && lein_2_7_1 lux auto test
+		cd ~/lux/lux-scheme/ && lein clean && lein_2_7_1 lux auto test
+	# Build
+		cd ~/lux/lux-scheme/ && lein_2_7_1 lux auto build
+		cd ~/lux/lux-scheme/ && lein clean && lein_2_7_1 lux auto build
+	# Try
+		cd ~/lux/lux-scheme/ && java -jar target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux
+
 # Run compiler test suite
 cd ~/lux/new-luxc/ && lein_2_7_1 lux auto test
 cd ~/lux/new-luxc/ && lein clean && lein_2_7_1 lux auto test
diff --git a/documentation/research/debugging.md b/documentation/research/debugging.md
index bd2074543..39fa3b51f 100644
--- a/documentation/research/debugging.md
+++ b/documentation/research/debugging.md
@@ -1,5 +1,6 @@
 # Tool
 
+1. https://github.com/srg-imperial/SaBRe
 1. https://developer.mozilla.org/en-US/docs/Mozilla/Projects/WebReplay
 1. https://umaar.github.io/performance-debugging-devtools-2018/#/
 1. https://microsoft.github.io/debug-adapter-protocol/
diff --git a/lux-scheme/project.clj b/lux-scheme/project.clj
new file mode 100644
index 000000000..b5f22536e
--- /dev/null
+++ b/lux-scheme/project.clj
@@ -0,0 +1,30 @@
+(def version "0.6.0-SNAPSHOT")
+(def repo "https://github.com/LuxLang/lux")
+(def sonatype-releases "https://oss.sonatype.org/service/local/staging/deploy/maven2/")
+(def sonatype-snapshots "https://oss.sonatype.org/content/repositories/snapshots/")
+
+(defproject com.github.luxlang/lux-scheme #=(identity version)
+  :description "A Scheme compiler for Lux."
+  :url ~repo
+  :license {:name "Lux License v0.1"
+            :url ~(str repo "/blob/master/license.txt")}
+  :scm {:name "git"
+        :url ~(str repo ".git")}
+  :pom-addition [:developers [:developer
+                              [:name "Eduardo Julian"]
+                              [:url "https://github.com/eduardoejp"]]]
+  
+  :repositories [["releases" ~sonatype-releases]
+                 ["snapshots" ~sonatype-snapshots]]
+  :deploy-repositories [["releases" {:url ~sonatype-releases :creds :gpg}]
+                        ["snapshots" {:url ~sonatype-snapshots :creds :gpg}]]
+  
+  :plugins [[com.github.luxlang/lein-luxc ~version]]
+  :dependencies [[com.github.luxlang/luxc-jvm ~version]
+                 [com.github.luxlang/stdlib ~version]
+                 [kawa-scheme/kawa-core "2.4"]]
+
+  :manifest {"lux" ~version}
+  :source-paths ["source"]
+  :lux {:program "program"}
+  )
diff --git a/lux-scheme/source/program.lux b/lux-scheme/source/program.lux
new file mode 100644
index 000000000..b4adddec9
--- /dev/null
+++ b/lux-scheme/source/program.lux
@@ -0,0 +1,355 @@
+(.module:
+  [lux #*
+   ["." debug]
+   ["." host (#+ import: interface: do-to object)]
+   [abstract
+    [monad (#+ do)]]
+   [control
+    ["." exception (#+ exception:)]
+    ["." io (#+ IO io)]
+    [parser
+     [cli (#+ program:)]]]
+   [data
+    ["." maybe]
+    ["." error (#+ Error)]
+    [number
+     ["." i64]]
+    ["." text ("#@." hash)
+     format]
+    [collection
+     ["." array (#+ Array)]]]
+   [macro
+    ["." template]]
+   [world
+    ["." file]]
+   [target
+    ["_" scheme]]
+   [tool
+    [compiler
+     ["." name]
+     ["." synthesis]
+     [phase
+      [macro (#+ Expander)]
+      ["." generation
+       ["." scheme
+        ["." runtime]
+        ["." extension]]]]
+     [default
+      ["." platform (#+ Platform)]]]]]
+  [program
+   ["/" compositor
+    ["/." cli]]])
+
+(import: #long java/lang/Boolean)
+(import: #long java/lang/String)
+
+(import: #long (java/lang/Class a))
+
+(import: #long java/lang/Object
+  (toString [] java/lang/String)
+  (getClass [] (java/lang/Class java/lang/Object)))
+
+(import: #long java/lang/Long
+  (intValue [] java/lang/Integer))
+
+(import: #long java/lang/Integer
+  (longValue [] java/lang/Long))
+
+(import: #long gnu/math/IntNum
+  (new #manual [int])
+  (longValue [] long))
+
+(import: #long gnu/math/DFloNum
+  (doubleValue [] double))
+
+(import: #long gnu/lists/FString
+  (toString [] String))
+
+(import: #long gnu/lists/Pair
+  (getCar [] java/lang/Object)
+  (getCdr [] java/lang/Object))
+
+(import: #long (gnu/lists/FVector E)
+  (getBufferLength [] int)
+  (getRaw [int] E))
+
+(import: #long gnu/expr/ModuleMethod
+  (apply2 [java/lang/Object java/lang/Object] #try java/lang/Object))
+
+(import: #long gnu/mapping/Environment)
+
+(import: #long gnu/expr/Language
+  (eval [java/lang/String] #try java/lang/Object))
+
+(import: #long kawa/standard/Scheme
+  (#static getR7rsInstance [] kawa/standard/Scheme))
+
+(def: (variant? value)
+  (-> Any Bit)
+  (case (host.check (Array java/lang/Object) (:coerce java/lang/Object value))
+    (#.Some array)
+    ## TODO: Get rid of this coercion ASAP.
+    (let [array (:coerce (Array java/lang/Object) array)]
+      (and (n/= 3 (array.size array))
+           (case (array.read 0 array)
+             (#.Some tag)
+             (case (host.check java/lang/Integer tag)
+               (#.Some _)
+               true
+
+               #.None
+               false)
+             
+             #.None
+             false)))
+    
+    #.None
+    false))
+
+(template [<name>]
+  [(interface: <name>
+     (getValue [] java/lang/Object))
+
+   (`` (import: #long (~~ (template.identifier ["program/" <name>]))
+         (getValue [] java/lang/Object)))]
+
+  [VariantValue]
+  [TupleValue]
+  )
+
+(def: (variant-value lux-value cdr? value)
+  (-> (-> java/lang/Object java/lang/Object) Bit (Array java/lang/Object) gnu/lists/Pair)
+  (object [] gnu/lists/Pair [program/VariantValue]
+    []
+    ## Methods
+    (program/VariantValue
+     (getValue self) java/lang/Object
+     (:coerce java/lang/Object value))
+    (gnu/lists/Pair
+     (getCar self) java/lang/Object
+     (if cdr?
+       (case (array.read 1 value)
+         (#.Some flag-is-set)
+         (:coerce java/lang/Object "")
+         
+         #.None
+         (host.null))
+       (|> value
+           (array.read 0)
+           maybe.assume
+           (:coerce java/lang/Integer)
+           gnu/math/IntNum::new)))
+    (gnu/lists/Pair
+     (getCdr self) java/lang/Object
+     (if cdr?
+       (|> value
+           (array.read 2)
+           maybe.assume
+           lux-value)
+       (variant-value lux-value true value)))))
+
+(def: (tuple-value lux-value value)
+  (-> (-> java/lang/Object java/lang/Object) (Array java/lang/Object) gnu/lists/FVector)
+  (object [] gnu/lists/SimpleVector [program/TupleValue]
+    []
+    ## Methods
+    (program/TupleValue
+     (getValue self) java/lang/Object
+     (:coerce java/lang/Object value))
+    (gnu/lists/SimpleVector
+     (getBufferLength self) int
+     (host.long-to-int (array.size value)))
+    (gnu/lists/SimpleVector
+     (getRaw self {idx int}) java/lang/Object
+     (|> value
+         (array.read (|> idx java/lang/Integer::longValue (:coerce Nat)))
+         maybe.assume
+         lux-value))
+    (gnu/lists/SimpleVector
+     (getBuffer self) java/lang/Object
+     (error! "tuple-value getBuffer"))
+    (gnu/lists/SimpleVector
+     (setBuffer self {_ java/lang/Object}) void
+     (error! "tuple-value setBuffer"))
+    (gnu/lists/SimpleVector
+     (clearBuffer self {_ int} {_ int}) void
+     (error! "tuple-value clearBuffer"))
+    (gnu/lists/SimpleVector
+     (copyBuffer self {_ int}) void
+     (error! "tuple-value copyBuffer"))
+    (gnu/lists/SimpleVector
+     (newInstance self {_ int}) gnu/lists/SimpleVector
+     (error! "tuple-value newInstance"))
+    ))
+
+(exception: (unknown-kind-of-host-object {object java/lang/Object})
+  (exception.report
+   ["Class" (java/lang/Object::toString (java/lang/Object::getClass object))]
+   ["Object" (java/lang/Object::toString object)]))
+
+(exception: (cannot-apply-a-non-function {object java/lang/Object})
+  (exception.report
+   ["Class" (java/lang/Object::toString (java/lang/Object::getClass object))]
+   ["Object" (java/lang/Object::toString object)]))
+
+(def: (lux-value value)
+  (-> java/lang/Object java/lang/Object)
+  (<| (case (host.check (Array java/lang/Object) value)
+        (#.Some value)
+        ## TODO: Get rid of the coercions below.
+        (if (variant? value)
+          (variant-value lux-value false (:coerce (Array java/lang/Object) value))
+          (tuple-value lux-value (:coerce (Array java/lang/Object) value)))
+        #.None)
+      value))
+
+(type: (Reader a)
+  (-> a (Error Any)))
+
+(def: (variant tag flag value)
+  (-> Nat Bit Any Any)
+  [(java/lang/Long::intValue (:coerce java/lang/Long tag))
+   (: Any
+      (if flag
+        synthesis.unit
+        (host.null)))
+   value])
+
+(def: (read-variant read host-object)
+  (-> (Reader java/lang/Object) (Reader gnu/lists/Pair))
+  (do error.monad
+    [tag (read (gnu/lists/Pair::getCar host-object))
+     #let [host-object (:coerce gnu/lists/Pair (gnu/lists/Pair::getCdr host-object))
+           flag (case (host.check java/lang/String (gnu/lists/Pair::getCar host-object))
+                  (#.Some _)
+                  true
+                  
+                  #.None
+                  false)]
+     value (read (gnu/lists/Pair::getCdr host-object))]
+    (wrap (..variant (:coerce Nat tag) flag value))))
+
+(def: (read-tuple read host-object)
+  (-> (Reader java/lang/Object) (Reader (gnu/lists/FVector java/lang/Object)))
+  (let [size (.nat (gnu/lists/FVector::getBufferLength host-object))]
+    (loop [idx 0
+           output (: (Array Any)
+                     (array.new size))]
+      (if (n/< size idx)
+        (case (read (gnu/lists/FVector::getRaw (.int idx) host-object))
+          (#error.Failure error)
+          (#error.Failure error)
+
+          (#error.Success lux-value)
+          (recur (inc idx) (array.write idx (: Any lux-value) output)))
+        (#error.Success output)))))
+
+(def: (read host-object)
+  (Reader java/lang/Object)
+  (`` (<| (~~ (template [<class>]
+                [(case (host.check <class> host-object)
+                   (#.Some host-object)
+                   (#error.Success host-object)
+                   #.None)]
+
+                [java/lang/Boolean] [java/lang/String] [gnu/expr/ModuleMethod]
+                ))
+          (~~ (template [<class> <method>]
+                [(case (host.check <class> host-object)
+                   (#.Some host-object)
+                   (#error.Success (<method> host-object))
+                   #.None)]
+
+                [gnu/math/IntNum gnu/math/IntNum::longValue]
+                [gnu/math/DFloNum gnu/math/DFloNum::doubleValue]
+                [gnu/lists/FString gnu/lists/FString::toString]
+                [program/VariantValue program/VariantValue::getValue]
+                [program/TupleValue program/TupleValue::getValue]
+                ))
+          (case (host.check gnu/lists/Pair host-object)
+            (#.Some host-object)
+            (read-variant read host-object)
+            #.None)
+          (case (host.check gnu/lists/FVector host-object)
+            (#.Some host-object)
+            (read-tuple read (:coerce (gnu/lists/FVector java/lang/Object) host-object))
+            #.None)
+          ## else
+          (exception.throw ..unknown-kind-of-host-object host-object))))
+
+(def: ensure-macro
+  (-> Macro (Maybe gnu/expr/ModuleMethod))
+  (|>> (:coerce java/lang/Object) (host.check gnu/expr/ModuleMethod)))
+
+(def: (expander macro inputs lux)
+  Expander
+  (case (ensure-macro macro)
+    (#.Some macro)
+    (case (gnu/expr/ModuleMethod::apply2 (lux-value (:coerce java/lang/Object inputs))
+                                         (lux-value (:coerce java/lang/Object lux))
+                                         macro)
+      (#error.Success output)
+      (|> output
+          ..read
+          (:coerce (Error (Error [Lux (List Code)]))))
+
+      (#error.Failure error)
+      (#error.Failure error))
+
+    #.None
+    (exception.throw ..cannot-apply-a-non-function (:coerce java/lang/Object macro)))
+  )
+
+(def: separator "$")
+
+(type: Host
+  (generation.Host _.Expression _.Expression))
+
+(def: host
+  (IO Host)
+  (io (let [interpreter (kawa/standard/Scheme::getR7rsInstance)
+            evaluate! (function (evaluate! alias input)
+                        (do error.monad
+                          [output (gnu/expr/Language::eval (_.code input) interpreter)]
+                          (read output)))]
+        (: Host
+           (structure
+            (def: evaluate! evaluate!)
+            (def: (execute! alias input)
+              (gnu/expr/Language::eval (_.code input) interpreter))
+            (def: (define! [module name] input)
+              (let [global (format (text.replace-all .module-separator ..separator module)
+                                   ..separator (name.normalize name)
+                                   "___" (%n (text@hash name)))
+                    @global (_.var global)]
+                (do error.monad
+                  [#let [definition (_.define-constant @global input)]
+                   _ (gnu/expr/Language::eval (_.code definition) interpreter)
+                   value (evaluate! global @global)]
+                  (wrap [global value definition])))))))))
+
+(def: platform
+  (IO (Platform IO _.Var _.Expression _.Expression))
+  (do io.monad
+    [host ..host]
+    (wrap {#platform.&monad io.monad
+           #platform.&file-system file.system
+           #platform.host host
+           #platform.phase scheme.generate
+           #platform.runtime runtime.generate})))
+
+(def: (program program)
+  (-> _.Expression _.Expression)
+  (_.apply/2 program
+             ## TODO: Figure out how to always get the command-line
+             ## arguments.
+             ## It appears that it differs between Scheme implementations.
+             (runtime.lux//program-args _.nil)
+             _.nil))
+
+(program: [{service /cli.service}]
+  (/.compiler ..expander
+              ..platform
+              extension.bundle
+              ..program
+              service))
diff --git a/new-luxc/project.clj b/new-luxc/project.clj
index 322800e29..cd74becbc 100644
--- a/new-luxc/project.clj
+++ b/new-luxc/project.clj
@@ -22,10 +22,7 @@
         :url ~(str repo ".git")}
 
   :dependencies [;; JVM Bytecode
-                 [org.ow2.asm/asm-all "5.0.3"]
-                 ;; ;; Scheme
-                 ;; [kawa-scheme/kawa-core "2.4"]
-                 ]
+                 [org.ow2.asm/asm-all "5.0.3"]]
   
   :manifest {"lux" ~version}
   :source-paths ["source"]
diff --git a/new-luxc/source/luxc/lang/translation/scheme.lux b/new-luxc/source/luxc/lang/translation/scheme.lux
deleted file mode 100644
index e509cb8ca..000000000
--- a/new-luxc/source/luxc/lang/translation/scheme.lux
+++ /dev/null
@@ -1,214 +0,0 @@
-(.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 [scheme #+ 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 (Array byte)))
-
-(host.import: java/lang/CharSequence)
-
-(host.import: java/lang/Appendable
-  (append [CharSequence] Appendable))
-
-(host.import: java/lang/StringBuilder
-  (new [])
-  (toString [] String))
-
-(host.import: gnu/mapping/Environment)
-
-(host.import: gnu/expr/Language
-  (eval [String] #try #? Object))
-
-(host.import: kawa/standard/Scheme
-  (#static getR7rsInstance [] Scheme))
-
-(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 (Scheme::getR7rsInstance [])]
-        {#context ["" +0]
-         #anchor #.None
-         #loader (function (_ code)
-                   (do e.Monad<Error>
-                     [_ (Language::eval [(scheme.expression code)] interpreter)]
-                     (wrap [])))
-         #interpreter (function (_ code)
-                        (do e.Monad<Error>
-                          [output (Language::eval [(scheme.expression code)] interpreter)]
-                          (wrap (maybe.default (:coerce Object [])
-                                               output))))
-         #module-buffer #.None
-         #program-buffer (StringBuilder::new [])})))
-
-(def: #export file-extension ".scm")
-
-(def: #export r-module-name Text (format "module" file-extension))
-
-(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 "lux-variant")
-
-(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 (scheme.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/new-luxc/source/luxc/lang/translation/scheme/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/scheme/eval.jvm.lux
deleted file mode 100644
index db9b25129..000000000
--- a/new-luxc/source/luxc/lang/translation/scheme/eval.jvm.lux
+++ /dev/null
@@ -1,154 +0,0 @@
-(.module:
-  lux
-  (lux (control ["ex" exception #+ exception:]
-                [monad #+ do])
-       (data [bit]
-             [maybe]
-             ["e" error #+ Error]
-             [text "text/" Eq<Text>]
-             text/format
-             (coll [array]))
-       [host])
-  (luxc [lang]
-        (lang (host [scheme #+ Expression])))
-  [//])
-
-(template [<name>]
-  [(exception: #export (<name> {message Text})
-     message)]
-
-  [Unknown-Kind-Of-Host-Object]
-  [Null-Has-No-Lux-Representation]
-  [Cannot-Evaluate]
-  [invalid-variant]
-  )
-
-(host.import: java/lang/Object
-  (toString [] String)
-  (getClass [] (Class Object)))
-
-(host.import: java/lang/Long
-  (intValue [] Integer))
-
-(host.import: java/lang/Boolean)
-(host.import: java/lang/String)
-
-(host.import: gnu/math/IntNum
-  (longValue [] long))
-
-(host.import: gnu/math/DFloNum
-  (doubleValue [] double))
-
-(host.import: (gnu/lists/FVector E)
-  (getBufferLength [] int)
-  (get [int] E))
-
-(host.import: gnu/lists/EmptyList)
-
-(host.import: gnu/lists/FString
-  (toString [] String))
-
-(host.import: gnu/lists/Pair
-  (getCar [] Object)
-  (getCdr [] Object)
-  (get [int] Object))
-
-(host.import: gnu/mapping/Symbol
-  (getName [] String))
-
-(host.import: gnu/mapping/SimpleSymbol)
-
-(def: (parse-tuple lux-object host-object)
-  (-> (-> Object (Error Any)) (FVector Object) (Error Any))
-  (let [size (:coerce Nat (FVector::getBufferLength [] host-object))]
-    (loop [idx +0
-           output (:coerce (Array Any) (array.new size))]
-      (if (n/< size idx)
-        (case (lux-object (FVector::get [(:coerce Int idx)] host-object))
-          (#e.Error error)
-          (#e.Error error)
-
-          (#e.Success lux-value)
-          (recur (inc idx) (array.write idx (:coerce Any lux-value) output)))
-        (#e.Success output)))))
-
-(def: (variant tag flag value)
-  (-> Nat Bit Any Any)
-  [(Long::intValue [] (:coerce Long tag))
-   (: Any
-      (if flag
-        //.unit
-        (host.null)))
-   value])
-
-(def: (to-text value)
-  (-> Any Text)
-  (let [value-text (:coerce Text (Object::toString [] (:coerce Object value)))
-        class-text (:coerce Text (Object::toString [] (Object::getClass [] (:coerce Object value))))]
-    (format value-text " : " class-text)))
-
-(def: (parse-variant lux-object host-object)
-  (-> (-> Object (Error Any)) Pair (Error Any))
-  (let [variant-tag (Pair::getCar [] host-object)]
-    (if (and (host.instance? gnu/mapping/SimpleSymbol variant-tag)
-             (text/= //.variant-tag (Symbol::getName [] (:coerce Symbol variant-tag))))
-      (do e.Monad<Error>
-        [#let [host-object (:coerce Pair (Pair::getCdr [] host-object))]
-         tag (lux-object (Pair::getCar [] host-object))
-         #let [host-object (:coerce Pair (Pair::getCdr [] host-object))]
-         #let [flag (host.instance? java/lang/String
-                                    (Pair::getCar [] host-object))]
-         value (lux-object (Pair::getCdr [] host-object))]
-        (wrap (..variant (:coerce Nat tag) flag value)))
-      (ex.throw invalid-variant (:coerce Text (Object::toString [] (:coerce Object host-object)))))))
-
-(def: (lux-object host-object)
-  (-> Object (Error Any))
-  (cond (or (host.instance? java/lang/Boolean host-object)
-            (host.instance? java/lang/String host-object))
-        (#e.Success host-object)
-
-        (host.instance? gnu/math/IntNum host-object)
-        (#e.Success (IntNum::longValue [] (:coerce IntNum host-object)))
-
-        (host.instance? gnu/math/DFloNum host-object)
-        (#e.Success (DFloNum::doubleValue [] (:coerce DFloNum host-object)))
-
-        (host.instance? gnu/lists/FString host-object)
-        (#e.Success (FString::toString [] (:coerce FString host-object)))
-
-        (host.instance? gnu/lists/FVector host-object)
-        (parse-tuple lux-object (:coerce (FVector Object) host-object))
-
-        (host.instance? gnu/lists/EmptyList host-object)
-        (#e.Success //.unit)
-
-        (host.instance? gnu/lists/Pair host-object)
-        (parse-variant lux-object (:coerce Pair host-object))
-
-        ## else
-        (let [object-class (:coerce Text (Object::toString [] (Object::getClass [] (:coerce Object host-object))))
-              text-representation (:coerce Text (Object::toString [] (:coerce Object host-object)))]
-          (ex.throw Unknown-Kind-Of-Host-Object (format object-class " --- " text-representation)))))
-
-(def: #export (eval code)
-  (-> Expression (Meta Any))
-  (function (_ compiler)
-    (let [interpreter (|> compiler (get@ #.host) (:coerce //.Host) (get@ #//.interpreter))]
-      (case (interpreter code)
-        (#e.Error error)
-        (exec (log! (format "eval #e.Error\n"
-                            "<< " (scheme.expression code) "\n"
-                            error))
-          ((lang.throw Cannot-Evaluate error) compiler))
-
-        (#e.Success output)
-        (case (lux-object output)
-          (#e.Success parsed-output)
-          (#e.Success [compiler parsed-output])
-
-          (#e.Error error)
-          (exec (log! (format "eval #e.Error\n"
-                              "<< " (scheme.expression code) "\n"
-                              error))
-            ((lang.throw Cannot-Evaluate error) compiler)))))))
diff --git a/new-luxc/source/luxc/lang/translation/scheme/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/scheme/statement.jvm.lux
deleted file mode 100644
index 755e8a898..000000000
--- a/new-luxc/source/luxc/lang/translation/scheme/statement.jvm.lux
+++ /dev/null
@@ -1,45 +0,0 @@
-(.module:
-  lux
-  (lux (control [monad #+ do])
-       [macro]
-       (data text/format))
-  (luxc (lang [".L" module]
-              (host ["_" scheme #+ 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 (_.define def-name (list) 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/stdlib/source/lux/target/scheme.lux b/stdlib/source/lux/target/scheme.lux
index 820ff8c83..886d2ba88 100644
--- a/stdlib/source/lux/target/scheme.lux
+++ b/stdlib/source/lux/target/scheme.lux
@@ -1,15 +1,14 @@
 (.module:
   [lux (#- Code int or and if function cond let)
    [control
-    [pipe (#+ new> cond> case>)]
-    ["." function]]
+    [pipe (#+ new> cond> case>)]]
    [data
     [number
      ["." frac]]
     ["." text
      format]
     [collection
-     ["." list ("#;." functor fold)]]]
+     ["." list ("#@." functor fold)]]]
    [macro
     ["." template]]
    [type
@@ -44,25 +43,25 @@
 
   (def: #export var (-> Text Var) (|>> :abstraction))
 
-  (def: (arguments [vars rest])
+  (def: (arguments [mandatory rest])
     (-> Arguments (Code Any))
     (case rest
       (#.Some rest)
-      (case vars
+      (case mandatory
         #.Nil
         rest
 
         _
         (|> (format " . " (:representation rest))
-            (format (|> vars
-                        (list;map ..code)
+            (format (|> mandatory
+                        (list@map ..code)
                         (text.join-with " ")))
             (text.enclose ["(" ")"])
             :abstraction))
       
       #.None
-      (|> vars
-          (list;map ..code)
+      (|> mandatory
+          (list@map ..code)
           (text.join-with " ")
           (text.enclose ["(" ")"])
           :abstraction)))
@@ -129,14 +128,15 @@
     (|>> :abstraction))
 
   (def: form
-    (-> (List (Code Any)) Text)
-    (|>> (list;map ..code)
+    (-> (List (Code Any)) Code)
+    (|>> (list@map ..code)
          (text.join-with " ")
-         (text.enclose ["(" ")"])))
+         (text.enclose ["(" ")"])
+         :abstraction))
   
   (def: #export (apply/* func args)
     (-> Expression (List Expression) Computation)
-    (:abstraction (..form (#.Cons func args))))
+    (..form (#.Cons func args)))
   
   (template [<name> <function>]
     [(def: #export <name>
@@ -193,7 +193,7 @@
      [[append/2 "append"]
       [cons/2 "cons"]
       [make-vector/2 "make-vector"]
-      [vector-ref/2 "vector-ref"]
+      ## [vector-ref/2 "vector-ref"]
       [list-tail/2 "list-tail"]
       [map/2 "map"]
       [string-ref/2 "string-ref"]
@@ -207,6 +207,23 @@
      [[vector-copy!/5 "vector-copy!"]]]
     )
 
+  ## TODO: define "vector-ref/2" like a normal apply/2 function.
+  ## "vector-ref/2" as an 'invoke' is problematic, since it only works
+  ## in Kawa.
+  ## However, the way Kawa defines "vector-ref" causes trouble,
+  ## because it does a runtime type-check which throws an error when
+  ## it checks against custom values/objects/classes made for
+  ## JVM<->Scheme interop.
+  ## There are 2 ways to deal with this:
+  ## 0. To fork Kawa, and get rid of the type-check so the normal
+  ## "vector-ref" can be used instead.
+  ## 1. To carry on, and then, when it's time to compile the compiler
+  ## itself into Scheme, switch from 'invoke' to normal 'vector-ref'.
+  ## Either way, the 'invoke' needs to go away.
+  (def: #export (vector-ref/2 vector index)
+    (-> Expression Expression Computation)
+    (..form (list (..var "invoke") vector (..symbol "getRaw") index)))
+
   (template [<lux-name> <scheme-name>]
     [(def: #export (<lux-name> param subject)
        (-> Expression Expression Computation)
@@ -238,7 +255,7 @@
   (template [<lux-name> <scheme-name>]
     [(def: #export <lux-name>
        (-> (List Expression) Computation)
-       (|>> (list& (..global <scheme-name>)) ..form :abstraction))]
+       (|>> (list& (..global <scheme-name>)) ..form))]
 
     [or "or"]
     [and "and"]
@@ -247,20 +264,17 @@
   (template [<lux-name> <scheme-name> <var> <pre>]
     [(def: #export (<lux-name> bindings body)
        (-> (List [<var> Expression]) Expression Computation)
-       (:abstraction
-        (..form (list (..global <scheme-name>)
-                      (|> bindings
-                          (list;map (.function (_ [binding/name binding/value])
-                                      (:abstraction
-                                       (..form (list (<pre> binding/name)
-                                                     binding/value)))))
-                          ..form
-                          :abstraction)
-                      body))))]
-
-    [let           "let"           Var       function.identity]
-    [let*          "let*"          Var       function.identity]
-    [letrec        "letrec"        Var       function.identity]
+       (..form (list (..global <scheme-name>)
+                     (|> bindings
+                         (list@map (.function (_ [binding/name binding/value])
+                                     (..form (list (|> binding/name <pre>)
+                                                   binding/value))))
+                         ..form)
+                     body)))]
+
+    [let           "let"           Var       (<|)]
+    [let*          "let*"          Var       (<|)]
+    [letrec        "letrec"        Var       (<|)]
     [let-values    "let-values"    Arguments ..arguments]
     [let*-values   "let*-values"   Arguments ..arguments]
     [letrec-values "letrec-values" Arguments ..arguments]
@@ -268,17 +282,15 @@
 
   (def: #export (if test then else)
     (-> Expression Expression Expression Computation)
-    (:abstraction
-     (..form (list (..global "if") test then else))))
+    (..form (list (..global "if") test then else)))
 
   (def: #export (when test then)
     (-> Expression Expression Computation)
-    (:abstraction
-     (..form (list (..global "when") test then))))
+    (..form (list (..global "when") test then)))
 
   (def: #export (cond clauses else)
     (-> (List [Expression Expression]) Expression Computation)
-    (|> (list;fold (.function (_ [test then] next)
+    (|> (list@fold (.function (_ [test then] next)
                      (if test then next))
                    else
                    (list.reverse clauses))
@@ -287,31 +299,31 @@
 
   (def: #export (lambda arguments body)
     (-> Arguments Expression Computation)
-    (:abstraction
-     (..form (list (..global "lambda")
-                   (..arguments arguments)
-                   body))))
+    (..form (list (..global "lambda")
+                  (..arguments arguments)
+                  body)))
 
-  (def: #export (define name arguments body)
+  (def: #export (define-function name arguments body)
     (-> Var Arguments Expression Computation)
-    (:abstraction
-     (..form (list (..global "define")
-                   (|> arguments
-                       (update@ #mandatory (|>> (#.Cons name)))
-                       ..arguments)
-                   body))))
+    (..form (list (..global "define")
+                  (|> arguments
+                      (update@ #mandatory (|>> (#.Cons name)))
+                      ..arguments)
+                  body)))
+
+  (def: #export (define-constant name value)
+    (-> Var Expression Computation)
+    (..form (list (..global "define") name value)))
 
   (def: #export begin
     (-> (List Expression) Computation)
-    (|>> (#.Cons (..global "begin")) ..form :abstraction))
+    (|>> (#.Cons (..global "begin")) ..form))
 
   (def: #export (set! name value)
     (-> Var Expression Computation)
-    (:abstraction
-     (..form (list (..global "set!") name value))))
+    (..form (list (..global "set!") name value)))
 
   (def: #export (with-exception-handler handler body)
     (-> Expression Expression Computation)
-    (:abstraction
-     (..form (list (..global "with-exception-handler") handler body))))
+    (..form (list (..global "with-exception-handler") handler body)))
   )
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/scheme/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/scheme/case.lux
index d4cd440fb..04d3bae1d 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/scheme/case.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/scheme/case.lux
@@ -9,7 +9,7 @@
     ["." text
      format]
     [collection
-     ["." list ("#;." functor fold)]]]
+     ["." list ("#@." functor fold)]]]
    [target
     ["_" scheme (#+ Expression Computation Var)]]]
   ["." // #_
@@ -17,7 +17,7 @@
    ["#." primitive]
    ["#/" // #_
     ["#." reference]
-    ["#/" // ("#;." monad)
+    ["#/" // ("#@." monad)
      ["#/" // #_
       [reference (#+ Register)]
       ["#." synthesis (#+ Synthesis Path)]]]]])
@@ -35,15 +35,18 @@
             bodyO))))
 
 (def: #export (record-get generate valueS pathP)
-  (-> Phase Synthesis (List [Nat Bit])
+  (-> Phase Synthesis (List (Either Nat Nat))
       (Operation Expression))
   (do ////.monad
     [valueO (generate valueS)]
-    (wrap (list;fold (function (_ [idx tail?] source)
-                       (.let [method (.if tail?
-                                       //runtime.product//right
-                                       //runtime.product//left)]
-                         (method source (_.int (.int idx)))))
+    (wrap (list@fold (function (_ side source)
+                       (.let [method (.case side
+                                       (^template [<side> <accessor>]
+                                         (<side> lefts)
+                                         (<accessor> (_.int (.int lefts))))
+                                       ([#.Left  //runtime.tuple//left]
+                                        [#.Right //runtime.tuple//right]))]
+                         (method source)))
                      valueO
                      pathP))))
 
@@ -98,9 +101,9 @@
 (def: (pm-catch handler)
   (-> Expression Computation)
   (_.lambda [(list @alt-error) #.None]
-            (_.if (|> @alt-error (_.eqv?/2 pm-error))
-              handler
-              (_.raise/1 @alt-error))))
+       (_.if (|> @alt-error (_.eqv?/2 pm-error))
+         handler
+         (_.raise/1 @alt-error))))
 
 (def: (pattern-matching' generate pathP)
   (-> Phase Path (Operation Expression))
@@ -109,15 +112,14 @@
     (generate bodyS)
 
     #/////synthesis.Pop
-    (////;wrap pop-cursor!)
+    (////@wrap pop-cursor!)
 
     (#/////synthesis.Bind register)
-    (////;wrap (_.define (..register register) [(list) #.None]
-                         cursor-top))
+    (////@wrap (_.define-constant (..register register) ..cursor-top))
 
     (^template [<tag> <format> <=>]
       (^ (<tag> value))
-      (////;wrap (_.when (|> value <format> (<=> cursor-top) _.not/1)
+      (////@wrap (_.when (|> value <format> (<=> cursor-top) _.not/1)
                          fail-pm!)))
     ([/////synthesis.path/bit  //primitive.bit           _.eqv?/2]
      [/////synthesis.path/i64  (<| //primitive.i64 .int) _.=/2]
@@ -126,18 +128,18 @@
 
     (^template [<pm> <flag> <prep>]
       (^ (<pm> idx))
-      (////;wrap (_.let (list [@temp (|> idx <prep> .int _.int (//runtime.sum//get cursor-top <flag>))])
+      (////@wrap (_.let (list [@temp (|> idx <prep> .int _.int (//runtime.sum//get cursor-top <flag>))])
                    (_.if (_.null?/1 @temp)
                      fail-pm!
                      (push-cursor! @temp)))))
     ([/////synthesis.side/left  _.nil         (<|)]
      [/////synthesis.side/right (_.string "") inc])
 
-    (^template [<pm> <getter> <prep>]
+    (^template [<pm> <getter>]
       (^ (<pm> idx))
-      (////;wrap (|> idx <prep> .int _.int (<getter> cursor-top) push-cursor!)))
-    ([/////synthesis.member/left  //runtime.product//left  (<|)]
-     [/////synthesis.member/right //runtime.product//right inc])
+      (////@wrap (push-cursor! (<getter> (_.int (.int idx)) cursor-top))))
+    ([/////synthesis.member/left  //runtime.tuple//left]
+     [/////synthesis.member/right //runtime.tuple//right])
 
     (^template [<tag> <computation>]
       (^ (<tag> leftP rightP))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/scheme/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/scheme/extension/common.lux
index f33cb9599..6701bc078 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/scheme/extension/common.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/scheme/extension/common.lux
@@ -82,36 +82,24 @@
      Binary
      (<op> paramO subjectO))]
   
-  [bit::and _.bit-and/2]
-  [bit::or  _.bit-or/2]
-  [bit::xor _.bit-xor/2]
+  [i64::and _.bit-and/2]
+  [i64::or  _.bit-or/2]
+  [i64::xor _.bit-xor/2]
   )
 
-(def: (bit::left-shift [subjectO paramO])
+(def: (i64::left-shift [subjectO paramO])
   Binary
   (_.arithmetic-shift/2 (_.remainder/2 (_.int +64) paramO)
                         subjectO))
 
-(def: (bit::arithmetic-right-shift [subjectO paramO])
+(def: (i64::arithmetic-right-shift [subjectO paramO])
   Binary
   (_.arithmetic-shift/2 (|> paramO (_.remainder/2 (_.int +64)) (_.*/2 (_.int -1)))
                         subjectO))
 
-(def: (bit::logical-right-shift [subjectO paramO])
+(def: (i64::logical-right-shift [subjectO paramO])
   Binary
-  (///runtime.bit//logical-right-shift (_.remainder/2 (_.int +64) paramO) subjectO))
-
-(def: bundle::bit
-  Bundle
-  (<| (bundle.prefix "bit")
-      (|> bundle.empty
-          (bundle.install "and" (binary bit::and))
-          (bundle.install "or" (binary bit::or))
-          (bundle.install "xor" (binary bit::xor))
-          (bundle.install "left-shift" (binary bit::left-shift))
-          (bundle.install "logical-right-shift" (binary bit::logical-right-shift))
-          (bundle.install "arithmetic-right-shift" (binary bit::arithmetic-right-shift))
-          )))
+  (///runtime.i64//logical-right-shift (_.remainder/2 (_.int +64) paramO) subjectO))
 
 (import: java/lang/Double
   (#static MIN_VALUE Double)
@@ -122,9 +110,9 @@
      Nullary
      (<encode> <const>))]
 
-  [frac::smallest (Double::MIN_VALUE)            _.float]
-  [frac::min      (f/* -1.0 (Double::MAX_VALUE)) _.float]
-  [frac::max      (Double::MAX_VALUE)            _.float]
+  [f64::smallest (Double::MIN_VALUE)            _.float]
+  [f64::min      (f/* -1.0 (Double::MAX_VALUE)) _.float]
+  [f64::max      (Double::MAX_VALUE)            _.float]
   )
 
 (template [<name> <op>]
@@ -132,11 +120,11 @@
      Binary
      (|> subjectO (<op> paramO)))]
 
-  [int::+ _.+/2]
-  [int::- _.-/2]
-  [int::* _.*/2]
-  [int::/ _.quotient/2]
-  [int::% _.remainder/2]
+  [i64::+ _.+/2]
+  [i64::- _.-/2]
+  [i64::* _.*/2]
+  [i64::/ _.quotient/2]
+  [i64::% _.remainder/2]
   )
 
 (template [<name> <op>]
@@ -144,13 +132,13 @@
      Binary
      (<op> paramO subjectO))]
 
-  [frac::+ _.+/2]
-  [frac::- _.-/2]
-  [frac::* _.*/2]
-  [frac::/ _.//2]
-  [frac::% _.mod/2]
-  [frac::= _.=/2]
-  [frac::< _.</2]
+  [f64::+ _.+/2]
+  [f64::- _.-/2]
+  [f64::* _.*/2]
+  [f64::/ _.//2]
+  [f64::% _.mod/2]
+  [f64::= _.=/2]
+  [f64::< _.</2]
 
   [text::= _.string=?/2]
   [text::< _.string<?/2]
@@ -161,41 +149,47 @@
      Binary
      (<cmp> paramO subjectO))]
 
-  [int::= _.=/2]
-  [int::< _.</2]
+  [i64::= _.=/2]
+  [i64::< _.</2]
   )
 
-(def: int::char (|>> _.integer->char/1 _.string/1))
+(def: i64::char (|>> _.integer->char/1 _.string/1))
 
-(def: bundle::int
+(def: bundle::i64
   Bundle
-  (<| (bundle.prefix "int")
+  (<| (bundle.prefix "i64")
       (|> bundle.empty
-          (bundle.install "+" (binary int::+))
-          (bundle.install "-" (binary int::-))
-          (bundle.install "*" (binary int::*))
-          (bundle.install "/" (binary int::/))
-          (bundle.install "%" (binary int::%))
-          (bundle.install "=" (binary int::=))
-          (bundle.install "<" (binary int::<))
-          (bundle.install "to-frac" (unary (|>> (_.//2 (_.float +1.0)))))
-          (bundle.install "char" (unary int::char)))))
-
-(def: bundle::frac
+          (bundle.install "and" (binary i64::and))
+          (bundle.install "or" (binary i64::or))
+          (bundle.install "xor" (binary i64::xor))
+          (bundle.install "left-shift" (binary i64::left-shift))
+          (bundle.install "logical-right-shift" (binary i64::logical-right-shift))
+          (bundle.install "arithmetic-right-shift" (binary i64::arithmetic-right-shift))
+          (bundle.install "+" (binary i64::+))
+          (bundle.install "-" (binary i64::-))
+          (bundle.install "*" (binary i64::*))
+          (bundle.install "/" (binary i64::/))
+          (bundle.install "%" (binary i64::%))
+          (bundle.install "=" (binary i64::=))
+          (bundle.install "<" (binary i64::<))
+          (bundle.install "f64" (unary (|>> (_.//2 (_.float +1.0)))))
+          (bundle.install "char" (unary i64::char)))))
+
+(def: bundle::f64
   Bundle
-  (<| (bundle.prefix "frac")
+  (<| (bundle.prefix "f64")
       (|> bundle.empty
-          (bundle.install "+" (binary frac::+))
-          (bundle.install "-" (binary frac::-))
-          (bundle.install "*" (binary frac::*))
-          (bundle.install "/" (binary frac::/))
-          (bundle.install "%" (binary frac::%))
-          (bundle.install "=" (binary frac::=))
-          (bundle.install "<" (binary frac::<))
-          (bundle.install "smallest" (nullary frac::smallest))
-          (bundle.install "min" (nullary frac::min))
-          (bundle.install "max" (nullary frac::max))
-          (bundle.install "to-int" (unary _.exact/1))
+          (bundle.install "+" (binary f64::+))
+          (bundle.install "-" (binary f64::-))
+          (bundle.install "*" (binary f64::*))
+          (bundle.install "/" (binary f64::/))
+          (bundle.install "%" (binary f64::%))
+          (bundle.install "=" (binary f64::=))
+          (bundle.install "<" (binary f64::<))
+          (bundle.install "smallest" (nullary f64::smallest))
+          (bundle.install "min" (nullary f64::min))
+          (bundle.install "max" (nullary f64::max))
+          (bundle.install "i64" (unary _.exact/1))
           (bundle.install "encode" (unary _.number->string/1))
           (bundle.install "decode" (unary ///runtime.frac//decode)))))
 
@@ -240,9 +234,8 @@
   Bundle
   (<| (bundle.prefix "lux")
       (|> bundle::lux
-          (dict.merge bundle::bit)
-          (dict.merge bundle::int)
-          (dict.merge bundle::frac)
+          (dict.merge bundle::i64)
+          (dict.merge bundle::f64)
           (dict.merge bundle::text)
           (dict.merge bundle::io)
           )))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/scheme/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/scheme/runtime.lux
index 3fe02a55d..94269b4aa 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/scheme/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/scheme/runtime.lux
@@ -38,8 +38,6 @@
 
 (def: unit (_.string /////synthesis.unit))
 
-(def: #export variant-tag "lux-variant")
-
 (def: (flag value)
   (-> Bit Computation)
   (if value
@@ -48,8 +46,7 @@
 
 (def: (variant' tag last? value)
   (-> Expression Expression Expression Computation)
-  (<| (_.cons/2 (_.symbol ..variant-tag))
-      (_.cons/2 tag)
+  (<| (_.cons/2 tag)
       (_.cons/2 last?)
       value))
 
@@ -102,15 +99,15 @@
                      _.Computation
                      (~ (case argsC+
                           #.Nil
-                          (` (_.define (~ @runtime) [(list) #.None] (~ definition)))
+                          (` (_.define-constant (~ @runtime) [(list) #.None] (~ definition)))
 
                           _
                           (` (let [(~+ (|> (list.zip2 argsC+ argsLC+)
                                            (list;map (function (_ [left right])
                                                        (list left right)))
                                            list;join))]
-                               (_.define (~ @runtime) [(list (~+ argsLC+)) #.None]
-                                         (~ definition))))))))))))
+                               (_.define-function (~ @runtime) [(list (~+ argsLC+)) #.None]
+                                                  (~ definition))))))))))))
 
 (runtime: (slice offset length list)
   (<| (_.if (_.null?/1 list)
@@ -156,58 +153,40 @@
   (_.begin (list @@lux//try
                  @@lux//program-args)))
 
-(def: minimum-index-length
-  (-> Expression Computation)
-  (|>> (_.+/2 (_.int +1))))
-
-(def: product-element
-  (-> Expression Expression Computation)
-  (function.flip _.vector-ref/2))
-
-(def: (product-tail product)
+(def: last-index
   (-> Expression Computation)
-  (_.vector-ref/2 product (|> (_.length/1 product) (_.-/2 (_.int +1)))))
+  (|>> _.length/1 (_.-/2 (_.int +1))))
 
-(def: (updated-index min-length product)
-  (-> Expression Expression Computation)
-  (|> min-length (_.-/2 (_.length/1 product))))
-
-(runtime: (product//left product index)
-  (let [@index_min_length (_.var "index_min_length")]
+(runtime: (tuple//left lefts tuple)
+  (with-vars [last-index-right]
     (_.begin
-     (list (_.define @index_min_length [(list) #.None]
-                     (minimum-index-length index))
-           (_.if (|> product _.length/1 (_.>/2 @index_min_length))
+     (list (_.define-constant last-index-right (..last-index tuple))
+           (_.if (_.>/2 lefts last-index-right)
              ## No need for recursion
-             (product-element index product)
+             (_.vector-ref/2 tuple lefts)
              ## Needs recursion
-             (product//left (product-tail product)
-                            (updated-index @index_min_length product)))))))
-
-(runtime: (product//right product index)
-  (let [@index_min_length (_.var "index_min_length")
-        @product_length (_.var "product_length")
-        @slice (_.var "slice")
-        last-element? (|> @product_length (_.=/2 @index_min_length))
-        needs-recursion? (|> @product_length (_.</2 @index_min_length))]
+             (tuple//left (_.-/2 last-index-right lefts)
+                          (_.vector-ref/2 tuple last-index-right)))))))
+
+(runtime: (tuple//right lefts tuple)
+  (with-vars [last-index-right right-index @slice]
     (_.begin
-     (list
-      (_.define @index_min_length [(list) #.None] (minimum-index-length index))
-      (_.define @product_length [(list) #.None] (_.length/1 product))
-      (<| (_.if last-element?
-            (product-element index product))
-          (_.if needs-recursion?
-            (product//right (product-tail product)
-                            (updated-index @index_min_length product)))
-          ## Must slice
-          (_.begin
-           (list (_.define @slice [(list) #.None]
-                           (_.make-vector/1 (|> @product_length (_.-/2 index))))
-                 (_.vector-copy!/5 @slice (_.int +0) product index @product_length)
-                 @slice)))))))
+     (list (_.define-constant last-index-right (..last-index tuple))
+           (_.define-constant right-index (_.+/2 (_.int +1) lefts))
+           (_.cond (list [(_.=/2 right-index last-index-right)
+                          (_.vector-ref/2 tuple right-index)]
+                         [(_.>/2 right-index last-index-right)
+                          ## Needs recursion.
+                          (tuple//right (_.-/2 last-index-right lefts)
+                                        (_.vector-ref/2 tuple last-index-right))])
+                   (_.begin
+                    (list (_.define-constant @slice (_.make-vector/1 (_.-/2 right-index (_.length/1 tuple))))
+                          (_.vector-copy!/5 @slice (_.int +0) tuple right-index (_.length/1 tuple))
+                          @slice))))
+     )))
 
 (runtime: (sum//get sum last? wanted-tag)
-  (with-vars [variant-tag sum-tag sum-flag sum-value]
+  (with-vars [sum-tag sum-flag sum-value]
     (let [no-match _.nil
           is-last? (|> sum-flag (_.eqv?/2 (_.string "")))
           test-recursion (_.if is-last?
@@ -216,8 +195,10 @@
                                      (|> wanted-tag (_.-/2 sum-tag))
                                      last?)
                            no-match)]
-      (<| (_.let-values (list [[(list variant-tag sum-tag sum-flag sum-value) #.None]
-                               (_.apply/* (_.global "apply") (list (_.global "values") sum))]))
+      (<| (_.let (list [sum-tag (_.car/1 sum)]
+                       [sum-value (_.cdr/1 sum)]))
+          (_.let (list [sum-flag (_.car/1 sum-value)]
+                       [sum-value (_.cdr/1 sum-value)]))
           (_.if (|> wanted-tag (_.=/2 sum-tag))
             (_.if (|> sum-flag (_.eqv?/2 last?))
               sum-value
@@ -231,11 +212,11 @@
 
 (def: runtime//adt
   Computation
-  (_.begin (list @@product//left
-                 @@product//right
+  (_.begin (list @@tuple//left
+                 @@tuple//right
                  @@sum//get)))
 
-(runtime: (bit//logical-right-shift shift input)
+(runtime: (i64//logical-right-shift shift input)
   (_.if (_.=/2 (_.int +0) shift)
     input
     (|> input
@@ -244,7 +225,7 @@
 
 (def: runtime//bit
   Computation
-  (_.begin (list @@bit//logical-right-shift)))
+  (_.begin (list @@i64//logical-right-shift)))
 
 (runtime: (frac//decode input)
   (with-vars [@output]
@@ -259,42 +240,6 @@
   (_.begin
    (list @@frac//decode)))
 
-(def: (check-index-out-of-bounds array idx body)
-  (-> Expression Expression Expression Computation)
-  (_.if (|> idx (_.<=/2 (_.length/1 array)))
-    body
-    (_.raise/1 (_.string "Array index out of bounds!"))))
-
-(runtime: (array//get array idx)
-  (with-vars [@temp]
-    (<| (check-index-out-of-bounds array idx)
-        (_.let (list [@temp (_.vector-ref/2 array idx)])
-          (_.if (|> @temp (_.eqv?/2 _.nil))
-            ..none
-            (..some @temp))))))
-
-(runtime: (array//put array idx value)
-  (<| (check-index-out-of-bounds array idx)
-      (_.begin
-       (list (_.vector-set!/3 array idx value)
-             array))))
-
-(def: runtime//array
-  Computation
-  (_.begin
-   (list @@array//get
-         @@array//put)))
-
-(runtime: (box//write value box)
-  (_.begin
-   (list
-    (_.vector-set!/3 box (_.int +0) value)
-    ..unit)))
-
-(def: runtime//box
-  Computation
-  (_.begin (list @@box//write)))
-
 (runtime: (io//current-time _)
   (|> (_.apply/* (_.global "current-second") (list))
       (_.*/2 (_.int +1,000))
@@ -310,8 +255,6 @@
                  runtime//bit
                  runtime//adt
                  runtime//frac
-                 runtime//array
-                 runtime//box
                  runtime//io
                  )))
 
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/scheme/structure.lux b/stdlib/source/lux/tool/compiler/phase/generation/scheme/structure.lux
index e101effeb..f435442cc 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/scheme/structure.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/scheme/structure.lux
@@ -30,4 +30,8 @@
   (-> Phase (Variant Synthesis) (Operation Expression))
   (do ///.monad
     [valueT (generate valueS)]
-    (wrap (runtime.variant [lefts right? valueT]))))
+    (wrap (runtime.variant [(if right?
+                              (inc lefts)
+                              lefts)
+                            right?
+                            valueT]))))
-- 
cgit v1.2.3