diff options
author | Eduardo Julian | 2017-09-17 00:38:24 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-09-17 00:38:24 -0400 |
commit | c95fa2cc7db042fdde7250479727650f43b087a1 (patch) | |
tree | cf4cc5a1829fa717b4dad17683251af56c54afa3 /new-luxc/source/luxc/generator/case.jvm.lux | |
parent | 18fa9ac1ded14e8e6b96609ff1fb6f98af47580f (diff) |
- Added pattern-matching compilation.
Diffstat (limited to 'new-luxc/source/luxc/generator/case.jvm.lux')
-rw-r--r-- | new-luxc/source/luxc/generator/case.jvm.lux | 214 |
1 files changed, 214 insertions, 0 deletions
diff --git a/new-luxc/source/luxc/generator/case.jvm.lux b/new-luxc/source/luxc/generator/case.jvm.lux new file mode 100644 index 000000000..1f351325e --- /dev/null +++ b/new-luxc/source/luxc/generator/case.jvm.lux @@ -0,0 +1,214 @@ +(;module: + lux + (lux (control [monad #+ do]) + [macro "lux/" Monad<Lux>]) + (luxc (lang ["ls" synthesis]) + (generator (host ["$" jvm] + (jvm ["$t" type] + ["$i" inst])) + [expr])) + [../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 ../runtime;runtime-name + "pm_peek" + ($t;method (list ../runtime;$Stack) + (#;Some $Object) + (list)) + false))) + +(def: popI + $;Inst + (|>. ($i;INVOKESTATIC ../runtime;runtime-name + "pm_pop" + ($t;method (list ../runtime;$Stack) + (#;Some ../runtime;$Stack) + (list)) + false))) + +(def: pushI + $;Inst + (|>. ($i;INVOKESTATIC ../runtime;runtime-name + "pm_push" + ($t;method (list ../runtime;$Stack $Object) + (#;Some ../runtime;$Stack) + (list)) + false))) + +(def: (generate-pattern' stack-depth @else @end path) + (-> Nat $;Label $;Label ls;Path (Lux $;Inst)) + (case path + (#ls;ExecP bodyS) + (do macro;Monad<Lux> + [bodyI (expr;generate bodyS)] + (wrap (|>. (pop-altI stack-depth) + bodyI + ($i;GOTO @end)))) + + #ls;UnitP + (lux/wrap popI) + + (#ls;BindP register) + (lux/wrap (|>. peekI + ($i;ASTORE register) + popI)) + + (#ls;BoolP value) + (lux/wrap (let [jumpI (if value $i;IFEQ $i;IFNE)] + (|>. peekI + ($i;unwrap #$;Boolean) + (jumpI @else)))) + + (^template [<tag> <prep>] + (<tag> value) + (lux/wrap (|>. peekI + ($i;unwrap #$;Long) + ($i;long (|> value <prep>)) + $i;LCMP + ($i;IFNE @else)))) + ([#ls;NatP (:! Int)] + [#ls;IntP (: Int)] + [#ls;DegP (:! Int)]) + + (#ls;FracP value) + (lux/wrap (|>. peekI + ($i;unwrap #$;Double) + ($i;double value) + $i;DCMPL + ($i;IFNE @else))) + + (#ls;TextP value) + (lux/wrap (|>. peekI + ($i;string value) + ($i;INVOKEVIRTUAL "java.lang.Object" + "equals" + ($t;method (list $Object) + (#;Some $t;boolean) + (list)) + false) + ($i;IFEQ @else))) + + (#ls;TupleP idx subP) + (do macro;Monad<Lux> + [subI (generate-pattern' stack-depth @else @end subP) + #let [[idx tail?] (case idx + (#;Left idx) + [idx false] + + (#;Right idx) + [idx true])]] + (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 ../runtime;runtime-name + (if tail? "pm_right" "pm_left") + ($t;method (list ../runtime;$Tuple $t;int) + (#;Some $Object) + (list)) + false) + pushI + subI)))) + + (#ls;VariantP idx subP) + (do macro;Monad<Lux> + [subI (generate-pattern' stack-depth @else @end subP) + #let [[idx last?] (case idx + (#;Left idx) + [idx false] + + (#;Right idx) + [idx true]) + flagI (if last? + ($i;string "") + $i;NULL)]] + (wrap (<| $i;with-label (function [@success]) + $i;with-label (function [@fail]) + (|>. peekI + ($i;CHECKCAST ($t;descriptor ../runtime;$Variant)) + ($i;int (nat-to-int idx)) + flagI + ($i;INVOKESTATIC ../runtime;runtime-name "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)))) + + (#ls;SeqP leftP rightP) + (do macro;Monad<Lux> + [leftI (generate-pattern' stack-depth @else @end leftP) + rightI (generate-pattern' stack-depth @else @end rightP)] + (wrap (|>. leftI + rightI))) + + (#ls;AltP leftP rightP) + (do macro;Monad<Lux> + [@alt-else $i;make-label + leftI (generate-pattern' (n.inc stack-depth) @alt-else @end leftP) + rightI (generate-pattern' stack-depth @else @end rightP)] + (wrap (|>. $i;DUP + leftI + ($i;label @alt-else) + $i;POP + rightI))) + )) + +(def: (generate-pattern path @end) + (-> ls;Path $;Label (Lux $;Inst)) + (do macro;Monad<Lux> + [@else $i;make-label + pathI (generate-pattern' +1 @else @end path)] + (wrap (|>. pathI + ($i;label @else) + $i;POP + ($i;INVOKESTATIC ../runtime;runtime-name + "pm_fail" + ($t;method (list) #;None (list)) + false) + $i;NULL + ($i;GOTO @end))))) + +(def: #export (generate valueS path) + (-> ls;Synthesis ls;Path (Lux $;Inst)) + (do macro;Monad<Lux> + [@end $i;make-label + valueI (expr;generate valueS) + pathI (generate-pattern path @end)] + (wrap (|>. valueI + $i;NULL + $i;SWAP + pushI + pathI + ($i;label @end))))) |