Optimized pattern-matching against variants.

3 files changed, 136 insertions, 160 deletions

diff --git a/luxc/src/lux/compiler/jvm/rt.clj b/luxc/src/lux/compiler/jvm/rt.clj
index 059e33a97..7fabd27ed 100644
--- a/luxc/src/lux/compiler/jvm/rt.clj
+++ b/luxc/src/lux/compiler/jvm/rt.clj
@@ -66,6 +66,11 @@
     (&&/save-class! (second (string/split &&/function-class #"/"))
                     (.toByteArray (doto =class .visitEnd)))))
 
+(defmacro <bytecode> [& instructions]
+  `(fn [^MethodVisitor writer#]
+     (doto writer#
+       ~@instructions)))
+
 ;; Runtime infrastructure
 (defn ^:private compile-LuxRT-adt-methods [^ClassWriter =class]
   (|let [lefts #(doto ^MethodVisitor %
@@ -140,120 +145,89 @@
                (.visitInsn Opcodes/ARETURN)
                (.visitMaxs 0 0)
                (.visitEnd)))
-         _ (let [$begin (new Label)
-                 $just-return (new Label)
-                 $then (new Label)
-                 $further (new Label)
-                 $shorten (new Label)
-                 $not-right (new Label)
-                 failure (fn [^MethodVisitor writer]
-                           (doto writer
-                             ;; (.visitInsn Opcodes/POP2)
-                             (.visitInsn Opcodes/ACONST_NULL)
-                             (.visitInsn Opcodes/ARETURN)))
-                 shortened (fn [^MethodVisitor writer]
-                             (doto writer
-                               ;; Get Tag
-                               (.visitVarInsn Opcodes/ALOAD 0) (.visitLdcInsn (int 0)) (.visitInsn Opcodes/AALOAD)
-                               ;; Shorten tag
-                               &&/unwrap-int (.visitVarInsn Opcodes/ILOAD 1) (.visitInsn Opcodes/ISUB)
-                               ;; Get flag
-                               (.visitVarInsn Opcodes/ALOAD 0) (.visitLdcInsn (int 1)) (.visitInsn Opcodes/AALOAD)
-                               ;; Get value
-                               (.visitVarInsn Opcodes/ALOAD 0) (.visitLdcInsn (int 2)) (.visitInsn Opcodes/AALOAD)
-                               ;; Build sum
-                               (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;")))]
+         _ (let [$loop (new Label)
+                 $perfect-match! (new Label)
+                 $tags-match! (new Label)
+                 $maybe-nested (new Label)
+                 $mismatch! (new Label)
+
+                 !variant (<bytecode> (.visitVarInsn Opcodes/ALOAD 0))
+                 !tag (<bytecode> (.visitVarInsn Opcodes/ILOAD 1))
+                 !last? (<bytecode> (.visitVarInsn Opcodes/ALOAD 2))
+
+                 <>tag (<bytecode> (.visitLdcInsn (int 0))
+                                   (.visitInsn Opcodes/AALOAD)
+                                   &&/unwrap-int)
+                 <>last? (<bytecode> (.visitLdcInsn (int 1))
+                                     (.visitInsn Opcodes/AALOAD))
+                 <>value (<bytecode> (.visitLdcInsn (int 2))
+                                     (.visitInsn Opcodes/AALOAD))
+
+                 not-found (<bytecode> (.visitInsn Opcodes/ACONST_NULL))
+
+                 super-nested-tag (<bytecode> (.visitInsn Opcodes/SWAP)
+                                              (.visitInsn Opcodes/ISUB))
+                 super-nested (<bytecode> super-nested-tag ;; super-tag
+                                          !variant <>last? ;; super-tag, super-last
+                                          !variant <>value ;; super-tag, super-last, super-value
+                                          (.visitMethodInsn Opcodes/INVOKESTATIC "lux/LuxRT" "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;"))
+
+                 update-!variant (<bytecode> !variant <>value
+                                             (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
+                                             (.visitVarInsn Opcodes/ASTORE 0))
+                 update-!tag (<bytecode> (.visitInsn Opcodes/ISUB))
+                 iterate! (fn [^Label $loop]
+                            (<bytecode> update-!variant
+                                        update-!tag
+                                        (.visitJumpInsn Opcodes/GOTO $loop)))]
              (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "sum_get" "([Ljava/lang/Object;ILjava/lang/Object;)Ljava/lang/Object;" nil nil)
                (.visitCode)
-               (.visitLabel $begin)
-               (.visitVarInsn Opcodes/ILOAD 1) ;; tag
-               (.visitVarInsn Opcodes/ALOAD 0) ;; tag, sum
-               (.visitLdcInsn (int 0)) ;; tag, sum, sum-tag-idx
-               (.visitInsn Opcodes/AALOAD) ;; tag, sum-tag'
-               &&/unwrap-int ;; tag, sum-tag
-               (.visitInsn Opcodes/DUP2) ;; tag, sum-tag, tag, sum-tag
-               (.visitJumpInsn Opcodes/IF_ICMPEQ $then) ;; tag, sum-tag
-               (.visitInsn Opcodes/DUP2) ;; tag, sum-tag, tag, sum-tag
-               (.visitJumpInsn Opcodes/IF_ICMPGT $further) ;; tag, sum-tag
-               (.visitInsn Opcodes/DUP2) ;; tag, sum-tag, tag, sum-tag
-               (.visitJumpInsn Opcodes/IF_ICMPLT $shorten) ;; tag, sum-tag
-               failure
-               (.visitLabel $then) ;; tag, sum-tag
-               (.visitVarInsn Opcodes/ALOAD 2) ;; tag, sum-tag, wants-last?
-               (.visitVarInsn Opcodes/ALOAD 0)
-               (.visitLdcInsn (int 1))
-               (.visitInsn Opcodes/AALOAD) ;; tag, sum-tag, wants-last?, is-last?
-               (.visitJumpInsn Opcodes/IF_ACMPEQ $just-return)
-               (.visitJumpInsn Opcodes/GOTO $further)
-               (.visitLabel $just-return)
+               !tag ;; tag
+               (.visitLabel $loop)
+               !variant <>tag ;; tag, variant::tag
+               (.visitInsn Opcodes/DUP2) (.visitJumpInsn Opcodes/IF_ICMPEQ $tags-match!) ;; tag, variant::tag
+               (.visitInsn Opcodes/DUP2) (.visitJumpInsn Opcodes/IF_ICMPGT $maybe-nested) ;; tag, variant::tag
+               !last? (.visitJumpInsn Opcodes/IFNULL $mismatch!) ;; tag, variant::tag
+               super-nested ;; super-variant
+               (.visitInsn Opcodes/ARETURN)
+               (.visitLabel $tags-match!) ;; tag, variant::tag
+               !last? ;; tag, variant::tag, last?
+               !variant <>last?
+               (.visitJumpInsn Opcodes/IF_ACMPEQ $perfect-match!)
+               (.visitLabel $maybe-nested) ;; tag, variant::tag
+               !variant <>last? ;; tag, variant::tag, variant::last?
+               (.visitJumpInsn Opcodes/IFNULL $mismatch!) ;; tag, variant::tag
+               ((iterate! $loop))
+               (.visitLabel $perfect-match!)
                ;; (.visitInsn Opcodes/POP2)
-               (.visitVarInsn Opcodes/ALOAD 0)
-               (.visitLdcInsn (int 2))
-               (.visitInsn Opcodes/AALOAD)
+               !variant <>value
                (.visitInsn Opcodes/ARETURN)
-               (.visitLabel $shorten)
-               (.visitVarInsn Opcodes/ALOAD 2)
-               (.visitJumpInsn Opcodes/IFNULL $not-right)
+               (.visitLabel $mismatch!) ;; tag, variant::tag
                ;; (.visitInsn Opcodes/POP2)
-               shortened
+               not-found
                (.visitInsn Opcodes/ARETURN)
-               (.visitLabel $further) ;; tag, sum-tag
-               (.visitVarInsn Opcodes/ALOAD 0) ;; tag, sum-tag, sum
-               (.visitLdcInsn (int 1)) ;; tag, sum-tag, sum, last-index?
-               (.visitInsn Opcodes/AALOAD) ;; tag, sum-tag, last?
-               (.visitJumpInsn Opcodes/IFNULL $not-right) ;; tag, sum-tag
-               (.visitInsn Opcodes/ISUB) ;; sub-tag
-               (.visitVarInsn Opcodes/ALOAD 0) ;; sub-tag, sum
-               (.visitLdcInsn (int 2)) ;; sub-tag, sum, sub-sum-idx
-               (.visitInsn Opcodes/AALOAD) ;; sub-tag, sub-sum
-               (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;")
-               (.visitVarInsn Opcodes/ASTORE 0) ;; sub-tag
-               (.visitVarInsn Opcodes/ISTORE 1) ;;
-               (.visitJumpInsn Opcodes/GOTO $begin)
-               (.visitLabel $not-right) ;; tag, sum-tag
-               failure
                (.visitMaxs 0 0)
                (.visitEnd)))
-         ;; I commented-out some parts because a null-check was
-         ;; done to ensure variants were never created with null
-         ;; values (this would interfere later with
-         ;; pattern-matching).
-         ;; Since Lux itself does not have null values as part of
-         ;; the language, the burden of ensuring non-nulls was
-         ;; shifted to library code dealing with host-interop, to
-         ;; ensure variant-making was as fast as possible.
-         ;; The null-checking code was left as comments in case I
-         ;; ever change my mind.
-         _ (let [;; $is-null (new Label)
-                 ]
-             (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;" nil nil)
-               (.visitCode)
-               ;; (.visitVarInsn Opcodes/ALOAD 2)
-               ;; (.visitJumpInsn Opcodes/IFNULL $is-null)
-               (.visitLdcInsn (int 3))
-               (.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object")
-               (.visitInsn Opcodes/DUP)
-               (.visitLdcInsn (int 0))
-               (.visitVarInsn Opcodes/ILOAD 0)
-               (&&/wrap-int)
-               (.visitInsn Opcodes/AASTORE)
-               (.visitInsn Opcodes/DUP)
-               (.visitLdcInsn (int 1))
-               (.visitVarInsn Opcodes/ALOAD 1)
-               (.visitInsn Opcodes/AASTORE)
-               (.visitInsn Opcodes/DUP)
-               (.visitLdcInsn (int 2))
-               (.visitVarInsn Opcodes/ALOAD 2)
-               (.visitInsn Opcodes/AASTORE)
-               (.visitInsn Opcodes/ARETURN)
-               ;; (.visitLabel $is-null)
-               ;; (.visitTypeInsn Opcodes/NEW "java/lang/IllegalStateException")
-               ;; (.visitInsn Opcodes/DUP)
-               ;; (.visitLdcInsn "Cannot create variant for null pointer")
-               ;; (.visitMethodInsn Opcodes/INVOKESPECIAL "java/lang/IllegalStateException" "<init>" "(Ljava/lang/String;)V")
-               ;; (.visitInsn Opcodes/ATHROW)
-               (.visitMaxs 0 0)
-               (.visitEnd)))]
+         _ (doto (.visitMethod =class (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC) "sum_make" "(ILjava/lang/Object;Ljava/lang/Object;)[Ljava/lang/Object;" nil nil)
+             (.visitCode)
+             (.visitLdcInsn (int 3))
+             (.visitTypeInsn Opcodes/ANEWARRAY "java/lang/Object")
+             (.visitInsn Opcodes/DUP)
+             (.visitLdcInsn (int 0))
+             (.visitVarInsn Opcodes/ILOAD 0)
+             (&&/wrap-int)
+             (.visitInsn Opcodes/AASTORE)
+             (.visitInsn Opcodes/DUP)
+             (.visitLdcInsn (int 1))
+             (.visitVarInsn Opcodes/ALOAD 1)
+             (.visitInsn Opcodes/AASTORE)
+             (.visitInsn Opcodes/DUP)
+             (.visitLdcInsn (int 2))
+             (.visitVarInsn Opcodes/ALOAD 2)
+             (.visitInsn Opcodes/AASTORE)
+             (.visitInsn Opcodes/ARETURN)
+             (.visitMaxs 0 0)
+             (.visitEnd))]
     nil))
 
 (defn ^:private swap2x1 [^MethodVisitor =method]
diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.lux
index 78467022e..87a5d535c 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/runtime.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.lux
@@ -169,56 +169,64 @@
                          _.ARETURN))
          ($d.method #$.Public $.staticM "pm_variant" (type.method [(list //.$Variant $Tag $Flag) $Value (list)])
                     (<| _.with-label (function (_ @loop))
-                        _.with-label (function (_ @just-return))
-                        _.with-label (function (_ @then))
-                        _.with-label (function (_ @further))
-                        _.with-label (function (_ @shorten))
-                        _.with-label (function (_ @wrong))
-                        (let [variant-partI (: (-> Nat Inst)
+                        _.with-label (function (_ @perfect-match!))
+                        _.with-label (function (_ @tags-match!))
+                        _.with-label (function (_ @maybe-nested))
+                        _.with-label (function (_ @mismatch!))
+                        (let [$variant (_.ALOAD 0)
+                              $tag (_.ILOAD 1)
+                              $last? (_.ALOAD 2)
+                              
+                              variant-partI (: (-> Nat Inst)
                                                (function (_ idx)
                                                  (|>> (_.int (.int idx)) _.AALOAD)))
-                              tagI (: Inst
-                                      (|>> (variant-partI 0) (_.unwrap type.int)))
-                              flagI (variant-partI 1)
-                              datumI (variant-partI 2)
-                              shortenI (|>> (_.ALOAD 0) tagI ## Get tag
-                                            (_.ILOAD 1) _.ISUB ## Shorten tag
-                                            (_.ALOAD 0) flagI ## Get flag
-                                            (_.ALOAD 0) datumI ## Get value
-                                            variantI ## Build sum
-                                            _.ARETURN)
-                              update-tagI (|>> _.ISUB (_.ISTORE 1))
-                              update-variantI (|>> (_.ALOAD 0) datumI (_.CHECKCAST //.$Variant) (_.ASTORE 0))
-                              failureI (|>> _.NULL _.ARETURN)
-                              return-datumI (|>> (_.ALOAD 0) datumI _.ARETURN)])
-                        (|>> (_.label @loop)
-                             (_.ILOAD 1) ## tag
-                             (_.ALOAD 0) tagI ## tag, sumT
-                             _.DUP2 (_.IF_ICMPEQ @then)
-                             _.DUP2 (_.IF_ICMPGT @further)
-                             _.DUP2 (_.IF_ICMPLT @shorten)
-                             ## _.POP2
-                             failureI
-                             (_.label @then) ## tag, sumT
-                             (_.ALOAD 2) ## tag, sumT, wants-last?
-                             (_.ALOAD 0) flagI ## tag, sumT, wants-last?, is-last?
-                             (_.IF_ACMPEQ @just-return) ## tag, sumT
-                             (_.label @further) ## tag, sumT
-                             (_.ALOAD 0) flagI ## tag, sumT, last?
-                             (_.IFNULL @wrong) ## tag, sumT
-                             update-tagI
-                             update-variantI
-                             (_.GOTO @loop)
-                             (_.label @just-return) ## tag, sumT
-                             ## _.POP2
-                             return-datumI
-                             (_.label @shorten) ## tag, sumT
-                             (_.ALOAD 2) (_.IFNULL @wrong)
+                              ::tag (: Inst
+                                       (|>> (variant-partI 0) (_.unwrap type.int)))
+                              ::last? (variant-partI 1)
+                              ::value (variant-partI 2)
+
+                              super-nested-tag (|>> _.SWAP ## variant::tag, tag
+                                                    _.ISUB)
+                              super-nested (|>> super-nested-tag ## super-tag
+                                                $variant ::last? ## super-tag, super-last
+                                                $variant ::value ## super-tag, super-last, super-value
+                                                ..variantI)
+                              
+                              update-$tag _.ISUB
+                              update-$variant (|>> $variant ::value
+                                                   (_.CHECKCAST //.$Variant)
+                                                   (_.ASTORE 0))
+                              iterate! (: (-> Label Inst)
+                                          (function (_ @loop)
+                                            (|>> update-$variant
+                                                 update-$tag
+                                                 (_.GOTO @loop))))
+                              
+                              not-found _.NULL])
+                        (|>> $tag ## tag
+                             (_.label @loop)
+                             $variant ::tag ## tag, variant::tag
+                             _.DUP2 (_.IF_ICMPEQ @tags-match!) ## tag, variant::tag
+                             _.DUP2 (_.IF_ICMPGT @maybe-nested) ## tag, variant::tag
+                             $last? (_.IFNULL @mismatch!) ## tag, variant::tag
+                             super-nested ## super-variant
+                             _.ARETURN
+                             (_.label @tags-match!) ## tag, variant::tag
+                             $last? ## tag, variant::tag, last?
+                             $variant ::last? ## tag, variant::tag, last?, variant::last?
+                             (_.IF_ACMPEQ @perfect-match!) ## tag, variant::tag
+                             (_.label @maybe-nested) ## tag, variant::tag
+                             $variant ::last? ## tag, variant::tag, variant::last?
+                             (_.IFNULL @mismatch!) ## tag, variant::tag
+                             (iterate! @loop)
+                             (_.label @perfect-match!) ## tag, variant::tag
                              ## _.POP2
-                             shortenI
-                             (_.label @wrong) ## tag, sumT
+                             $variant ::value
+                             _.ARETURN
+                             (_.label @mismatch!) ## tag, variant::tag
                              ## _.POP2
-                             failureI)))
+                             not-found
+                             _.ARETURN)))
          ($d.method #$.Public $.staticM "tuple_left" (type.method [(list //.$Tuple $Index) $Value (list)])
                     (<| _.with-label (function (_ @loop))
                         _.with-label (function (_ @recursive))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux
index 99a8ed79a..5968ed6c8 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux
@@ -272,7 +272,6 @@
                      @perfect-match! _.new-label
                      @tags-match! _.new-label
                      @maybe-nested _.new-label
-                     @maybe-super-nested _.new-label
                      @mismatch! _.new-label
                      #let [::tag ($_ _.compose
                                      (..get ..variant-tag)
@@ -315,9 +314,8 @@
                         $variant ::tag
                         _.dup2 (_.if-icmpeq @tags-match!)
                         _.dup2 (_.if-icmpgt @maybe-nested)
-                        _.dup2 (_.if-icmplt @maybe-super-nested)
-                        ## _.pop2
-                        not-found
+                        $last? (_.ifnull @mismatch!) ## tag, sumT
+                        super-nested ## super-variant
                         _.areturn
                         (_.set-label @tags-match!) ## tag, sumT
                         $last? ## tag, sumT, wants-last?
@@ -331,10 +329,6 @@
                         ## _.pop2
                         $variant ::value
                         _.areturn
-                        (_.set-label @maybe-super-nested) ## tag, sumT
-                        $last? (_.ifnull @mismatch!) ## tag, sumT
-                        super-nested ## super-variant
-                        _.areturn
                         (_.set-label @mismatch!) ## tag, sumT
                         ## _.pop2
                         not-found