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 +++++++++++++++++---------------------- 1 file changed, 80 insertions(+), 106 deletions(-) (limited to 'luxc/src') 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] -- cgit v1.2.3