aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux
diff options
context:
space:
mode:
authorEduardo Julian2019-04-16 20:53:41 -0400
committerEduardo Julian2019-04-16 20:53:41 -0400
commit697707d8560a5735be38fd9b1ff91a02c289d48f (patch)
tree7f9e81974c9ec3ede82e7f2392ebba037e3e9df8 /new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux
parent42248854f0cb5e3364e6aae25527cee65cbda3e8 (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.lux235
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)))))