From 9eaaaf953ba7ce1eeb805603f4e113aa15f5178f Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 8 Jan 2018 21:40:06 -0400 Subject: - Moved all translation code under the JVM path (in preparation for porting the JS back-end). --- new-luxc/source/luxc/lang/translation/case.jvm.lux | 230 --------------------- 1 file changed, 230 deletions(-) delete mode 100644 new-luxc/source/luxc/lang/translation/case.jvm.lux (limited to 'new-luxc/source/luxc/lang/translation/case.jvm.lux') diff --git a/new-luxc/source/luxc/lang/translation/case.jvm.lux b/new-luxc/source/luxc/lang/translation/case.jvm.lux deleted file mode 100644 index b693f50b8..000000000 --- a/new-luxc/source/luxc/lang/translation/case.jvm.lux +++ /dev/null @@ -1,230 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data text/format) - [macro "macro/" Monad]) - (luxc ["_" lang] - (lang [".L" host] - (host ["$" jvm] - (jvm ["$t" type] - ["$i" inst])) - ["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: (translate-path' translate 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 macro.Monad - [bodyI (translate bodyS)] - (wrap (|>> (pop-altI stack-depth) - bodyI - ($i.GOTO @end)))) - - (^ [_ (#.Form (list [_ (#.Text "lux case pop")]))]) - (macro/wrap popI) - - (^ [_ (#.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) - (jumpI @else)))) - - (^template [ ] - [_ ( value)] - (macro/wrap (|>> peekI - ($i.unwrap #$.Long) - ($i.long (|> value )) - $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" - "equals" - ($t.method (list $Object) - (#.Some $t.boolean) - (list)) - false) - ($i.IFEQ @else))) - - (^template [ ] - (^ [_ (#.Form (list [_ (#.Text )] [_ (#.Nat idx)]))]) - (macro/wrap (case idx - +0 - (|>> 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 - - ($t.method (list //runtime.$Tuple $t.int) - (#.Some $Object) - (list)) - false) - pushI)))) - (["lux case tuple left" "pm_left"] - ["lux case tuple right" "pm_right"]) - - (^template [ ] - (^ [_ (#.Form (list [_ (#.Text )] [_ (#.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)) - - ($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)))) - (["lux case variant left" $i.NULL] - ["lux case variant right" ($i.string "")]) - - (^ [_ (#.Form (list [_ (#.Text "lux case seq")] leftP rightP))]) - (do macro.Monad - [leftI (translate-path' translate stack-depth @else @end leftP) - rightI (translate-path' translate stack-depth @else @end rightP)] - (wrap (|>> leftI - rightI))) - - (^ [_ (#.Form (list [_ (#.Text "lux case alt")] leftP rightP))]) - (do macro.Monad - [@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 - leftI - ($i.label @alt-else) - $i.POP - rightI))) - - _ - (_.throw Unrecognized-Path (%code path)))) - -(def: (translate-path translate path @end) - (-> (-> ls.Synthesis (Meta $.Inst)) - ls.Path $.Label (Meta $.Inst)) - (do macro.Monad - [@else $i.make-label - pathI (translate-path' translate +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 (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) - thenI - ($i.GOTO @end) - ($i.label @else) - elseI - ($i.label @end)))) - -(def: #export (translate-case translate valueS path) - (-> (-> ls.Synthesis (Meta $.Inst)) - ls.Synthesis ls.Path (Meta $.Inst)) - (do macro.Monad - [@end $i.make-label - valueI (translate valueS) - pathI (translate-path translate path @end)] - (wrap (|>> valueI - $i.NULL - $i.SWAP - pushI - pathI - ($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 - [inputI (translate inputS) - exprI (translate exprS)] - (wrap (|>> inputI - ($i.ASTORE register) - exprI)))) -- cgit v1.2.3