diff options
Diffstat (limited to '')
10 files changed, 78 insertions, 86 deletions
diff --git a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux index 782639b25..28560854d 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux @@ -121,7 +121,7 @@ _ (|>> peekI ($i.CHECKCAST ($t.descriptor //runtime.$Tuple)) - ($i.int (nat-to-int idx)) + ($i.int (.int idx)) ($i.INVOKESTATIC hostL.runtime-class <method> ($t.method (list //runtime.$Tuple $t.int) @@ -138,7 +138,7 @@ $i.with-label (function (_ @fail)) (|>> peekI ($i.CHECKCAST ($t.descriptor //runtime.$Variant)) - ($i.int (nat-to-int idx)) + ($i.int (.int idx)) <flag> ($i.INVOKESTATIC hostL.runtime-class "pm_variant" ($t.method (list //runtime.$Variant //runtime.$Tag //runtime.$Flag) @@ -166,7 +166,7 @@ (^ [_ (#.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) + leftI (translate-path' translate (inc stack-depth) @alt-else @end leftP) rightI (translate-path' translate stack-depth @else @end rightP)] (wrap (|>> $i.DUP leftI diff --git a/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux index 1d8da2893..b678677ce 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux @@ -11,10 +11,11 @@ [macro] [host] (world [blob #+ Blob] - [file #+ File])) + [file #+ File]) + ["//" lang] + (lang ["//." reference #+ Register])) (luxc [lang] - (lang [".L" variable #+ Register] - (host ["$" jvm] + (lang (host ["$" jvm] (jvm ["$t" type] ["$d" def] ["$i" inst]))))) @@ -131,10 +132,10 @@ (wrap def-value) (#e.Success #.None) - (lang.throw Invalid-Definition-Value (%ident def-ident)) + (//.throw Invalid-Definition-Value (%ident def-ident)) (#e.Error error) - (lang.throw Cannot-Load-Definition - (format "Definition: " (%ident def-ident) "\n" - "Error:\n" - error)))))))) + (//.throw Cannot-Load-Definition + (format "Definition: " (%ident def-ident) "\n" + "Error:\n" + error)))))))) diff --git a/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux index 42b4f3358..a587d2e5b 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux @@ -6,12 +6,12 @@ (data ["e" error] text/format) [macro] - (macro ["s" syntax])) - (luxc ["&" lang] - (lang [".L" variable #+ Variable Register] - [".L" extension] - (host ["$" jvm]) - ["ls" synthesis])) + (macro ["s" syntax]) + ["//" lang] + (lang ["//." reference #+ Register] + ["//." synthesis #+ Synthesis] + ["//." extension])) + (luxc (lang (host ["$" jvm]))) (// [".T" common] [".T" primitive] [".T" structure] @@ -30,23 +30,19 @@ ) (def: #export (translate synthesis) - (-> ls.Synthesis (Meta $.Inst)) + (-> Synthesis (Meta $.Inst)) (case synthesis - (^code []) - primitiveT.translate-unit - - (^code [(~ singleton)]) - (translate singleton) - - (^template [<tag> <generator>] - [_ (<tag> value)] - (<generator> value)) - ([#.Bool primitiveT.translate-bool] - [#.Nat primitiveT.translate-nat] - [#.Int primitiveT.translate-int] - [#.Deg primitiveT.translate-deg] - [#.Frac primitiveT.translate-frac] - [#.Text primitiveT.translate-text]) + (^ (//synthesis.bool value)) + (primitiveT.translate-bool value) + + (^ (//synthesis.i64 value)) + (primitiveT.translate-i64 value) + + (^ (//synthesis.f64 value)) + (primitiveT.translate-f64 value) + + (^ (//synthesis.text value)) + (primitiveT.translate-text value) (^code ((~ [_ (#.Nat tag)]) (~ [_ (#.Bool last?)]) (~ valueS))) (structureT.translate-variant translate tag last? valueS) @@ -74,7 +70,7 @@ (functionT.translate-function translate environment arity bodyS) _ - (&.throw Invalid-Function-Syntax (%code synthesis))) + (//.throw Invalid-Function-Syntax (%code synthesis))) (^code ("lux call" (~ functionS) (~+ argsS))) (functionT.translate-call translate functionS argsS) @@ -86,5 +82,5 @@ ## (translation argsS)) _ - (&.throw Unrecognized-Synthesis (%code synthesis)) + (//.throw Unrecognized-Synthesis (%code synthesis)) )) diff --git a/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux index f5799e572..70eedf738 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux @@ -39,7 +39,7 @@ (if (poly-arg? arity) ($t.method (list.concat (list (captured-args env) (list $t.int) - (list.repeat (n/dec arity) $Object))) + (list.repeat (dec arity) $Object))) #.None (list)) ($t.method (captured-args env) #.None (list)))) @@ -59,7 +59,7 @@ (def: (inputsI start amount) (-> $.Register Nat $.Inst) - (|> (list.n/range start (n/+ start (n/dec amount))) + (|> (list.n/range start (n/+ start (dec amount))) (list/map $i.ALOAD) $i.fuse)) @@ -76,7 +76,7 @@ (def: (inc-intI by) (-> Nat $.Inst) - (|>> ($i.int (nat-to-int by)) + (|>> ($i.int (.int by)) $i.IADD)) (def: (nullsI amount) @@ -106,7 +106,7 @@ (do macro.Monad<Meta> [captureI+ (monad.map @ referenceT.translate-variable env) #let [argsI (if (poly-arg? arity) - (|> (nullsI (n/dec arity)) + (|> (nullsI (dec arity)) (list ($i.int 0)) $i.fuse) id)]] @@ -123,12 +123,12 @@ (let [env-size (list.size env) captureI (|> (case env-size +0 (list) - _ (list.n/range +0 (n/dec env-size))) + _ (list.n/range +0 (dec env-size))) (list/map (function (_ source) (|>> ($i.ALOAD +0) ($i.GETFIELD class (referenceT.captured source) $Object)))) $i.fuse) - argsI (|> (nullsI (n/dec arity)) + argsI (|> (nullsI (dec arity)) (list ($i.int 0)) $i.fuse)] (|>> ($i.NEW class) @@ -156,20 +156,20 @@ (if (n/= +1 arity) (|>> ($i.int 0) ($i.INVOKESPECIAL hostL.function-class "<init>" function-init-method false)) - (|>> ($i.ILOAD (n/inc env-size)) + (|>> ($i.ILOAD (inc env-size)) ($i.INVOKESPECIAL hostL.function-class "<init>" function-init-method false)))) (def: (with-init class env arity) (-> Text (List Variable) ls.Arity $.Def) (let [env-size (list.size env) offset-partial (: (-> Nat Nat) - (|>> n/inc (n/+ env-size))) + (|>> inc (n/+ env-size))) store-capturedI (|> (case env-size +0 (list) - _ (list.n/range +0 (n/dec env-size))) + _ (list.n/range +0 (dec env-size))) (list/map (function (_ register) (|>> ($i.ALOAD +0) - ($i.ALOAD (n/inc register)) + ($i.ALOAD (inc register)) ($i.PUTFIELD class (referenceT.captured register) $Object)))) $i.fuse) store-partialI (if (poly-arg? arity) @@ -177,7 +177,7 @@ (list/map (function (_ idx) (let [register (offset-partial idx)] (|>> ($i.ALOAD +0) - ($i.ALOAD (n/inc register)) + ($i.ALOAD (inc register)) ($i.PUTFIELD class (referenceT.partial idx) $Object))))) $i.fuse) id)] @@ -191,19 +191,19 @@ (def: (with-apply class env function-arity @begin bodyI apply-arity) (-> Text (List Variable) ls.Arity $.Label $.Inst ls.Arity $.Def) - (let [num-partials (n/dec function-arity) + (let [num-partials (dec function-arity) @default ($.new-label []) @labels (list/map $.new-label (list.repeat num-partials [])) - arity-over-extent (|> (nat-to-int function-arity) (i/- (nat-to-int apply-arity))) + arity-over-extent (|> (.int function-arity) (i/- (.int apply-arity))) casesI (|> (list/compose @labels (list @default)) (list.zip2 (list.n/range +0 num-partials)) (list/map (function (_ [stage @label]) (let [load-partialsI (if (n/> +0 stage) - (|> (list.n/range +0 (n/dec stage)) + (|> (list.n/range +0 (dec stage)) (list/map (|>> referenceT.partial (load-fieldI class))) $i.fuse) id)] - (cond (i/= arity-over-extent (nat-to-int stage)) + (cond (i/= arity-over-extent (.int stage)) (|>> ($i.label @label) ($i.ALOAD +0) (when (n/> +0 stage) @@ -213,7 +213,7 @@ ($i.INVOKEVIRTUAL class "impl" (implementation-method function-arity) false) $i.ARETURN) - (i/> arity-over-extent (nat-to-int stage)) + (i/> arity-over-extent (.int stage)) (let [args-to-completion (|> function-arity (n/- stage)) args-left (|> apply-arity (n/- args-to-completion))] (|>> ($i.label @label) @@ -222,14 +222,14 @@ load-partialsI (inputsI +1 args-to-completion) ($i.INVOKEVIRTUAL class "impl" (implementation-method function-arity) false) - (applysI (n/inc args-to-completion) args-left) + (applysI (inc args-to-completion) args-left) $i.ARETURN)) - ## (i/< arity-over-extent (nat-to-int stage)) + ## (i/< arity-over-extent (.int stage)) (let [env-size (list.size env) load-capturedI (|> (case env-size +0 (list) - _ (list.n/range +0 (n/dec env-size))) + _ (list.n/range +0 (dec env-size))) (list/map (|>> referenceT.captured (load-fieldI class))) $i.fuse)] (|>> ($i.label @label) @@ -247,7 +247,7 @@ $i.fuse)] ($d.method #$.Public $.noneM runtimeT.apply-method (runtimeT.apply-signature apply-arity) (|>> get-amount-of-partialsI - ($i.TABLESWITCH 0 (|> num-partials n/dec nat-to-int) + ($i.TABLESWITCH 0 (|> num-partials dec .int) @default @labels) casesI ($i.INVOKESTATIC hostL.runtime-class "apply_fail" ($t.method (list) #.None (list)) false) @@ -271,7 +271,7 @@ bodyI $i.ARETURN)))) functionD (: $.Def - (|>> ($d.int-field #$.Public ($_ $.++F $.staticF $.finalF) arity-field (nat-to-int arity)) + (|>> ($d.int-field #$.Public ($_ $.++F $.staticF $.finalF) arity-field (.int arity)) (with-captured env) (with-partial arity) (with-init class env arity) diff --git a/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux index fab4a7efe..f48ab149a 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux @@ -35,7 +35,7 @@ (Meta $.Inst)) (do macro.Monad<Meta> [[@begin offset] hostL.anchor - #let [pairs (list.zip2 (list.n/range offset (|> (list.size argsS) n/dec (n/+ offset))) + #let [pairs (list.zip2 (list.n/range offset (|> (list.size argsS) dec (n/+ offset))) argsS)] ## It may look weird that first I compile the values separately, ## and then I compile the stores/allocations. diff --git a/new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux index f92c7025a..80a243852 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux @@ -12,10 +12,6 @@ ["ls" synthesis])) (// [".T" common])) -(def: #export translate-unit - (Meta $.Inst) - (macro/wrap ($i.string hostL.unit))) - (def: #export (translate-bool value) (-> Bool (Meta $.Inst)) (macro/wrap ($i.GETSTATIC "java.lang.Boolean" @@ -27,9 +23,7 @@ (-> <type> (Meta $.Inst)) (macro/wrap (|>> (<load> value) <wrap>)))] - [translate-nat Nat (|>> (:! Int) $i.long) ($i.wrap #$.Long)] - [translate-int Int $i.long ($i.wrap #$.Long)] - [translate-deg Deg (|>> (:! Int) $i.long) ($i.wrap #$.Long)] - [translate-frac Frac $i.double ($i.wrap #$.Double)] + [translate-i64 Int $i.long ($i.wrap #$.Long)] + [translate-f64 Frac $i.double ($i.wrap #$.Double)] [translate-text Text $i.string id] ) diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux index 5cb4d52ec..689724bae 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux @@ -11,15 +11,16 @@ [macro #+ with-gensyms] (macro [code] ["s" syntax #+ syntax:]) - [host]) - (luxc ["&" lang] - (lang [".L" host] + [host] + ["//" lang] + (lang ["//." reference #+ Register] + ["//." synthesis #+ Synthesis] + ["//." extension])) + (luxc (lang [".L" host] (host ["$" jvm] (jvm ["$t" type] ["$d" def] - ["$i" inst])) - ["la" analysis] - ["ls" synthesis])) + ["$i" inst])))) (/// [".T" runtime] [".T" case] [".T" function] @@ -38,10 +39,10 @@ ## [Types] (type: #export Translator - (-> ls.Synthesis (Meta $.Inst))) + (-> Synthesis (Meta $.Inst))) (type: #export Proc - (-> Translator (List ls.Synthesis) (Meta $.Inst))) + (-> Translator (List Synthesis) (Meta $.Inst))) (type: #export Bundle (Dict Text Proc)) @@ -78,8 +79,8 @@ (def: (wrong-arity proc expected actual) (-> Text Nat Nat Text) (format "Wrong number of arguments for " (%t proc) "\n" - "Expected: " (|> expected nat-to-int %i) "\n" - " Actual: " (|> actual nat-to-int %i))) + "Expected: " (|> expected .int %i) "\n" + " Actual: " (|> actual .int %i))) (syntax: (arity: {name s.local-symbol} {arity s.nat}) (with-gensyms [g!_ g!proc g!name g!translate g!inputs] @@ -171,7 +172,7 @@ message) (def: #export (wrong-syntax procedure args) - (-> Text (List ls.Synthesis) Text) + (-> Text (List Synthesis) Text) (format "Procedure: " procedure "\n" "Arguments: " (%code (code.tuple args)))) @@ -184,7 +185,7 @@ (loopT.translate-loop translate offset initsS+ bodyS) (#e.Error error) - (&.throw Wrong-Syntax (wrong-syntax proc-name inputsS))) + (//.throw Wrong-Syntax (wrong-syntax proc-name inputsS))) ))) (def: lux//recur diff --git a/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux index 6776092c9..9271efe8f 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux @@ -16,7 +16,7 @@ (do-template [<name> <prefix>] [(def: #export (<name> idx) (-> Nat Text) - (|> idx nat-to-int %i (format <prefix>)))] + (|> idx .int %i (format <prefix>)))] [captured "c"] [partial "p"] @@ -30,12 +30,12 @@ #let [function-class (format (text.replace-all "/" "." this-module) "." function-class)]] (wrap (|>> ($i.ALOAD +0) ($i.GETFIELD function-class - (|> variable i/inc (i/* -1) int-to-nat captured) + (|> variable inc (i/* -1) .nat captured) commonT.$Object))))) (def: #export (translate-local variable) (-> Variable (Meta $.Inst)) - (macro/wrap ($i.ALOAD (int-to-nat variable)))) + (macro/wrap ($i.ALOAD (.nat variable)))) (def: #export (translate-variable variable) (-> Variable (Meta $.Inst)) diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux index 456974ccd..c22199864 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux @@ -247,7 +247,7 @@ $i.with-label (function (_ @wrong)) (let [variant-partI (: (-> Nat $.Inst) (function (_ idx) - (|>> ($i.int (nat-to-int idx)) $i.AALOAD))) + (|>> ($i.int (.int idx)) $i.AALOAD))) tagI (: $.Inst (|>> (variant-partI +0) ($i.unwrap #$.Int))) flagI (variant-partI +1) @@ -445,11 +445,11 @@ #let [applyI (|> (list.n/range +2 num-apply-variants) (list/map (function (_ arity) ($d.method #$.Public $.noneM apply-method (apply-signature arity) - (let [preI (|> (list.n/range +0 (n/dec arity)) + (let [preI (|> (list.n/range +0 (dec arity)) (list/map $i.ALOAD) $i.fuse)] (|>> preI - ($i.INVOKEVIRTUAL hostL.function-class apply-method (apply-signature (n/dec arity)) false) + ($i.INVOKEVIRTUAL hostL.function-class apply-method (apply-signature (dec arity)) false) ($i.CHECKCAST hostL.function-class) ($i.ALOAD arity) ($i.INVOKEVIRTUAL hostL.function-class apply-method (apply-signature +1) false) diff --git a/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux index 4a98d346d..fce1c6790 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux @@ -33,11 +33,11 @@ (do @ [memberI (translate member)] (wrap (|>> $i.DUP - ($i.int (nat-to-int idx)) + ($i.int (.int idx)) memberI $i.AASTORE))))) (:: @ map $i.fuse))] - (wrap (|>> ($i.int (nat-to-int size)) + (wrap (|>> ($i.int (.int size)) ($i.array $Object) membersI)))) @@ -51,7 +51,7 @@ (-> (-> ls.Synthesis (Meta $.Inst)) Nat Bool ls.Synthesis (Meta $.Inst)) (do macro.Monad<Meta> [memberI (translate member)] - (wrap (|>> ($i.int (nat-to-int tag)) + (wrap (|>> ($i.int (.int tag)) (flagI tail?) memberI ($i.INVOKESTATIC hostL.runtime-class |