diff options
author | Eduardo Julian | 2017-11-29 22:49:56 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-11-29 22:49:56 -0400 |
commit | 4433c9bcd6c6cac44c018aad2e21a5b4d7cc4896 (patch) | |
tree | 0c166db6e01b41dfadd01801b5242967f2363b7d /new-luxc/source/luxc/lang/translation/case.jvm.lux | |
parent | 77c113a3455cdbc4bb485a94f67f392480cdcfbf (diff) |
- Adapted main codebase to the latest syntatic changes.
Diffstat (limited to '')
-rw-r--r-- | new-luxc/source/luxc/lang/translation/case.jvm.lux | 262 |
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)))) |