Upgraded the tuple right-access mechanism to the new style.

3 files changed, 79 insertions, 81 deletions

diff --git a/luxc/src/lux/compiler/jvm/case.clj b/luxc/src/lux/compiler/jvm/case.clj
index cceed14e4..aa262a102 100644
--- a/luxc/src/lux/compiler/jvm/case.clj
+++ b/luxc/src/lux/compiler/jvm/case.clj
@@ -108,27 +108,26 @@
       (.visitMethodInsn Opcodes/INVOKEVIRTUAL "java/lang/Object" "equals" "(Ljava/lang/Object;)Z")
       (.visitJumpInsn Opcodes/IFEQ $else))
 
-    (&o/$TuplePM _idx+)
-    (|let [[_idx is-tail?] (|case _idx+
-                             (&/$Left _idx)
-                             (&/T [_idx false])
-
-                             (&/$Right _idx)
-                             (&/T [_idx true]))]
-      (if (= 0 _idx)
-        (doto writer
-          stack-peek
-          (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
-          (.visitLdcInsn (int 0))
-          (.visitInsn Opcodes/AALOAD)
-          (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "pm_stack_push" "([Ljava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;"))
-        (doto writer
-          stack-peek
-          (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
-          (.visitLdcInsn (int _idx))
-          (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" (if is-tail? "product_getRight" "tuple_left") "([Ljava/lang/Object;I)Ljava/lang/Object;")
-          (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "pm_stack_push" "([Ljava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;")
-          )))
+    (&o/$TuplePM (&/$Left lefts))
+    (let [accessI (if (= 0 lefts)
+                    #(doto %
+                       (.visitInsn Opcodes/AALOAD))
+                    #(doto %
+                       (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "tuple_left" "([Ljava/lang/Object;I)Ljava/lang/Object;")))]
+      (doto writer
+        stack-peek
+        (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
+        (.visitLdcInsn (int lefts))
+        accessI
+        (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "pm_stack_push" "([Ljava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;")))
+
+    (&o/$TuplePM (&/$Right _idx))
+    (doto writer
+      stack-peek
+      (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
+      (.visitLdcInsn (int (dec _idx)))
+      (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "tuple_right" "([Ljava/lang/Object;I)Ljava/lang/Object;")
+      (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "pm_stack_push" "([Ljava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;"))
 
     (&o/$VariantPM _idx+)
     (|let [$success (new Label)
diff --git a/luxc/src/lux/compiler/jvm/lux.clj b/luxc/src/lux/compiler/jvm/lux.clj
index b57b94894..4aebc2bbf 100644
--- a/luxc/src/lux/compiler/jvm/lux.clj
+++ b/luxc/src/lux/compiler/jvm/lux.clj
@@ -206,9 +206,11 @@
                           (|let [[idx tail?] step]
                             (doto *writer*
                               (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
-                              (.visitLdcInsn (int idx))
+                              (.visitLdcInsn (int (if tail?
+                                                    (dec idx)
+                                                    idx)))
                               (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT"
-                                                (if tail? "product_getRight" "tuple_left")
+                                                (if tail? "tuple_right" "tuple_left")
                                                 "([Ljava/lang/Object;I)Ljava/lang/Object;"))))
                         _path)]]
     (return nil)))
diff --git a/luxc/src/lux/compiler/jvm/rt.clj b/luxc/src/lux/compiler/jvm/rt.clj
index d28011b41..f5fc85795 100644
--- a/luxc/src/lux/compiler/jvm/rt.clj
+++ b/luxc/src/lux/compiler/jvm/rt.clj
@@ -68,88 +68,85 @@
 
 ;; Runtime infrastructure
 (defn ^:private compile-LuxRT-adt-methods [^ClassWriter =class]
-  (|let [_ (let [$begin (new Label)
+  (|let [lefts #(doto %
+                  (.visitVarInsn Opcodes/ILOAD 1))
+         tuple-size #(doto %
+                       (.visitVarInsn Opcodes/ALOAD 0)
+                       (.visitInsn Opcodes/ARRAYLENGTH))
+         last-right-index #(doto %
+                             tuple-size
+                             (.visitLdcInsn (int 1))
+                             (.visitInsn Opcodes/ISUB))
+         sub-tuple #(doto %
+                      (.visitVarInsn Opcodes/ALOAD 0)
+                      last-right-index
+                      (.visitInsn Opcodes/AALOAD)
+                      (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;"))
+         _ (let [$begin (new Label)
                  $not-rec (new Label)
-                 index-right #(doto %
-                                (.visitVarInsn Opcodes/ALOAD 0)
-                                (.visitInsn Opcodes/ARRAYLENGTH)
-                                (.visitLdcInsn (int 1))
-                                (.visitInsn Opcodes/ISUB))
-                 lefts #(doto %
-                          (.visitVarInsn Opcodes/ILOAD 1))
                  left-index lefts
-                 access #(doto %
-                           (.visitVarInsn Opcodes/ALOAD 0)
-                           left-index
-                           (.visitInsn Opcodes/AALOAD))
+                 left-access #(doto %
+                                (.visitVarInsn Opcodes/ALOAD 0)
+                                left-index
+                                (.visitInsn Opcodes/AALOAD))
                  sub-lefts #(doto %
-                              ;; index-right, lefts
+                              ;; last-right-index, lefts
                               (.visitInsn Opcodes/SWAP)
-                              (.visitInsn Opcodes/ISUB))
-                 sub-tuple #(doto %
-                              (.visitVarInsn Opcodes/ALOAD 0)
-                              index-right
-                              (.visitInsn Opcodes/AALOAD)
-                              (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;"))]
+                              (.visitInsn Opcodes/ISUB))]
              (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "tuple_left" "([Ljava/lang/Object;I)Ljava/lang/Object;" nil nil)
                (.visitCode)
                (.visitLabel $begin)
-               index-right
+               last-right-index
                lefts
                (.visitInsn Opcodes/DUP2) (.visitJumpInsn Opcodes/IF_ICMPGT $not-rec)
-               sub-lefts (.visitVarInsn Opcodes/ISTORE 1)
                sub-tuple (.visitVarInsn Opcodes/ASTORE 0)
+               sub-lefts (.visitVarInsn Opcodes/ISTORE 1)
                (.visitJumpInsn Opcodes/GOTO $begin)
                (.visitLabel $not-rec)
-               ;; index-right, lefts
+               ;; last-right-index, lefts
                ;; (.visitInsn Opcodes/POP2) ;;
-               access
+               left-access
                (.visitInsn Opcodes/ARETURN)
                (.visitMaxs 0 0)
                (.visitEnd)))
          _ (let [$begin (new Label)
                  $is-last (new Label)
-                 $must-copy (new Label)]
-             (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "product_getRight" "([Ljava/lang/Object;I)Ljava/lang/Object;" nil nil)
+                 $must-copy (new Label)
+                 right-index #(doto %
+                                lefts
+                                (.visitLdcInsn (int 1))
+                                (.visitInsn Opcodes/IADD))
+                 right-access #(doto %
+                                 (.visitVarInsn Opcodes/ALOAD 0)
+                                 (.visitInsn Opcodes/SWAP)
+                                 (.visitInsn Opcodes/AALOAD))
+                 sub-right #(doto %
+                              (.visitVarInsn Opcodes/ALOAD 0)
+                              right-index
+                              tuple-size
+                              (.visitMethodInsn Opcodes/INVOKESTATIC "java/util/Arrays" "copyOfRange" "([Ljava/lang/Object;II)[Ljava/lang/Object;"))
+                 sub-lefts #(doto %
+                              lefts
+                              last-right-index
+                              (.visitInsn Opcodes/ISUB))]
+             (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "tuple_right" "([Ljava/lang/Object;I)Ljava/lang/Object;" nil nil)
                (.visitCode)
                (.visitLabel $begin)
