Implemented an optimization for getting fields/slots from records in the new compiler.

7 files changed, 65 insertions, 28 deletions

diff --git a/lux-jvm/source/luxc/lang/host/jvm.lux b/lux-jvm/source/luxc/lang/host/jvm.lux
index d957bdb1d..841b6a2a9 100644
--- a/lux-jvm/source/luxc/lang/host/jvm.lux
+++ b/lux-jvm/source/luxc/lang/host/jvm.lux
@@ -19,7 +19,8 @@
       [category (#+ Class)]]]]
    [tool
     [compiler
-     [reference (#+ Register)]
+     [reference
+      [variable (#+ Register)]]
      [language
       [lux
        ["." generation]]]
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/case.lux b/lux-jvm/source/luxc/lang/translation/jvm/case.lux
index 0d8aaa91e..23f84ad4e 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/case.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/case.lux
@@ -7,7 +7,9 @@
     ["ex" exception (#+ exception:)]]
    [data
     [number
-     ["n" nat]]]
+     ["n" nat]]
+    [collection
+     ["." list ("#@." fold)]]]
    [target
     [jvm
      ["." type (#+ Type)
@@ -21,7 +23,8 @@
       [archive (#+ Archive)]]
      [language
       [lux
-       ["." synthesis (#+ Path Synthesis)]]]]]]
+       ["." synthesis (#+ Path Synthesis)
+        ["#/." case]]]]]]]
   [luxc
    [lang
     [host
@@ -55,6 +58,24 @@
        _.AALOAD
        (_.CHECKCAST runtime.$Stack)))
 
+(def: (left-projection lefts)
+  (-> Nat Inst)
+  (.let [accessI (.case lefts
+                   0
+                   _.AALOAD
+                   
+                   lefts
+                   (_.INVOKESTATIC //.$Runtime "tuple_left" (type.method [(list //.$Tuple runtime.$Index) //.$Value (list)])))]
+    (|>> (_.CHECKCAST //.$Tuple)
+         (_.int (.int lefts))
+         accessI)))
+
+(def: (right-projection lefts)
+  (-> Nat Inst)
+  (|>> (_.CHECKCAST //.$Tuple)
+       (_.int (.int lefts))
+       (_.INVOKESTATIC //.$Runtime "tuple_right" (type.method [(list //.$Tuple runtime.$Index) //.$Value (list)]))))
+
 (def: (path' stack-depth @else @end phase archive path)
   (-> Nat Label Label Phase Archive Path (Operation Inst))
   (.case path
@@ -121,23 +142,13 @@
      [synthesis.side/right (_.string "") .inc])
 
     (^ (synthesis.member/left lefts))
-    (operation@wrap (.let [accessI (.case lefts
-                                     0
-                                     _.AALOAD
-                                     
-                                     lefts
-                                     (_.INVOKESTATIC //.$Runtime "tuple_left" (type.method [(list //.$Tuple runtime.$Index) //.$Value (list)])))]
-                      (|>> peekI
-                           (_.CHECKCAST //.$Tuple)
-                           (_.int (.int lefts))
-                           accessI
-                           pushI)))
+    (operation@wrap (|>> peekI
+                         (..left-projection lefts)
+                         pushI))
 
     (^ (synthesis.member/right lefts))
     (operation@wrap (|>> peekI
-                         (_.CHECKCAST //.$Tuple)
-                         (_.int (.int lefts))
-                         (_.INVOKESTATIC //.$Runtime "tuple_right" (type.method [(list //.$Tuple runtime.$Index) //.$Value (list)]))
+                         (..right-projection lefts)
                          pushI))
 
     ## Extra optimization
@@ -226,6 +237,21 @@
                (_.ASTORE register)
                exprI))))
 
+(def: #export (get phase archive [path recordS])
+  (Generator [(List synthesis.Member) Synthesis])
+  (do phase.monad
+    [recordG (phase archive recordS)]
+    (wrap (list@fold (function (_ step so-far)
+                       (.let [next (.case step
+                                     (#.Left lefts)
+                                     (..left-projection lefts)
+                                     
+                                     (#.Right lefts)
+                                     (..right-projection lefts))]
+                         (|>> so-far next)))
+                     recordG
+                     path))))
+
 (def: #export (case phase archive [valueS path])
   (Generator [Synthesis Path])
   (do phase.monad
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/expression.lux b/lux-jvm/source/luxc/lang/translation/jvm/expression.lux
index 144e35f9b..01425750f 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/expression.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/expression.lux
@@ -53,6 +53,9 @@
     (^ (synthesis.branch/if data))
     (case.if translate archive data)
 
+    (^ (synthesis.branch/get data))
+    (case.get translate archive data)
+
     (^ (synthesis.branch/case data))
     (case.case translate archive data)
 
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux
index 7b90a8e4f..482521e34 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux
@@ -30,8 +30,9 @@
       ["." parser]]]]
    [tool
     [compiler
-     ["." reference (#+ Variable)]
      ["." phase ("#@." monad)]
+     [reference (#+)
+      ["." variable (#+ Variable)]]
      [meta
       [archive (#+ Archive)]]
      [language
@@ -864,6 +865,9 @@
       (^ (synthesis.branch/if [testS thenS elseS]))
       (synthesis.branch/if [(recur testS) (recur thenS) (recur elseS)])
 
+      (^ (synthesis.branch/get [path recordS]))
+      (synthesis.branch/get [path (recur recordS)])
+
       (^ (synthesis.loop/scope [offset initsS+ bodyS]))
       (synthesis.loop/scope [offset (list@map recur initsS+) (recur bodyS)])
 
@@ -969,14 +973,14 @@
                                      ## Combine them.
                                      list@join
                                      ## Remove duplicates.
-                                     (set.from-list reference.hash)
+                                     (set.from-list variable.hash)
                                      set.to-list)
                global-mapping (|> total-environment
                                   ## Give them names as "foreign" variables.
                                   list.enumerate
                                   (list@map (function (_ [id capture])
-                                              [capture (#reference.Foreign id)]))
-                                  (dictionary.from-list reference.hash))
+                                              [capture (#variable.Foreign id)]))
+                                  (dictionary.from-list variable.hash))
                normalized-methods (list@map (function (_ [environment
                                                           [ownerT name
                                                            strict-fp? annotations vars
@@ -985,11 +989,11 @@
                                               (let [local-mapping (|> environment
                                                                       list.enumerate
                                                                       (list@map (function (_ [foreign-id capture])
-                                                                                  [(#reference.Foreign foreign-id)
+                                                                                  [(#variable.Foreign foreign-id)
                                                                                    (|> global-mapping
                                                                                        (dictionary.get capture)
                                                                                        maybe.assume)]))
-                                                                      (dictionary.from-list reference.hash))]
+                                                                      (dictionary.from-list variable.hash))]
                                                 [ownerT name
                                                  strict-fp? annotations vars
                                                  self-name arguments returnT exceptionsT
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/function.lux b/lux-jvm/source/luxc/lang/translation/jvm/function.lux
index 888ad9545..bfa11f1c2 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/function.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/function.lux
@@ -21,8 +21,9 @@
    [tool
     [compiler
      [arity (#+ Arity)]
-     [reference (#+ Register)]
      ["." phase]
+     [reference
+      [variable (#+ Register)]]
      [language
       [lux
        [analysis (#+ Environment)]
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/loop.lux b/lux-jvm/source/luxc/lang/translation/jvm/loop.lux
index 1f2168fed..10fb23cbd 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/loop.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/loop.lux
@@ -11,8 +11,9 @@
      ["." list ("#/." functor monoid)]]]
    [tool
     [compiler
-     [reference (#+ Register)]
      ["." phase]
+     [reference
+      [variable (#+ Register)]]
      [language
       [lux
        ["." synthesis (#+ Synthesis)]
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/reference.lux b/lux-jvm/source/luxc/lang/translation/jvm/reference.lux
index 6bcf4a2e5..61eac8dcc 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/reference.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/reference.lux
@@ -10,7 +10,8 @@
      ["." type]]]
    [tool
     [compiler
-     ["." reference (#+ Register Variable)]
+     [reference
+      ["." variable (#+ Register Variable)]]
      ["." phase ("operation@." monad)]
      [meta
       [archive (#+ Archive)]]
@@ -51,10 +52,10 @@
 (def: #export (variable archive variable)
   (-> Archive Variable (Operation Inst))
   (case variable
-    (#reference.Local variable)
+    (#variable.Local variable)
     (operation@wrap (local variable))
     
-    (#reference.Foreign variable)
+    (#variable.Foreign variable)
     (foreign archive variable)))
 
 (def: #export (constant archive name)