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.lux96
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux59
2 files changed, 49 insertions, 106 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 e11187787..ac7ab3b83 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux
@@ -57,9 +57,8 @@
(list))
#0)))
-(def: (path' translate stack-depth @else @end path)
- (-> (-> Synthesis (Operation Inst))
- Nat Label Label Path (Operation Inst))
+(def: (path' phase stack-depth @else @end path)
+ (-> Phase Nat Label Label Path (Operation Inst))
(.case path
#synthesis.Pop
(operation/wrap popI)
@@ -101,15 +100,39 @@
(#synthesis.Then bodyS)
(do phase.Monad<Operation>
- [bodyI (translate bodyS)]
+ [bodyI (phase bodyS)]
(wrap (|>> (pop-altI stack-depth)
bodyI
(_.GOTO @end))))
- (^template [<pattern> <method>]
+ (^template [<pattern> <flag> <prepare>]
(^ (<pattern> idx))
- (operation/wrap (.case idx
+ (operation/wrap (<| _.with-label (function (_ @success))
+ _.with-label (function (_ @fail))
+ (|>> peekI
+ (_.CHECKCAST ($t.descriptor runtime.$Variant))
+ (_.int (.int (<prepare> idx)))
+ <flag>
+ (_.INVOKESTATIC //.runtime-class "pm_variant"
+ ($t.method (list runtime.$Variant runtime.$Tag runtime.$Flag)
+ (#.Some runtime.$Datum)
+ (list))
+ #0)
+ _.DUP
+ (_.IFNULL @fail)
+ (_.GOTO @success)
+ (_.label @fail)
+ _.POP
+ (_.GOTO @else)
+ (_.label @success)
+ pushI))))
+ ([synthesis.side/left _.NULL .id]
+ [synthesis.side/right (_.string "") .inc])
+
+ (^template [<pattern> <method> <prepare>]
+ (^ (<pattern> idx))
+ (operation/wrap (.case (<prepare> idx)
0
(|>> peekI
(_.CHECKCAST ($t.descriptor runtime.$Tuple))
@@ -128,39 +151,14 @@
(list))
#0)
pushI))))
- ([synthesis.member/left "pm_left"]
- [synthesis.member/right "pm_right"])
-
- (^template [<pattern> <flag> <mod>]
- (^ (<pattern> idx))
- (.let [idx (<mod> idx)]
- (operation/wrap (<| _.with-label (function (_ @success))
- _.with-label (function (_ @fail))
- (|>> peekI
- (_.CHECKCAST ($t.descriptor runtime.$Variant))
- (_.int (.int idx))
- <flag>
- (_.INVOKESTATIC //.runtime-class "pm_variant"
- ($t.method (list runtime.$Variant runtime.$Tag runtime.$Flag)
- (#.Some runtime.$Datum)
- (list))
- #0)
- _.DUP
- (_.IFNULL @fail)
- (_.GOTO @success)
- (_.label @fail)
- _.POP
- (_.GOTO @else)
- (_.label @success)
- pushI)))))
- ([synthesis.side/left _.NULL .id]
- [synthesis.side/right (_.string "") .inc])
+ ([synthesis.member/left "pm_left" id]
+ [synthesis.member/right "pm_right" inc])
(#synthesis.Alt leftP rightP)
(do phase.Monad<Operation>
[@alt-else _.make-label
- leftI (path' translate (inc stack-depth) @alt-else @end leftP)
- rightI (path' translate stack-depth @else @end rightP)]
+ leftI (path' phase (inc stack-depth) @alt-else @end leftP)
+ rightI (path' phase stack-depth @else @end rightP)]
(wrap (|>> _.DUP
leftI
(_.label @alt-else)
@@ -169,17 +167,17 @@
(#synthesis.Seq leftP rightP)
(do phase.Monad<Operation>
- [leftI (path' translate stack-depth @else @end leftP)
- rightI (path' translate stack-depth @else @end rightP)]
+ [leftI (path' phase stack-depth @else @end leftP)
+ rightI (path' phase stack-depth @else @end rightP)]
(wrap (|>> leftI
rightI)))
))
-(def: (path translate path @end)
+(def: (path phase path @end)
(-> Phase Path Label (Operation Inst))
(do phase.Monad<Operation>
[@else _.make-label
- pathI (..path' translate 1 @else @end path)]
+ pathI (..path' phase 1 @else @end path)]
(wrap (|>> pathI
(_.label @else)
_.POP
@@ -190,12 +188,12 @@
_.NULL
(_.GOTO @end)))))
-(def: #export (if translate testS thenS elseS)
+(def: #export (if phase testS thenS elseS)
(-> Phase Synthesis Synthesis Synthesis (Operation Inst))
(do phase.Monad<Operation>
- [testI (translate testS)
- thenI (translate thenS)
- elseI (translate elseS)]
+ [testI (phase testS)
+ thenI (phase thenS)
+ elseI (phase elseS)]
(wrap (<| _.with-label (function (_ @else))
_.with-label (function (_ @end))
(|>> testI
@@ -207,21 +205,21 @@
elseI
(_.label @end))))))
-(def: #export (let translate inputS register exprS)
+(def: #export (let phase inputS register exprS)
(-> Phase Synthesis Nat Synthesis (Operation Inst))
(do phase.Monad<Operation>
- [inputI (translate inputS)
- exprI (translate exprS)]
+ [inputI (phase inputS)
+ exprI (phase exprS)]
(wrap (|>> inputI
(_.ASTORE register)
exprI))))
-(def: #export (case translate valueS path)
+(def: #export (case phase valueS path)
(-> Phase Synthesis Path (Operation Inst))
(do phase.Monad<Operation>
[@end _.make-label
- valueI (translate valueS)
- pathI (..path translate path @end)]
+ valueI (phase valueS)
+ pathI (..path phase path @end)]
(wrap (|>> _.NULL
valueI
pushI
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 c92ab1026..20c31bd5d 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux
@@ -106,59 +106,8 @@
Def
(let [store-tagI (|>> _.DUP (_.int +0) (_.ILOAD 0) (_.wrap #$.Int) _.AASTORE)
store-flagI (|>> _.DUP (_.int +1) (_.ALOAD 1) _.AASTORE)
- store-valueI (|>> _.DUP (_.int +2) (_.ALOAD 2) _.AASTORE)
- force-textMT ($t.method (list $Object) (#.Some $String) (list))]
- (|>> ($d.method #$.Public $.staticM "force_text" force-textMT
- (<| _.with-label (function (_ @is-null))
- _.with-label (function (_ @normal-object))
- _.with-label (function (_ @array-loop))
- _.with-label (function (_ @within-bounds))
- _.with-label (function (_ @is-first))
- _.with-label (function (_ @elem-end))
- _.with-label (function (_ @fold-end))
- (let [on-normal-objectI (|>> (_.ALOAD 0)
- (_.INVOKEVIRTUAL "java.lang.Object" "toString" ($t.method (list) (#.Some $String) (list)) #0))
- on-null-objectI (_.string "NULL")
- arrayI (|>> (_.ALOAD 0)
- (_.CHECKCAST ($t.descriptor $Object-Array)))
- recurseI (_.INVOKESTATIC //.runtime-class "force_text" force-textMT #0)
- force-elemI (|>> _.DUP arrayI _.SWAP _.AALOAD recurseI)
- swap2 (|>> _.DUP2_X2 ## X,Y => Y,X,Y
- _.POP2 ## Y,X,Y => Y,X
- )
- add-spacingI (|>> (_.string ", ") _.SWAP string-concatI)
- merge-with-totalI (|>> _.DUP_X2 _.POP ## TSIP => TPSI
- swap2 ## TPSI => SITP
- string-concatI ## SITP => SIT
- _.DUP_X2 _.POP ## SIT => TSI
- )
- foldI (|>> _.DUP ## TSI => TSII
- (_.IFEQ @is-first) ## TSI
- force-elemI add-spacingI merge-with-totalI (_.GOTO @elem-end)
- (_.label @is-first) ## TSI
- force-elemI merge-with-totalI
- (_.label @elem-end) ## TSI
- )
- inc-idxI (|>> (_.int +1) _.IADD)
- on-array-objectI (|>> (_.string "[") ## T
- arrayI _.ARRAYLENGTH ## TS
- (_.int +0) ## TSI
- (_.label @array-loop) ## TSI
- _.DUP2
- (_.IF_ICMPGT @within-bounds) ## TSI
- _.POP2 (_.string "]") string-concatI (_.GOTO @fold-end)
- (_.label @within-bounds)
- foldI inc-idxI (_.GOTO @array-loop)
- (_.label @fold-end))])
- (|>> (_.ALOAD 0)
- (_.IFNULL @is-null)
- (_.ALOAD 0)
- (_.INSTANCEOF ($t.descriptor $Object-Array))
- (_.IFEQ @normal-object)
- on-array-objectI _.ARETURN
- (_.label @normal-object) on-normal-objectI _.ARETURN
- (_.label @is-null) on-null-objectI _.ARETURN)))
- ($d.method #$.Public $.staticM "variant_make"
+ store-valueI (|>> _.DUP (_.int +2) (_.ALOAD 2) _.AASTORE)]
+ (|>> ($d.method #$.Public $.staticM "variant_make"
($t.method (list $t.int $Object $Object)
(#.Some $Variant)
(list))
@@ -169,10 +118,6 @@
store-valueI
_.ARETURN)))))
-(def: #export force-textI
- Inst
- (_.INVOKESTATIC //.runtime-class "force_text" ($t.method (list $Object) (#.Some $String) (list)) #0))
-
(def: frac-shiftI Inst (_.double (math.pow +32.0 +2.0)))
(def: frac-methods
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-05 17:06:48 +0000