aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux')
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux96
1 files changed, 47 insertions, 49 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