From a934596e2944e95b688873a10426399ab0e706dc Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sat, 24 Sep 2016 01:31:01 -0400
Subject: - Now optimizing the record accesses that are characteristic of get@
 and ::.

---
 src/lux/compiler.clj     |  3 +++
 src/lux/compiler/lux.clj | 14 ++++++++++++++
 src/lux/optimizer.clj    | 47 +++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 64 insertions(+)

diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 19832d4e6..fe3a24c32 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -94,6 +94,9 @@
         (&o/$let _value _register _body)
         (&&lux/compile-let (partial compile-expression $begin) _value _register _body)
 
+        (&o/$record-get _value _path)
+        (&&lux/compile-record-get (partial compile-expression $begin) _value _path)
+
         (&o/$function ?arity ?scope ?env ?body)
         (&&lambda/compile-function compile-expression &/$None ?arity ?scope ?env ?body)
 
diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj
index 83bb2ac44..6b5ec6a19 100644
--- a/src/lux/compiler/lux.clj
+++ b/src/lux/compiler/lux.clj
@@ -189,6 +189,20 @@
         _ (compile _body)]
     (return nil)))
 
+(defn compile-record-get [compile _value _path]
+  (|do [^MethodVisitor *writer* &/get-writer
+        _ (compile _value)
+        :let [_ (&/|map (fn [step]
+                          (|let [[idx tail?] step]
+                            (doto *writer*
+                              (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
+                              (.visitLdcInsn (int idx))
+                              (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT"
+                                                (if tail? "product_getRight" "product_getLeft")
+                                                "([Ljava/lang/Object;I)Ljava/lang/Object;"))))
+                        _path)]]
+    (return nil)))
+
 (defn ^:private compile-def-type [compile ?body]
   (|do [:let [?def-type (|case ?body
                           [[?def-type ?def-cursor] (&a/$ann ?def-value ?type-expr ?def-value-type)]
diff --git a/src/lux/optimizer.clj b/src/lux/optimizer.clj
index fd859d90d..933849be3 100644
--- a/src/lux/optimizer.clj
+++ b/src/lux/optimizer.clj
@@ -28,6 +28,7 @@
   ;; Purely for optimizations
   ("loop" 1)
   ("let" 3)
+  ("record-get" 2)
   )
 
 ;; For pattern-matching
@@ -311,11 +312,47 @@
                          (inc _register)
                          _register)
                        (shift-function-body old-scope new-scope own-body? _body))])
+
+      ($record-get _value _path)
+      (&/T [meta ($record-get (shift-function-body old-scope new-scope own-body? _value)
+                              _path)])
       
       _
       body
       )))
 
+(defn ^:private record-read-path [pms member-idx]
+  "(-> (List PM) Idx (List Idx))"
+  (loop [current-idx 0
+         pms pms]
+    (|case pms
+      (&/$Nil)
+      &/$None
+      
+      (&/$Cons _pm _pms)
+      (|case _pm
+        (&a-case/$NoTestAC)
+        (recur (inc current-idx)
+               _pms)
+        
+        (&a-case/$StoreTestAC _register)
+        (if (= member-idx _register)
+          (&/|list (&/T [current-idx (&/|empty? _pms)]))
+          (recur (inc current-idx)
+                 _pms))
+
+        (&a-case/$TupleTestAC _sub-tests)
+        (let [sub-path (record-read-path _sub-tests member-idx)]
+          (if (not (&/|empty? sub-path))
+            (&/$Cons (&/T [current-idx (&/|empty? _pms)]) sub-path)
+            (recur (inc current-idx)
+                   _pms)
+            ))
+        
+        _
+        (&/|list))
+      )))
+
 (defn ^:private optimize-loop [arity optim]
   "(-> Int Optimized Optimized)"
   (|let [[meta optim-] optim]
@@ -382,6 +419,16 @@
           (&/$Cons [(&a-case/$StoreTestAC _register) _body] (&/$Nil))
           (&/T [meta ($let (pass-0 value) _register (pass-0 _body))])
 
+          (&/$Cons [(&a-case/$TupleTestAC _sub-tests) [_ (&a/$var (&/$Local _member-idx))]] (&/$Nil))
+          (|let [_path (record-read-path _sub-tests _member-idx)]
+            (if (&/|empty? _path)
+              (&/T [meta ($case (pass-0 value)
+                                (optimize-pm (&/|map (fn [branch]
+                                                       (|let [[_pattern _body] branch]
+                                                         (&/T [_pattern (pass-0 _body)])))
+                                                     branches)))])
+              (&/T [meta ($record-get (pass-0 value) _path)])))
+
           _
           (&/T [meta ($case (pass-0 value)
                             (optimize-pm (&/|map (fn [branch]
-- 
cgit v1.2.3