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.lux227
1 files changed, 114 insertions, 113 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 2aa0586ab..016edf3d2 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux
@@ -6,55 +6,56 @@
[data
[text
format]]
- [language
- ["." compiler ("operation/" Monad<Operation>)
- ["." synthesis (#+ Path Synthesis)]]]]
+ [compiler
+ [default
+ ["." phase ("operation/." Monad<Operation>)
+ ["." synthesis (#+ Path Synthesis)]]]]]
[luxc
[lang
[host
- ["$" jvm (#+ Label Inst Operation Compiler)
+ ["$" jvm (#+ Label Inst Operation Phase)
["$t" type]
- ["$i" inst]]]]]
+ ["_" inst]]]]]
["." // (#+ $Object)
- [runtime]])
+ ["." runtime]])
(def: (pop-altI stack-depth)
(-> Nat Inst)
(.case stack-depth
+0 id
- +1 $i.POP
- +2 $i.POP2
+ +1 _.POP
+ +2 _.POP2
_ ## (n/> +2)
- (|>> $i.POP2
+ (|>> _.POP2
(pop-altI (n/- +2 stack-depth)))))
(def: peekI
Inst
- (|>> $i.DUP
- ($i.INVOKESTATIC //.runtime-class
- "pm_peek"
- ($t.method (list runtime.$Stack)
- (#.Some $Object)
- (list))
- #0)))
+ (|>> _.DUP
+ (_.INVOKESTATIC //.runtime-class
+ "pm_peek"
+ ($t.method (list runtime.$Stack)
+ (#.Some $Object)
+ (list))
+ #0)))
(def: popI
Inst
- (|>> ($i.INVOKESTATIC //.runtime-class
- "pm_pop"
- ($t.method (list runtime.$Stack)
- (#.Some runtime.$Stack)
- (list))
- #0)))
+ (|>> (_.INVOKESTATIC //.runtime-class
+ "pm_pop"
+ ($t.method (list runtime.$Stack)
+ (#.Some runtime.$Stack)
+ (list))
+ #0)))
(def: pushI
Inst
- (|>> ($i.INVOKESTATIC //.runtime-class
- "pm_push"
- ($t.method (list runtime.$Stack $Object)
- (#.Some runtime.$Stack)
- (list))
- #0)))
+ (|>> (_.INVOKESTATIC //.runtime-class
+ "pm_push"
+ ($t.method (list runtime.$Stack $Object)
+ (#.Some runtime.$Stack)
+ (list))
+ #0)))
(def: (path' translate stack-depth @else @end path)
(-> (-> Synthesis (Operation Inst))
@@ -65,45 +66,45 @@
(#synthesis.Bind register)
(operation/wrap (|>> peekI
- ($i.ASTORE register)))
+ (_.ASTORE register)))
(^ (synthesis.path/bit value))
- (operation/wrap (.let [jumpI (.if value $i.IFEQ $i.IFNE)]
+ (operation/wrap (.let [jumpI (.if value _.IFEQ _.IFNE)]
(|>> peekI
- ($i.unwrap #$.Boolean)
+ (_.unwrap #$.Boolean)
(jumpI @else))))
(^ (synthesis.path/i64 value))
(operation/wrap (|>> peekI
- ($i.unwrap #$.Long)
- ($i.long value)
- $i.LCMP
- ($i.IFNE @else)))
+ (_.unwrap #$.Long)
+ (_.long value)
+ _.LCMP
+ (_.IFNE @else)))
(^ (synthesis.path/f64 value))
(operation/wrap (|>> peekI
- ($i.unwrap #$.Double)
- ($i.double value)
- $i.DCMPL
- ($i.IFNE @else)))
+ (_.unwrap #$.Double)
+ (_.double value)
+ _.DCMPL
+ (_.IFNE @else)))
(^ (synthesis.path/text value))
(operation/wrap (|>> peekI
- ($i.string value)
- ($i.INVOKEVIRTUAL "java.lang.Object"
- "equals"
- ($t.method (list $Object)
- (#.Some $t.boolean)
- (list))
- #0)
- ($i.IFEQ @else)))
+ (_.string value)
+ (_.INVOKEVIRTUAL "java.lang.Object"
+ "equals"
+ ($t.method (list $Object)
+ (#.Some $t.boolean)
+ (list))
+ #0)
+ (_.IFEQ @else)))
(#synthesis.Then bodyS)
- (do compiler.Monad<Operation>
+ (do phase.Monad<Operation>
[bodyI (translate bodyS)]
(wrap (|>> (pop-altI stack-depth)
bodyI
- ($i.GOTO @end))))
+ (_.GOTO @end))))
(^template [<pattern> <method> <mod>]
@@ -111,21 +112,21 @@
(operation/wrap (.case (<mod> idx)
+0
(|>> peekI
- ($i.CHECKCAST ($t.descriptor runtime.$Tuple))
- ($i.int 0)
- $i.AALOAD
+ (_.CHECKCAST ($t.descriptor runtime.$Tuple))
+ (_.int 0)
+ _.AALOAD
pushI)
idx
(|>> peekI
- ($i.CHECKCAST ($t.descriptor runtime.$Tuple))
- ($i.int (.int idx))
- ($i.INVOKESTATIC //.runtime-class
- <method>
- ($t.method (list runtime.$Tuple $t.int)
- (#.Some $Object)
- (list))
- #0)
+ (_.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 "pm_left" .id]
[synthesis.member/right "pm_right" .inc])
@@ -133,41 +134,41 @@
(^template [<pattern> <flag> <mod>]
(^ (<pattern> idx))
(.let [idx (<mod> idx)]
- (operation/wrap (<| $i.with-label (function (_ @success))
- $i.with-label (function (_ @fail))
+ (operation/wrap (<| _.with-label (function (_ @success))
+ _.with-label (function (_ @fail))
(|>> peekI
- ($i.CHECKCAST ($t.descriptor runtime.$Variant))
- ($i.int (.int idx))
+ (_.CHECKCAST ($t.descriptor runtime.$Variant))
+ (_.int (.int idx))
<flag>
- ($i.INVOKESTATIC //.runtime-class "pm_variant"
- ($t.method (list runtime.$Variant runtime.$Tag runtime.$Flag)
- (#.Some runtime.$Datum)
- (list))
- #0)
- $i.DUP
- ($i.IFNULL @fail)
- ($i.GOTO @success)
- ($i.label @fail)
- $i.POP
- ($i.GOTO @else)
- ($i.label @success)
+ (_.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 $i.NULL .id]
- [synthesis.side/right ($i.string "") .inc])
+ ([synthesis.side/left _.NULL .id]
+ [synthesis.side/right (_.string "") .inc])
(#synthesis.Alt leftP rightP)
- (do compiler.Monad<Operation>
- [@alt-else $i.make-label
+ (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)]
- (wrap (|>> $i.DUP
+ (wrap (|>> _.DUP
leftI
- ($i.label @alt-else)
- $i.POP
+ (_.label @alt-else)
+ _.POP
rightI)))
(#synthesis.Seq leftP rightP)
- (do compiler.Monad<Operation>
+ (do phase.Monad<Operation>
[leftI (path' translate stack-depth @else @end leftP)
rightI (path' translate stack-depth @else @end rightP)]
(wrap (|>> leftI
@@ -175,55 +176,55 @@
))
(def: (path translate path @end)
- (-> Compiler Path Label (Operation Inst))
- (do compiler.Monad<Operation>
- [@else $i.make-label
+ (-> Phase Path Label (Operation Inst))
+ (do phase.Monad<Operation>
+ [@else _.make-label
pathI (..path' translate +1 @else @end path)]
(wrap (|>> pathI
- ($i.label @else)
- $i.POP
- ($i.INVOKESTATIC //.runtime-class
- "pm_fail"
- ($t.method (list) #.None (list))
- #0)
- $i.NULL
- ($i.GOTO @end)))))
+ (_.label @else)
+ _.POP
+ (_.INVOKESTATIC //.runtime-class
+ "pm_fail"
+ ($t.method (list) #.None (list))
+ #0)
+ _.NULL
+ (_.GOTO @end)))))
(def: #export (if translate testS thenS elseS)
- (-> Compiler Synthesis Synthesis Synthesis (Operation Inst))
- (do compiler.Monad<Operation>
+ (-> Phase Synthesis Synthesis Synthesis (Operation Inst))
+ (do phase.Monad<Operation>
[testI (translate testS)
thenI (translate thenS)
elseI (translate elseS)]
- (wrap (<| $i.with-label (function (_ @else))
- $i.with-label (function (_ @end))
+ (wrap (<| _.with-label (function (_ @else))
+ _.with-label (function (_ @end))
(|>> testI
- ($i.unwrap #$.Boolean)
- ($i.IFEQ @else)
+ (_.unwrap #$.Boolean)
+ (_.IFEQ @else)
thenI
- ($i.GOTO @end)
- ($i.label @else)
+ (_.GOTO @end)
+ (_.label @else)
elseI
- ($i.label @end))))))
+ (_.label @end))))))
(def: #export (let translate inputS register exprS)
- (-> Compiler Synthesis Nat Synthesis (Operation Inst))
- (do compiler.Monad<Operation>
+ (-> Phase Synthesis Nat Synthesis (Operation Inst))
+ (do phase.Monad<Operation>
[inputI (translate inputS)
exprI (translate exprS)]
(wrap (|>> inputI
- ($i.ASTORE register)
+ (_.ASTORE register)
exprI))))
(def: #export (case translate valueS path)
- (-> Compiler Synthesis Path (Operation Inst))
- (do compiler.Monad<Operation>
- [@end $i.make-label
+ (-> Phase Synthesis Path (Operation Inst))
+ (do phase.Monad<Operation>
+ [@end _.make-label
valueI (translate valueS)
pathI (..path translate path @end)]
(wrap (|>> valueI
- $i.NULL
- $i.SWAP
+ _.NULL
+ _.SWAP
pushI
pathI
- ($i.label @end)))))
+ (_.label @end)))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-22 08:18:48 +0000