diff options
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.lux | 227 |
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))))) |