aboutsummaryrefslogtreecommitdiff
path: root/new-luxc
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc')
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux52
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux44
2 files changed, 56 insertions, 40 deletions
diff --git a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux
index 22817e8eb..43d11c71e 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux
@@ -132,29 +132,35 @@
([synthesis.side/left _.NULL function.identity]
[synthesis.side/right (_.string "") .inc])
- (^template [<pattern> <method> <prepare>]
- (^ (<pattern> idx))
- (operation/wrap (.case (<prepare> idx)
- 0
- (|>> peekI
- (_.CHECKCAST ($t.descriptor runtime.$Tuple))
- (_.int +0)
- _.AALOAD
- pushI)
-
- idx
- (|>> peekI
- (_.CHECKCAST ($t.descriptor runtime.$Tuple))
- (_.int (.int idx))
- (_.INVOKESTATIC //.runtime-class
- <method>
- ($t.method (list runtime.$Tuple $t.int)
- (#.Some $Object)
- (list))
- #0)
- pushI))))
- ([synthesis.member/left "tuple_left" <|]
- [synthesis.member/right "pm_right" inc])
+ (^ (synthesis.member/left lefts))
+ (operation/wrap (.let [accessI (.case lefts
+ 0
+ _.AALOAD
+
+ lefts
+ (_.INVOKESTATIC //.runtime-class
+ "tuple_left"
+ ($t.method (list runtime.$Tuple $t.int)
+ (#.Some $Object)
+ (list))
+ #0))]
+ (|>> peekI
+ (_.CHECKCAST ($t.descriptor runtime.$Tuple))
+ (_.int (.int lefts))
+ accessI
+ pushI)))
+
+ (^ (synthesis.member/right lefts))
+ (operation/wrap (|>> peekI
+ (_.CHECKCAST ($t.descriptor runtime.$Tuple))
+ (_.int (.int lefts))
+ (_.INVOKESTATIC //.runtime-class
+ "tuple_right"
+ ($t.method (list runtime.$Tuple $t.int)
+ (#.Some $Object)
+ (list))
+ #0)
+ pushI))
(#synthesis.Alt leftP rightP)
(do phase.monad
diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
index 6ea00df21..973170d77 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
@@ -136,8 +136,6 @@
last-right-indexI (|>> tuple-sizeI (_.int +1) _.ISUB)
leftsI (_.ILOAD 1)
left-indexI leftsI
- accessI (|>> (_.ALOAD 0) left-indexI _.AALOAD)
- sub-leftsI (|>> _.SWAP _.ISUB)
sub-tupleI (|>> (_.ALOAD 0) last-right-indexI _.AALOAD (_.CHECKCAST ($t.descriptor $Tuple)))
expected-last-sizeI (|>> (_.ILOAD 1) (_.int +1) _.IADD)]
@@ -231,6 +229,8 @@
($d.method #$.Public $.staticM "tuple_left" ($t.method (list $Tuple $t.int) (#.Some $Object) (list))
(<| _.with-label (function (_ @begin))
_.with-label (function (_ @not-recursive))
+ (let [left-accessI (|>> (_.ALOAD 0) left-indexI _.AALOAD)
+ sub-leftsI (|>> _.SWAP _.ISUB)])
(|>> (_.label @begin)
last-right-indexI
leftsI
@@ -241,34 +241,44 @@
(_.GOTO @begin)
(_.label @not-recursive)
## _.POP2
- accessI
+ left-accessI
_.ARETURN)))
- ($d.method #$.Public $.staticM "pm_right" ($t.method (list $Tuple $t.int) (#.Some $Object) (list))
+ ($d.method #$.Public $.staticM "tuple_right" ($t.method (list $Tuple $t.int) (#.Some $Object) (list))
(<| _.with-label (function (_ @begin))
_.with-label (function (_ @tail))
_.with-label (function (_ @slice))
- (let [updated-idxI (|>> (_.ILOAD 1) (_.int +1) _.ISUB tuple-sizeI _.ISUB)
- sliceI (|>> (_.ALOAD 0) (_.ILOAD 1) tuple-sizeI
- (_.INVOKESTATIC "java.util.Arrays" "copyOfRange"
- ($t.method (list $Object-Array $t.int $t.int)
- (#.Some $Object-Array)
- (list))
- #0))])
+ (let [right-indexI (|>> leftsI
+ (_.int +1)
+ _.IADD)
+ right-accessI (|>> (_.ALOAD 0)
+ _.SWAP
+ _.AALOAD)
+ sub-rightI (|>> (_.ALOAD 0)
+ right-indexI
+ tuple-sizeI
+ (_.INVOKESTATIC "java.util.Arrays" "copyOfRange"
+ ($t.method (list $Object-Array $t.int $t.int)
+ (#.Some $Object-Array)
+ (list))
+ #0))
+ sub-leftsI (|>> leftsI
+ last-right-indexI
+ _.ISUB)])
(|>> (_.label @begin)
- tuple-sizeI
- expected-last-sizeI
+ last-right-indexI
+ right-indexI
_.DUP2 (_.IF_ICMPEQ @tail)
(_.IF_ICMPGT @slice)
## Must recurse
sub-tupleI (_.ASTORE 0)
- updated-idxI (_.ISTORE 1)
+ sub-leftsI (_.ISTORE 1)
(_.GOTO @begin)
(_.label @slice)
- sliceI
+ sub-rightI
_.ARETURN
(_.label @tail)
- ## _.POP2
- accessI
+ ## _.POP
+ right-accessI
_.ARETURN)))
)))