aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/generator/case.jvm.lux
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/generator/case.jvm.lux')
-rw-r--r--new-luxc/source/luxc/generator/case.jvm.lux225
1 files changed, 0 insertions, 225 deletions
diff --git a/new-luxc/source/luxc/generator/case.jvm.lux b/new-luxc/source/luxc/generator/case.jvm.lux
deleted file mode 100644
index a9ea4482a..000000000
--- a/new-luxc/source/luxc/generator/case.jvm.lux
+++ /dev/null
@@ -1,225 +0,0 @@
-(;module:
- lux
- (lux (control [monad #+ do]
- ["ex" exception #+ exception:])
- (data text/format)
- [meta "meta/" Monad<Meta>])
- (luxc ["_" base]
- [";L" host]
- (host ["$" jvm]
- (jvm ["$t" type]
- ["$i" inst]))
- (lang ["ls" synthesis]))
- [../runtime])
-
-(def: $Object $;Type ($t;class "java.lang.Object" (list)))
-
-(def: (pop-altI stack-depth)
- (-> Nat $;Inst)
- (case stack-depth
- +0 id
- +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
- "pm_peek"
- ($t;method (list ../runtime;$Stack)
- (#;Some $Object)
- (list))
- false)))
-
-(def: popI
- $;Inst
- (|>. ($i;INVOKESTATIC hostL;runtime-class
- "pm_pop"
- ($t;method (list ../runtime;$Stack)
- (#;Some ../runtime;$Stack)
- (list))
- false)))
-
-(def: pushI
- $;Inst
- (|>. ($i;INVOKESTATIC hostL;runtime-class
- "pm_push"
- ($t;method (list ../runtime;$Stack $Object)
- (#;Some ../runtime;$Stack)
- (list))
- false)))
-
-(exception: #export Unrecognized-Path)
-
-(def: (generate-path' generate stack-depth @else @end path)
- (-> (-> ls;Synthesis (Meta $;Inst))
- Nat $;Label $;Label ls;Path (Meta $;Inst))
- (case path
- (^ [_ (#;Form (list [_ (#;Text "lux case exec")] bodyS))])
- (do meta;Monad<Meta>
- [bodyI (generate bodyS)]
- (wrap (|>. (pop-altI stack-depth)
- bodyI
- ($i;GOTO @end))))
-
- (^ [_ (#;Form (list [_ (#;Text "lux case pop")]))])
- (meta/wrap popI)
-
- (^ [_ (#;Form (list [_ (#;Text "lux case bind")] [_ (#;Nat register)]))])
- (meta/wrap (|>. peekI
- ($i;ASTORE register)
- popI))
-
- [_ (#;Bool value)]
- (meta/wrap (let [jumpI (if value $i;IFEQ $i;IFNE)]
- (|>. peekI
- ($i;unwrap #$;Boolean)
- (jumpI @else))))
-
- (^template [<tag> <prep>]
- [_ (<tag> value)]
- (meta/wrap (|>. peekI
- ($i;unwrap #$;Long)
- ($i;long (|> value <prep>))
- $i;LCMP
- ($i;IFNE @else))))
- ([#;Nat (:! Int)]
- [#;Int (: Int)]
- [#;Deg (:! Int)])
-
- [_ (#;Frac value)]
- (meta/wrap (|>. peekI
- ($i;unwrap #$;Double)
- ($i;double value)
- $i;DCMPL
- ($i;IFNE @else)))
-
- [_ (#;Text value)]
- (meta/wrap (|>. peekI
- ($i;string value)
- ($i;INVOKEVIRTUAL "java.lang.Object"
- "equals"
- ($t;method (list $Object)
- (#;Some $t;boolean)
- (list))
- false)
- ($i;IFEQ @else)))
-
- (^template [<special> <method>]
- (^ [_ (#;Form (list [_ (#;Text <special>)] [_ (#;Nat idx)] subP))])
- (do meta;Monad<Meta>
- [subI (generate-path' generate stack-depth @else @end subP)]
- (wrap (case idx
- +0
- (|>. peekI
- ($i;CHECKCAST ($t;descriptor ../runtime;$Tuple))
- ($i;int 0)
- $i;AALOAD
- pushI
- subI)
-
- _
- (|>. 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)
- (list))
- false)
- pushI
- subI)))))
- (["lux case tuple left" "pm_left"]
- ["lux case tuple right" "pm_right"])
-
- (^template [<special> <flag>]
- (^ [_ (#;Form (list [_ (#;Text <special>)] [_ (#;Nat idx)] subP))])
- (do meta;Monad<Meta>
- [subI (generate-path' generate stack-depth @else @end subP)]
- (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)
- (list))
- false)
- $i;DUP
- ($i;IFNULL @fail)
- ($i;GOTO @success)
- ($i;label @fail)
- $i;POP
- ($i;GOTO @else)
- ($i;label @success)
- pushI
- subI)))))
- (["lux case variant left" $i;NULL]
- ["lux case variant right" ($i;string "")])
-
- (^ [_ (#;Form (list [_ (#;Text "lux case seq")] leftP rightP))])
- (do meta;Monad<Meta>
- [leftI (generate-path' generate stack-depth @else @end leftP)
- rightI (generate-path' generate stack-depth @else @end rightP)]
- (wrap (|>. leftI
- rightI)))
-
- (^ [_ (#;Form (list [_ (#;Text "lux case alt")] leftP rightP))])
- (do meta;Monad<Meta>
- [@alt-else $i;make-label
- leftI (generate-path' generate (n.inc stack-depth) @alt-else @end leftP)
- rightI (generate-path' generate stack-depth @else @end rightP)]
- (wrap (|>. $i;DUP
- leftI
- ($i;label @alt-else)
- $i;POP
- rightI)))
-
- _
- (_;throw Unrecognized-Path (%code path))))
-
-(def: (generate-path generate path @end)
- (-> (-> ls;Synthesis (Meta $;Inst))
- ls;Path $;Label (Meta $;Inst))
- (do meta;Monad<Meta>
- [@else $i;make-label
- pathI (generate-path' generate +1 @else @end path)]
- (wrap (|>. pathI
- ($i;label @else)
- $i;POP
- ($i;INVOKESTATIC hostL;runtime-class
- "pm_fail"
- ($t;method (list) #;None (list))
- false)
- $i;NULL
- ($i;GOTO @end)))))
-
-(def: #export (generate-case generate valueS path)
- (-> (-> ls;Synthesis (Meta $;Inst))
- ls;Synthesis ls;Path (Meta $;Inst))
- (do meta;Monad<Meta>
- [@end $i;make-label
- valueI (generate valueS)
- pathI (generate-path generate path @end)]
- (wrap (|>. valueI
- $i;NULL
- $i;SWAP
- pushI
- pathI
- ($i;label @end)))))
-
-(def: #export (generate-let generate register inputS exprS)
- (-> (-> ls;Synthesis (Meta $;Inst))
- Nat ls;Synthesis ls;Synthesis (Meta $;Inst))
- (do meta;Monad<Meta>
- [inputI (generate inputS)
- exprI (generate exprS)]
- (wrap (|>. inputI
- ($i;ASTORE register)
- exprI))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-05 15:17:14 +0000