aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--luxc/src/lux/compiler/jvm/rt.clj186
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/runtime.lux100
-rw-r--r--stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux10
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
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-04 23:54:00 +0000