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. --- .../source/luxc/lang/translation/jvm/case.jvm.lux | 52 ++++++++++++---------- .../luxc/lang/translation/jvm/runtime.jvm.lux | 44 +++++++++++------- 2 files changed, 56 insertions(+), 40 deletions(-) (limited to 'new-luxc/source/luxc/lang/translation') 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 [ ] - (^ ( idx)) - (operation/wrap (.case ( 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 - - ($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))) ))) -- cgit v1.2.3