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.

---
 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 +-
 5 files changed, 185 insertions(+), 231 deletions(-)

(limited to 'stdlib/source')

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