aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/case.jvm.lux
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/case.jvm.lux')
-rw-r--r--new-luxc/source/luxc/lang/translation/case.jvm.lux262
1 files changed, 131 insertions, 131 deletions
diff --git a/new-luxc/source/luxc/lang/translation/case.jvm.lux b/new-luxc/source/luxc/lang/translation/case.jvm.lux
index 3363e007c..b693f50b8 100644
--- a/new-luxc/source/luxc/lang/translation/case.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/case.jvm.lux
@@ -1,130 +1,130 @@
-(;module:
+(.module:
lux
(lux (control [monad #+ do]
["ex" exception #+ exception:])
(data text/format)
[macro "macro/" Monad<Meta>])
(luxc ["_" lang]
- (lang [";L" host]
+ (lang [".L" host]
(host ["$" jvm]
(jvm ["$t" type]
["$i" inst]))
["ls" synthesis]))
[//runtime])
-(def: $Object $;Type ($t;class "java.lang.Object" (list)))
+(def: $Object $.Type ($t.class "java.lang.Object" (list)))
(def: (pop-altI stack-depth)
- (-> Nat $;Inst)
+ (-> Nat $.Inst)
(case stack-depth
+0 id
- +1 $i;POP
- +2 $i;POP2
- _ ## (n.> +2)
- (|>. $i;POP2
- (pop-altI (n.- +2 stack-depth)))))
+ +1 $i.POP
+ +2 $i.POP2
+ _ ## (n/> +2)
+ (|>> $i.POP2
+ (pop-altI (n/- +2 stack-depth)))))
(def: peekI
- $;Inst
- (|>. $i;DUP
- ($i;INVOKESTATIC hostL;runtime-class
+ $.Inst
+ (|>> $i.DUP
+ ($i.INVOKESTATIC hostL.runtime-class
"pm_peek"
- ($t;method (list //runtime;$Stack)
- (#;Some $Object)
+ ($t.method (list //runtime.$Stack)
+ (#.Some $Object)
(list))
false)))
(def: popI
- $;Inst
- (|>. ($i;INVOKESTATIC hostL;runtime-class
+ $.Inst
+ (|>> ($i.INVOKESTATIC hostL.runtime-class
"pm_pop"
- ($t;method (list //runtime;$Stack)
- (#;Some //runtime;$Stack)
+ ($t.method (list //runtime.$Stack)
+ (#.Some //runtime.$Stack)
(list))
false)))
(def: pushI
- $;Inst
- (|>. ($i;INVOKESTATIC hostL;runtime-class
+ $.Inst
+ (|>> ($i.INVOKESTATIC hostL.runtime-class
"pm_push"
- ($t;method (list //runtime;$Stack $Object)
- (#;Some //runtime;$Stack)
+ ($t.method (list //runtime.$Stack $Object)
+ (#.Some //runtime.$Stack)
(list))
false)))
(exception: #export Unrecognized-Path)
(def: (translate-path' translate stack-depth @else @end path)
- (-> (-> ls;Synthesis (Meta $;Inst))
- Nat $;Label $;Label ls;Path (Meta $;Inst))
+ (-> (-> ls.Synthesis (Meta $.Inst))
+ Nat $.Label $.Label ls.Path (Meta $.Inst))
(case path
- (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))])
- (do macro;Monad<Meta>
+ (^ [_ (#.Form (list [_ (#.Text "lux case exec")] bodyS))])
+ (do macro.Monad<Meta>
[bodyI (translate bodyS)]
- (wrap (|>. (pop-altI stack-depth)
+ (wrap (|>> (pop-altI stack-depth)
bodyI
- ($i;GOTO @end))))
+ ($i.GOTO @end))))
- (^ [_ (#;Form (list [_ (#;Text "lux case pop")]))])
+ (^ [_ (#.Form (list [_ (#.Text "lux case pop")]))])
(macro/wrap popI)
- (^ [_ (#;Form (list [_ (#;Text "lux case bind")] [_ (#;Nat register)]))])
- (macro/wrap (|>. peekI
- ($i;ASTORE register)))
+ (^ [_ (#.Form (list [_ (#.Text "lux case bind")] [_ (#.Nat register)]))])
+ (macro/wrap (|>> peekI
+ ($i.ASTORE register)))
- [_ (#;Bool value)]
- (macro/wrap (let [jumpI (if value $i;IFEQ $i;IFNE)]
- (|>. peekI
- ($i;unwrap #$;Boolean)
+ [_ (#.Bool value)]
+ (macro/wrap (let [jumpI (if value $i.IFEQ $i.IFNE)]
+ (|>> peekI
+ ($i.unwrap #$.Boolean)
(jumpI @else))))
(^template [<tag> <prep>]
[_ (<tag> value)]
- (macro/wrap (|>. peekI
- ($i;unwrap #$;Long)
- ($i;long (|> value <prep>))
- $i;LCMP
- ($i;IFNE @else))))
- ([#;Nat (:! Int)]
- [#;Int (: Int)]
- [#;Deg (:! Int)])
-
- [_ (#;Frac value)]
- (macro/wrap (|>. peekI
- ($i;unwrap #$;Double)
- ($i;double value)
- $i;DCMPL
- ($i;IFNE @else)))
+ (macro/wrap (|>> peekI
+ ($i.unwrap #$.Long)
+ ($i.long (|> value <prep>))
+ $i.LCMP
+ ($i.IFNE @else))))
+ ([#.Nat (:! Int)]
+ [#.Int (: Int)]
+ [#.Deg (:! Int)])
+
+ [_ (#.Frac value)]
+ (macro/wrap (|>> peekI
+ ($i.unwrap #$.Double)
+ ($i.double value)
+ $i.DCMPL
+ ($i.IFNE @else)))
- [_ (#;Text value)]
- (macro/wrap (|>. peekI
- ($i;string value)
- ($i;INVOKEVIRTUAL "java.lang.Object"
+ [_ (#.Text value)]
+ (macro/wrap (|>> peekI
+ ($i.string value)
+ ($i.INVOKEVIRTUAL "java.lang.Object"
"equals"
- ($t;method (list $Object)
- (#;Some $t;boolean)
+ ($t.method (list $Object)
+ (#.Some $t.boolean)
(list))
false)
- ($i;IFEQ @else)))
+ ($i.IFEQ @else)))
(^template [<special> <method>]
- (^ [_ (#;Form (list [_ (#;Text <special>)] [_ (#;Nat idx)]))])
+ (^ [_ (#.Form (list [_ (#.Text <special>)] [_ (#.Nat idx)]))])
(macro/wrap (case idx
+0
- (|>. peekI
- ($i;CHECKCAST ($t;descriptor //runtime;$Tuple))
- ($i;int 0)
- $i;AALOAD
+ (|>> peekI
+ ($i.CHECKCAST ($t.descriptor //runtime.$Tuple))
+ ($i.int 0)
+ $i.AALOAD
pushI)
_
- (|>. peekI
- ($i;CHECKCAST ($t;descriptor //runtime;$Tuple))
- ($i;int (nat-to-int idx))
- ($i;INVOKESTATIC hostL;runtime-class
+ (|>> peekI
+ ($i.CHECKCAST ($t.descriptor //runtime.$Tuple))
+ ($i.int (nat-to-int idx))
+ ($i.INVOKESTATIC hostL.runtime-class
<method>
- ($t;method (list //runtime;$Tuple $t;int)
- (#;Some $Object)
+ ($t.method (list //runtime.$Tuple $t.int)
+ (#.Some $Object)
(list))
false)
pushI))))
@@ -132,99 +132,99 @@
["lux case tuple right" "pm_right"])
(^template [<special> <flag>]
- (^ [_ (#;Form (list [_ (#;Text <special>)] [_ (#;Nat idx)]))])
- (macro/wrap (<| $i;with-label (function [@success])
- $i;with-label (function [@fail])
- (|>. peekI
- ($i;CHECKCAST ($t;descriptor //runtime;$Variant))
- ($i;int (nat-to-int idx))
+ (^ [_ (#.Form (list [_ (#.Text <special>)] [_ (#.Nat idx)]))])
+ (macro/wrap (<| $i.with-label (function [@success])
+ $i.with-label (function [@fail])
+ (|>> peekI
+ ($i.CHECKCAST ($t.descriptor //runtime.$Variant))
+ ($i.int (nat-to-int idx))
<flag>
- ($i;INVOKESTATIC hostL;runtime-class "pm_variant"
- ($t;method (list //runtime;$Variant //runtime;$Tag //runtime;$Flag)
- (#;Some //runtime;$Datum)
+ ($i.INVOKESTATIC hostL.runtime-class "pm_variant"
+ ($t.method (list //runtime.$Variant //runtime.$Tag //runtime.$Flag)
+ (#.Some //runtime.$Datum)
(list))
false)
- $i;DUP
- ($i;IFNULL @fail)
- ($i;GOTO @success)
- ($i;label @fail)
- $i;POP
- ($i;GOTO @else)
- ($i;label @success)
+ $i.DUP
+ ($i.IFNULL @fail)
+ ($i.GOTO @success)
+ ($i.label @fail)
+ $i.POP
+ ($i.GOTO @else)
+ ($i.label @success)
pushI))))
- (["lux case variant left" $i;NULL]
- ["lux case variant right" ($i;string "")])
+ (["lux case variant left" $i.NULL]
+ ["lux case variant right" ($i.string "")])
- (^ [_ (#;Form (list [_ (#;Text "lux case seq")] leftP rightP))])
- (do macro;Monad<Meta>
+ (^ [_ (#.Form (list [_ (#.Text "lux case seq")] leftP rightP))])
+ (do macro.Monad<Meta>
[leftI (translate-path' translate stack-depth @else @end leftP)
rightI (translate-path' translate stack-depth @else @end rightP)]
- (wrap (|>. leftI
+ (wrap (|>> leftI
rightI)))
- (^ [_ (#;Form (list [_ (#;Text "lux case alt")] leftP rightP))])
- (do macro;Monad<Meta>
- [@alt-else $i;make-label
- leftI (translate-path' translate (n.inc stack-depth) @alt-else @end leftP)
+ (^ [_ (#.Form (list [_ (#.Text "lux case alt")] leftP rightP))])
+ (do macro.Monad<Meta>
+ [@alt-else $i.make-label
+ leftI (translate-path' translate (n/inc stack-depth) @alt-else @end leftP)
rightI (translate-path' translate stack-depth @else @end rightP)]
- (wrap (|>. $i;DUP
+ (wrap (|>> $i.DUP
leftI
- ($i;label @alt-else)
- $i;POP
+ ($i.label @alt-else)
+ $i.POP
rightI)))
_
- (_;throw Unrecognized-Path (%code path))))
+ (_.throw Unrecognized-Path (%code path))))
(def: (translate-path translate path @end)
- (-> (-> ls;Synthesis (Meta $;Inst))
- ls;Path $;Label (Meta $;Inst))
- (do macro;Monad<Meta>
- [@else $i;make-label
+ (-> (-> ls.Synthesis (Meta $.Inst))
+ ls.Path $.Label (Meta $.Inst))
+ (do macro.Monad<Meta>
+ [@else $i.make-label
pathI (translate-path' translate +1 @else @end path)]
- (wrap (|>. pathI
- ($i;label @else)
- $i;POP
- ($i;INVOKESTATIC hostL;runtime-class
+ (wrap (|>> pathI
+ ($i.label @else)
+ $i.POP
+ ($i.INVOKESTATIC hostL.runtime-class
"pm_fail"
- ($t;method (list) #;None (list))
+ ($t.method (list) #.None (list))
false)
- $i;NULL
- ($i;GOTO @end)))))
+ $i.NULL
+ ($i.GOTO @end)))))
(def: #export (translate-if testI thenI elseI)
- (-> $;Inst $;Inst $;Inst $;Inst)
- (<| $i;with-label (function [@else])
- $i;with-label (function [@end])
- (|>. testI
- ($i;unwrap #$;Boolean)
- ($i;IFEQ @else)
+ (-> $.Inst $.Inst $.Inst $.Inst)
+ (<| $i.with-label (function [@else])
+ $i.with-label (function [@end])
+ (|>> testI
+ ($i.unwrap #$.Boolean)
+ ($i.IFEQ @else)
thenI
- ($i;GOTO @end)
- ($i;label @else)
+ ($i.GOTO @end)
+ ($i.label @else)
elseI
- ($i;label @end))))
+ ($i.label @end))))
(def: #export (translate-case translate valueS path)
- (-> (-> ls;Synthesis (Meta $;Inst))
- ls;Synthesis ls;Path (Meta $;Inst))
- (do macro;Monad<Meta>
- [@end $i;make-label
+ (-> (-> ls.Synthesis (Meta $.Inst))
+ ls.Synthesis ls.Path (Meta $.Inst))
+ (do macro.Monad<Meta>
+ [@end $i.make-label
valueI (translate valueS)
pathI (translate-path translate path @end)]
- (wrap (|>. valueI
- $i;NULL
- $i;SWAP
+ (wrap (|>> valueI
+ $i.NULL
+ $i.SWAP
pushI
pathI
- ($i;label @end)))))
+ ($i.label @end)))))
(def: #export (translate-let translate register inputS exprS)
- (-> (-> ls;Synthesis (Meta $;Inst))
- Nat ls;Synthesis ls;Synthesis (Meta $;Inst))
- (do macro;Monad<Meta>
+ (-> (-> ls.Synthesis (Meta $.Inst))
+ Nat ls.Synthesis ls.Synthesis (Meta $.Inst))
+ (do macro.Monad<Meta>
[inputI (translate inputS)
exprI (translate exprS)]
- (wrap (|>. inputI
- ($i;ASTORE register)
+ (wrap (|>> inputI
+ ($i.ASTORE register)
exprI))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-24 05:49:27 +0000