diff options
author | Eduardo Julian | 2017-11-01 00:51:45 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-11-01 00:51:45 -0400 |
commit | 012f6bd41e527479dddbccbdab10daa78fd9a0fd (patch) | |
tree | 621f344a09acd52736f343d94582b3f1a2f0c5f9 /new-luxc/source/luxc/generator/case.jvm.lux | |
parent | 71d7a4c7206155e09f3e1e1d8699561ea6967382 (diff) |
- Re-organized code-generation, and re-named it "translation".
Diffstat (limited to 'new-luxc/source/luxc/generator/case.jvm.lux')
-rw-r--r-- | new-luxc/source/luxc/generator/case.jvm.lux | 225 |
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)))) |