-               (.visitVarInsn Opcodes/ALOAD 0) ;; tuple
-               (.visitInsn Opcodes/ARRAYLENGTH) ;; tuple-size
-               (.visitVarInsn Opcodes/ILOAD 1) ;; tuple-size, index
-               (.visitLdcInsn (int 1)) ;; tuple-size, index, offset-last-elem
-               (.visitInsn Opcodes/IADD) ;; tuple-size, index-last-elem
-               (.visitInsn Opcodes/DUP2) ;; tuple-size, index-last-elem, tuple-size, index-last-elem
-               (.visitJumpInsn Opcodes/IF_ICMPEQ $is-last) ;; tuple-size, index-last-elem
-               (.visitJumpInsn Opcodes/IF_ICMPGT $must-copy) ;;
+               last-right-index
+               right-index
+               (.visitInsn Opcodes/DUP2) (.visitJumpInsn Opcodes/IF_ICMPEQ $is-last)
+               (.visitJumpInsn Opcodes/IF_ICMPGT $must-copy)
                ;; Must recurse
-               (.visitVarInsn Opcodes/ALOAD 0) ;; tuple
-               (.visitInsn Opcodes/DUP) ;; tuple, tuple
-               (.visitInsn Opcodes/ARRAYLENGTH) ;; tuple, tuple-size
-               (.visitLdcInsn (int 1)) ;; tuple, tuple-size, offset-last-elem
-               (.visitInsn Opcodes/ISUB) ;; tuple, offset-tuple-last-elem
-               (.visitInsn Opcodes/AALOAD) ;; tuple-tail
-               (.visitVarInsn Opcodes/ILOAD 1) ;; tuple-tail, index
-               (.visitVarInsn Opcodes/ALOAD 0) ;; tuple-tail, index, tuple
-               (.visitInsn Opcodes/ARRAYLENGTH) ;; tuple-tail, index, tuple-size
-               (.visitLdcInsn (int 1)) ;; tuple-tail, index, tuple-size, 1
-               (.visitInsn Opcodes/ISUB) ;; tuple-tail, index, tuple-size*
-               (.visitInsn Opcodes/ISUB) ;; tuple-tail, index*
-               (.visitVarInsn Opcodes/ISTORE 1) ;; tuple-tail
-               (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") ;; tuple-tail
-               (.visitVarInsn Opcodes/ASTORE 0) ;;
+               sub-tuple (.visitVarInsn Opcodes/ASTORE 0)
+               sub-lefts (.visitVarInsn Opcodes/ISTORE 1)
                (.visitJumpInsn Opcodes/GOTO $begin)
                (.visitLabel $must-copy)
-               (.visitVarInsn Opcodes/ALOAD 0)
-               (.visitVarInsn Opcodes/ILOAD 1)
-               (.visitVarInsn Opcodes/ALOAD 0)
-               (.visitInsn Opcodes/ARRAYLENGTH)
-               (.visitMethodInsn Opcodes/INVOKESTATIC "java/util/Arrays" "copyOfRange" "([Ljava/lang/Object;II)[Ljava/lang/Object;")
+               sub-right
                (.visitInsn Opcodes/ARETURN)
-               (.visitLabel $is-last) ;; tuple-size, index-last-elem
-               ;; (.visitInsn Opcodes/POP2) ;;
-               (.visitVarInsn Opcodes/ALOAD 0) ;; tuple
-               (.visitVarInsn Opcodes/ILOAD 1) ;; tuple, index
-               (.visitInsn Opcodes/AALOAD) ;; elem
+               (.visitLabel $is-last)
+               ;; last-right-index, right-index
+               ;; (.visitInsn Opcodes/POP)
+               right-access
                (.visitInsn Opcodes/ARETURN)
                (.visitMaxs 0 0)
                (.visitEnd)))