From d4ded2084127fd8953d2889d72bab889213000a1 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 7 Apr 2019 21:12:08 -0400 Subject: Upgraded the tuple right-access mechanism to the new style. --- luxc/src/lux/compiler/jvm/case.clj | 41 +++++++------- luxc/src/lux/compiler/jvm/lux.clj | 6 +- luxc/src/lux/compiler/jvm/rt.clj | 113 ++++++++++++++++++------------------- 3 files changed, 79 insertions(+), 81 deletions(-) (limited to 'luxc') 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))) -- cgit v1.2.3