diff options
author | Eduardo Julian | 2019-04-16 20:53:41 -0400 |
---|---|---|
committer | Eduardo Julian | 2019-04-16 20:53:41 -0400 |
commit | 697707d8560a5735be38fd9b1ff91a02c289d48f (patch) | |
tree | 7f9e81974c9ec3ede82e7f2392ebba037e3e9df8 /new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux | |
parent | 42248854f0cb5e3364e6aae25527cee65cbda3e8 (diff) |
Made some new-luxc modules "old".
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 | 235 |
1 files changed, 0 insertions, 235 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 deleted file mode 100644 index 43d11c71e..000000000 --- a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux +++ /dev/null @@ -1,235 +0,0 @@ -(.module: - [lux (#- if let case) - [abstract - [monad (#+ do)]] - [control - ["." function] - ["ex" exception (#+ exception:)]] - [data - [text - format]] - [tool - [compiler - ["." synthesis (#+ Path Synthesis)] - ["." phase ("operation/." monad)]]]] - [luxc - [lang - [host - ["$" jvm (#+ Label Inst Operation Phase) - ["$t" type] - ["_" inst]]]]] - ["." // (#+ $Object) - ["." runtime]]) - -(def: (pop-altI stack-depth) - (-> Nat Inst) - (.case stack-depth - 0 function.identity - 1 _.POP - 2 _.POP2 - _ ## (n/> 2) - (|>> _.POP2 - (pop-altI (n/- 2 stack-depth))))) - -(def: peekI - Inst - (|>> _.DUP - (_.INVOKESTATIC //.runtime-class - "pm_peek" - ($t.method (list runtime.$Stack) - (#.Some $Object) - (list)) - #0))) - -(def: popI - Inst - (|>> (_.INVOKESTATIC //.runtime-class - "pm_pop" - ($t.method (list runtime.$Stack) - (#.Some runtime.$Stack) - (list)) - #0))) - -(def: pushI - Inst - (|>> (_.INVOKESTATIC //.runtime-class - "pm_push" - ($t.method (list runtime.$Stack $Object) - (#.Some runtime.$Stack) - (list)) - #0))) - -(def: (path' phase stack-depth @else @end path) - (-> Phase Nat Label Label Path (Operation Inst)) - (.case path - #synthesis.Pop - (operation/wrap popI) - - (#synthesis.Bind register) - (operation/wrap (|>> peekI - (_.ASTORE register))) - - (^ (synthesis.path/bit value)) - (operation/wrap (.let [jumpI (.if value _.IFEQ _.IFNE)] - (|>> peekI - (_.unwrap #$.Boolean) - (jumpI @else)))) - - (^ (synthesis.path/i64 value)) - (operation/wrap (|>> peekI - (_.unwrap #$.Long) - (_.long (.int value)) - _.LCMP - (_.IFNE @else))) - - (^ (synthesis.path/f64 value)) - (operation/wrap (|>> peekI - (_.unwrap #$.Double) - (_.double value) - _.DCMPL - (_.IFNE @else))) - - (^ (synthesis.path/text value)) - (operation/wrap (|>> peekI - (_.string value) - (_.INVOKEVIRTUAL "java.lang.Object" - "equals" - ($t.method (list $Object) - (#.Some $t.boolean) - (list)) - #0) - (_.IFEQ @else))) - - (#synthesis.Then bodyS) - (do phase.monad - [bodyI (phase bodyS)] - (wrap (|>> (pop-altI stack-depth) - bodyI - (_.GOTO @end)))) - - - (^template [<pattern> <flag> <prepare>] - (^ (<pattern> 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 function.identity] - [synthesis.side/right (_.string "") .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 - [@alt-else _.make-label - leftI (path' phase (inc stack-depth) @alt-else @end leftP) - rightI (path' phase stack-depth @else @end rightP)] - (wrap (|>> _.DUP - leftI - (_.label @alt-else) - _.POP - rightI))) - - (#synthesis.Seq leftP rightP) - (do phase.monad - [leftI (path' phase stack-depth @else @end leftP) - rightI (path' phase stack-depth @else @end rightP)] - (wrap (|>> leftI - rightI))) - )) - -(def: (path phase path @end) - (-> Phase Path Label (Operation Inst)) - (do phase.monad - [@else _.make-label - pathI (..path' phase 1 @else @end path)] - (wrap (|>> pathI - (_.label @else) - _.POP - (_.INVOKESTATIC //.runtime-class - "pm_fail" - ($t.method (list) #.None (list)) - #0) - _.NULL - (_.GOTO @end))))) - -(def: #export (if phase testS thenS elseS) - (-> Phase Synthesis Synthesis Synthesis (Operation Inst)) - (do phase.monad - [testI (phase testS) - thenI (phase thenS) - elseI (phase elseS)] - (wrap (<| _.with-label (function (_ @else)) - _.with-label (function (_ @end)) - (|>> testI - (_.unwrap #$.Boolean) - (_.IFEQ @else) - thenI - (_.GOTO @end) - (_.label @else) - elseI - (_.label @end)))))) - -(def: #export (let phase inputS register exprS) - (-> Phase Synthesis Nat Synthesis (Operation Inst)) - (do phase.monad - [inputI (phase inputS) - exprI (phase exprS)] - (wrap (|>> inputI - (_.ASTORE register) - exprI)))) - -(def: #export (case phase valueS path) - (-> Phase Synthesis Path (Operation Inst)) - (do phase.monad - [@end _.make-label - valueI (phase valueS) - pathI (..path phase path @end)] - (wrap (|>> _.NULL - valueI - pushI - pathI - (_.label @end))))) |