From 84ea12c2960cc7460de81087a6e53bcc6d37a3d6 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 28 Dec 2019 22:27:09 -0400 Subject: Optimized pattern-matching against variants. --- luxc/src/lux/compiler/jvm/rt.clj | 186 +++++++++------------ .../source/luxc/lang/translation/jvm/runtime.lux | 100 ++++++----- .../tool/compiler/phase/generation/jvm/runtime.lux | 10 +- 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 [& 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 ( (.visitVarInsn Opcodes/ALOAD 0)) + !tag ( (.visitVarInsn Opcodes/ILOAD 1)) + !last? ( (.visitVarInsn Opcodes/ALOAD 2)) + + <>tag ( (.visitLdcInsn (int 0)) + (.visitInsn Opcodes/AALOAD) + &&/unwrap-int) + <>last? ( (.visitLdcInsn (int 1)) + (.visitInsn Opcodes/AALOAD)) + <>value ( (.visitLdcInsn (int 2)) + (.visitInsn Opcodes/AALOAD)) + + not-found ( (.visitInsn Opcodes/ACONST_NULL)) + + super-nested-tag ( (.visitInsn Opcodes/SWAP) + (.visitInsn Opcodes/ISUB)) + super-nested ( 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 ( !variant <>value + (.visitTypeInsn Opcodes/CHECKCAST "[Ljava/lang/Object;") + (.visitVarInsn Opcodes/ASTORE 0)) + update-!tag ( (.visitInsn Opcodes/ISUB)) + iterate! (fn [^Label $loop] + ( 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" "" "(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 -- cgit v1.2.3