diff options
| author | Eduardo Julian | 2018-07-22 02:52:46 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2018-07-22 02:52:46 -0400 |
| commit | b14102eaa2a80f51f160ba293ec01928dbe683c3 (patch) | |
| tree | bf2640c4503de8c9f0a8f6b048548ef1a0bd4e83 /new-luxc/source/luxc/lang/translation/jvm | |
| parent | 9671d6064dd02dfe6c32492f5b9907b096e5bd89 (diff) | |
- Some fixes due to recent changes in stdlib.
- Removed some (now) useless modules.
Diffstat (limited to '')
16 files changed, 853 insertions, 871 deletions
diff --git a/new-luxc/source/luxc/lang/translation/jvm.lux b/new-luxc/source/luxc/lang/translation/jvm.lux index 152def2f5..3e239798b 100644 --- a/new-luxc/source/luxc/lang/translation/jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm.lux @@ -13,14 +13,15 @@ [collection ["." array] ["." dictionary (#+ Dictionary)]]] - [host (#+ import: do-to object)] + ["." host (#+ import: do-to object)] ["." io (#+ IO io)] [world - [blob (#+ Blob)]] - [language - ["." name] - [compiler - ["." translation]]]] + [binary (#+ Binary)]] + [compiler + [default + ["." name] + [phase + ["." translation]]]]] [/// [host ["." jvm (#+ Inst Definition Host State) @@ -69,7 +70,7 @@ (#error.Error error) (error! error))) -(type: #export ByteCode Blob) +(type: #export ByteCode Binary) (def: (define-class class-name bytecode loader) (-> Text ByteCode ClassLoader (Error Object)) 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 2aa0586ab..016edf3d2 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux @@ -6,55 +6,56 @@ [data [text format]] - [language - ["." compiler ("operation/" Monad<Operation>) - ["." synthesis (#+ Path Synthesis)]]]] + [compiler + [default + ["." phase ("operation/." Monad<Operation>) + ["." synthesis (#+ Path Synthesis)]]]]] [luxc [lang [host - ["$" jvm (#+ Label Inst Operation Compiler) + ["$" jvm (#+ Label Inst Operation Phase) ["$t" type] - ["$i" inst]]]]] + ["_" inst]]]]] ["." // (#+ $Object) - [runtime]]) + ["." runtime]]) (def: (pop-altI stack-depth) (-> Nat Inst) (.case stack-depth +0 id - +1 $i.POP - +2 $i.POP2 + +1 _.POP + +2 _.POP2 _ ## (n/> +2) - (|>> $i.POP2 + (|>> _.POP2 (pop-altI (n/- +2 stack-depth))))) (def: peekI Inst - (|>> $i.DUP - ($i.INVOKESTATIC //.runtime-class - "pm_peek" - ($t.method (list runtime.$Stack) - (#.Some $Object) - (list)) - #0))) + (|>> _.DUP + (_.INVOKESTATIC //.runtime-class + "pm_peek" + ($t.method (list runtime.$Stack) + (#.Some $Object) + (list)) + #0))) (def: popI Inst - (|>> ($i.INVOKESTATIC //.runtime-class - "pm_pop" - ($t.method (list runtime.$Stack) - (#.Some runtime.$Stack) - (list)) - #0))) + (|>> (_.INVOKESTATIC //.runtime-class + "pm_pop" + ($t.method (list runtime.$Stack) + (#.Some runtime.$Stack) + (list)) + #0))) (def: pushI Inst - (|>> ($i.INVOKESTATIC //.runtime-class - "pm_push" - ($t.method (list runtime.$Stack $Object) - (#.Some runtime.$Stack) - (list)) - #0))) + (|>> (_.INVOKESTATIC //.runtime-class + "pm_push" + ($t.method (list runtime.$Stack $Object) + (#.Some runtime.$Stack) + (list)) + #0))) (def: (path' translate stack-depth @else @end path) (-> (-> Synthesis (Operation Inst)) @@ -65,45 +66,45 @@ (#synthesis.Bind register) (operation/wrap (|>> peekI - ($i.ASTORE register))) + (_.ASTORE register))) (^ (synthesis.path/bit value)) - (operation/wrap (.let [jumpI (.if value $i.IFEQ $i.IFNE)] + (operation/wrap (.let [jumpI (.if value _.IFEQ _.IFNE)] (|>> peekI - ($i.unwrap #$.Boolean) + (_.unwrap #$.Boolean) (jumpI @else)))) (^ (synthesis.path/i64 value)) (operation/wrap (|>> peekI - ($i.unwrap #$.Long) - ($i.long value) - $i.LCMP - ($i.IFNE @else))) + (_.unwrap #$.Long) + (_.long value) + _.LCMP + (_.IFNE @else))) (^ (synthesis.path/f64 value)) (operation/wrap (|>> peekI - ($i.unwrap #$.Double) - ($i.double value) - $i.DCMPL - ($i.IFNE @else))) + (_.unwrap #$.Double) + (_.double value) + _.DCMPL + (_.IFNE @else))) (^ (synthesis.path/text value)) (operation/wrap (|>> peekI - ($i.string value) - ($i.INVOKEVIRTUAL "java.lang.Object" - "equals" - ($t.method (list $Object) - (#.Some $t.boolean) - (list)) - #0) - ($i.IFEQ @else))) + (_.string value) + (_.INVOKEVIRTUAL "java.lang.Object" + "equals" + ($t.method (list $Object) + (#.Some $t.boolean) + (list)) + #0) + (_.IFEQ @else))) (#synthesis.Then bodyS) - (do compiler.Monad<Operation> + (do phase.Monad<Operation> [bodyI (translate bodyS)] (wrap (|>> (pop-altI stack-depth) bodyI - ($i.GOTO @end)))) + (_.GOTO @end)))) (^template [<pattern> <method> <mod>] @@ -111,21 +112,21 @@ (operation/wrap (.case (<mod> idx) +0 (|>> peekI - ($i.CHECKCAST ($t.descriptor runtime.$Tuple)) - ($i.int 0) - $i.AALOAD + (_.CHECKCAST ($t.descriptor runtime.$Tuple)) + (_.int 0) + _.AALOAD pushI) idx (|>> peekI - ($i.CHECKCAST ($t.descriptor runtime.$Tuple)) - ($i.int (.int idx)) - ($i.INVOKESTATIC //.runtime-class - <method> - ($t.method (list runtime.$Tuple $t.int) - (#.Some $Object) - (list)) - #0) + (_.CHECKCAST ($t.descriptor runtime.$Tuple)) + (_.int (.int idx)) + (_.INVOKESTATIC //.runtime-class + <method> + ($t.method (list runtime.$Tuple $t.int) + (#.Some $Object) + (list)) + #0) pushI)))) ([synthesis.member/left "pm_left" .id] [synthesis.member/right "pm_right" .inc]) @@ -133,41 +134,41 @@ (^template [<pattern> <flag> <mod>] (^ (<pattern> idx)) (.let [idx (<mod> idx)] - (operation/wrap (<| $i.with-label (function (_ @success)) - $i.with-label (function (_ @fail)) + (operation/wrap (<| _.with-label (function (_ @success)) + _.with-label (function (_ @fail)) (|>> peekI - ($i.CHECKCAST ($t.descriptor runtime.$Variant)) - ($i.int (.int idx)) + (_.CHECKCAST ($t.descriptor runtime.$Variant)) + (_.int (.int idx)) <flag> - ($i.INVOKESTATIC //.runtime-class "pm_variant" - ($t.method (list runtime.$Variant runtime.$Tag runtime.$Flag) - (#.Some runtime.$Datum) - (list)) - #0) - $i.DUP - ($i.IFNULL @fail) - ($i.GOTO @success) - ($i.label @fail) - $i.POP - ($i.GOTO @else) - ($i.label @success) + (_.INVOKESTATIC //.runtime-class "pm_variant" + ($t.method (list runtime.$Variant runtime.$Tag runtime.$Flag) + (#.Some runtime.$Datum) + (list)) + #0) + _.DUP + (_.IFNULL @fail) + (_.GOTO @success) + (_.label @fail) + _.POP + (_.GOTO @else) + (_.label @success) pushI))))) - ([synthesis.side/left $i.NULL .id] - [synthesis.side/right ($i.string "") .inc]) + ([synthesis.side/left _.NULL .id] + [synthesis.side/right (_.string "") .inc]) (#synthesis.Alt leftP rightP) - (do compiler.Monad<Operation> - [@alt-else $i.make-label + (do phase.Monad<Operation> + [@alt-else _.make-label leftI (path' translate (inc stack-depth) @alt-else @end leftP) rightI (path' translate stack-depth @else @end rightP)] - (wrap (|>> $i.DUP + (wrap (|>> _.DUP leftI - ($i.label @alt-else) - $i.POP + (_.label @alt-else) + _.POP rightI))) (#synthesis.Seq leftP rightP) - (do compiler.Monad<Operation> + (do phase.Monad<Operation> [leftI (path' translate stack-depth @else @end leftP) rightI (path' translate stack-depth @else @end rightP)] (wrap (|>> leftI @@ -175,55 +176,55 @@ )) (def: (path translate path @end) - (-> Compiler Path Label (Operation Inst)) - (do compiler.Monad<Operation> - [@else $i.make-label + (-> Phase Path Label (Operation Inst)) + (do phase.Monad<Operation> + [@else _.make-label pathI (..path' translate +1 @else @end path)] (wrap (|>> pathI - ($i.label @else) - $i.POP - ($i.INVOKESTATIC //.runtime-class - "pm_fail" - ($t.method (list) #.None (list)) - #0) - $i.NULL - ($i.GOTO @end))))) + (_.label @else) + _.POP + (_.INVOKESTATIC //.runtime-class + "pm_fail" + ($t.method (list) #.None (list)) + #0) + _.NULL + (_.GOTO @end))))) (def: #export (if translate testS thenS elseS) - (-> Compiler Synthesis Synthesis Synthesis (Operation Inst)) - (do compiler.Monad<Operation> + (-> Phase Synthesis Synthesis Synthesis (Operation Inst)) + (do phase.Monad<Operation> [testI (translate testS) thenI (translate thenS) elseI (translate elseS)] - (wrap (<| $i.with-label (function (_ @else)) - $i.with-label (function (_ @end)) + (wrap (<| _.with-label (function (_ @else)) + _.with-label (function (_ @end)) (|>> testI - ($i.unwrap #$.Boolean) - ($i.IFEQ @else) + (_.unwrap #$.Boolean) + (_.IFEQ @else) thenI - ($i.GOTO @end) - ($i.label @else) + (_.GOTO @end) + (_.label @else) elseI - ($i.label @end)))))) + (_.label @end)))))) (def: #export (let translate inputS register exprS) - (-> Compiler Synthesis Nat Synthesis (Operation Inst)) - (do compiler.Monad<Operation> + (-> Phase Synthesis Nat Synthesis (Operation Inst)) + (do phase.Monad<Operation> [inputI (translate inputS) exprI (translate exprS)] (wrap (|>> inputI - ($i.ASTORE register) + (_.ASTORE register) exprI)))) (def: #export (case translate valueS path) - (-> Compiler Synthesis Path (Operation Inst)) - (do compiler.Monad<Operation> - [@end $i.make-label + (-> Phase Synthesis Path (Operation Inst)) + (do phase.Monad<Operation> + [@end _.make-label valueI (translate valueS) pathI (..path translate path @end)] (wrap (|>> valueI - $i.NULL - $i.SWAP + _.NULL + _.SWAP pushI pathI - ($i.label @end))))) + (_.label @end))))) 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 b01a68c3d..a138bd79a 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux @@ -3,23 +3,24 @@ [control [monad (#+ do)] ["ex" exception (#+ exception:)]] - [io] + ["." io] [concurrency [atom (#+ Atom atom)]] [data - [error (#+ Error)] - [text ("text/" Hash<Text>) + ["." error (#+ Error)] + ["." text ("text/." Hash<Text>) format] [collection - [dictionary (#+ Dictionary)]]] - [macro] + ["." dictionary (#+ Dictionary)]]] + ["." macro] [host (#+ import:)] [world - [blob (#+ Blob)]] - [language - [name] - [reference (#+ Register)] - ["." compiler]]] + [binary (#+ Binary)]] + [compiler + [default + ["." name] + [reference (#+ Register)] + ["." phase]]]] ## [luxc ## [lang ## [host @@ -29,30 +30,30 @@ ## (def: #export (with-artifacts action) ## (All [a] (-> (Meta a) (Meta [Artifacts a]))) -## (function (_ compiler) +## (function (_ state) ## (case (action (update@ #.host ## (|>> (:coerce Host) ## (set@ #artifacts (dictionary.new text.Hash<Text>)) ## (:coerce Nothing)) -## compiler)) -## (#error.Success [compiler' output]) +## state)) +## (#error.Success [state' output]) ## (#error.Success [(update@ #.host ## (|>> (:coerce Host) -## (set@ #artifacts (|> (get@ #.host compiler) (:coerce Host) (get@ #artifacts))) +## (set@ #artifacts (|> (get@ #.host state) (:coerce Host) (get@ #artifacts))) ## (:coerce Nothing)) -## compiler') -## [(|> compiler' (get@ #.host) (:coerce Host) (get@ #artifacts)) +## state') +## [(|> state' (get@ #.host) (:coerce Host) (get@ #artifacts)) ## output]]) ## (#error.Error error) ## (#error.Error error)))) -## (def: #export (load-definition compiler) -## (-> Lux (-> Ident Blob (Error Any))) -## (function (_ (^@ def-ident [def-module def-name]) def-bytecode) +## (def: #export (load-definition state) +## (-> Lux (-> Name Binary (Error Any))) +## (function (_ (^@ def-name [def-module def-name]) def-bytecode) ## (let [normal-name (format (name.normalize def-name) (%n (text/hash def-name))) ## class-name (format (text.replace-all "/" "." def-module) "." normal-name)] -## (<| (macro.run compiler) +## (<| (macro.run state) ## (do macro.Monad<Meta> ## [_ (..store-class class-name def-bytecode) ## class (..load-class class-name)] @@ -63,10 +64,10 @@ ## (wrap def-value) ## (#error.Success #.None) -## (compiler.throw invalid-definition-value (%ident def-ident)) +## (phase.throw invalid-definition-value (%name def-name)) ## (#error.Error error) -## (compiler.throw cannot-load-definition -## (format "Definition: " (%ident def-ident) "\n" +## (phase.throw cannot-load-definition +## (format "Definition: " (%name def-name) "\n" ## "Error:\n" ## error)))))))) diff --git a/new-luxc/source/luxc/lang/translation/jvm/eval.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/eval.jvm.lux index aed1abca3..49fbd0385 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/eval.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/eval.jvm.lux @@ -9,7 +9,7 @@ (lang (host ["$" jvm] (jvm ["$t" type] ["$d" def] - ["$i" inst])) + ["_" inst])) ["la" analysis] ["ls" synthesis])) (// [".T" common])) @@ -37,8 +37,8 @@ "<clinit>" ($t.method (list) #.None (list)) (|>> valueI - ($i.PUTSTATIC store-name commonT.value-field commonT.$Object) - $i.RETURN))))] + (_.PUTSTATIC store-name commonT.value-field commonT.$Object) + _.RETURN))))] _ (commonT.store-class store-name bytecode) class (commonT.load-class store-name)] (wrap (|> class 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 df126628c..f250604b5 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux @@ -1,13 +1,14 @@ (.module: [lux #* - [language - [compiler - ["." synthesis] - ["." extension]]]] + [compiler + [default + [phase + ["." synthesis] + ["." extension]]]]] [luxc [lang [host - [jvm (#+ Compiler)]]]] + [jvm (#+ Phase)]]]] [// ["." common] ["." primitive] @@ -18,7 +19,7 @@ ["." function]]) (def: #export (translate synthesis) - Compiler + Phase (case synthesis (^ (synthesis.bit value)) (primitive.bit value) 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 a8006a772..17585b63c 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux @@ -1,22 +1,23 @@ (.module: [lux (#- function) [control - [monad (#+ do)]] + ["." monad (#+ do)]] [data ["." text format] [collection - [list ("list/" Functor<List> Monoid<List>)]]] - [language - ["_." reference (#+ Register Variable)] - ["." compiler - [analysis (#+ Arity)] - [synthesis (#+ Synthesis Abstraction Apply)] - ["." translation]]]] + ["." list ("list/." Functor<List> Monoid<List>)]]] + [compiler + [default + ["_." reference (#+ Register Variable)] + ["." phase + [analysis (#+ Arity)] + [synthesis (#+ Synthesis Abstraction Apply)] + ["." translation]]]]] [luxc [lang [host - ["$" jvm (#+ Label Inst Def Operation Compiler) + ["$" jvm (#+ Label Inst Def Operation Phase) ["." type] ["." def] ["_" inst]]]]] @@ -109,7 +110,7 @@ (def: (instance class arity env) (-> Text Arity (List Variable) (Operation Inst)) - (do compiler.Monad<Operation> + (do phase.Monad<Operation> [captureI+ (monad.map @ reference.variable env) #let [argsI (if (poly-arg? arity) (|> (nullsI (dec arity)) @@ -284,13 +285,13 @@ (with-reset class arity env) applyD ))] - (do compiler.Monad<Operation> + (do phase.Monad<Operation> [instanceI (instance class arity env)] (wrap [functionD instanceI])))) (def: #export (function translate [env arity bodyS]) - (-> Compiler Abstraction (Operation Inst)) - (do compiler.Monad<Operation> + (-> Phase Abstraction (Operation Inst)) + (do phase.Monad<Operation> [@begin _.make-label [function-class bodyI] (translation.with-context (translation.with-anchor [@begin +1] @@ -312,8 +313,8 @@ (list& pre (segment size post))))) (def: #export (call translate [functionS argsS]) - (-> Compiler Apply (Operation Inst)) - (do compiler.Monad<Operation> + (-> Phase Apply (Operation Inst)) + (do phase.Monad<Operation> [functionI (translate functionS) argsI (monad.map @ translate argsS) #let [applyI (|> (segment runtime.num-apply-variants argsI) diff --git a/new-luxc/source/luxc/lang/translation/jvm/imports.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/imports.jvm.lux index 9c344e7e9..ec791019c 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/imports.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/imports.jvm.lux @@ -116,7 +116,7 @@ (do macro.Monad<Meta> [_ (moduleL.set-annotations annotations) current-module macro.current-module-name - imports (let [imports (|> (macro.get-tuple-ann (ident-for #.imports) annotations) + imports (let [imports (|> (macro.get-tuple-ann (name-of #.imports) annotations) (maybe.default (list)))] (case (s.run imports (p.some import)) (#e.Success imports) 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 ac356aebb..20be62066 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux @@ -1,21 +1,22 @@ (.module: [lux #* [control - [monad (#+ do)]] + ["." monad (#+ do)]] [data ["." text format] [collection - [list ("list/" Functor<List> Monoid<List>)]]] - [language - [reference (#+ Register)] - ["." compiler - ["." synthesis (#+ Synthesis)] - ["." translation]]]] + ["." list ("list/." Functor<List> Monoid<List>)]]] + [compiler + [default + [reference (#+ Register)] + ["." phase + ["." synthesis (#+ Synthesis)] + ["." translation]]]]] [luxc [lang [host - [jvm (#+ Inst Operation Compiler) + [jvm (#+ Inst Operation Phase) ["_" inst]]]]] ["." //]) @@ -29,8 +30,8 @@ #0)) (def: #export (recur translate argsS) - (-> Compiler (List Synthesis) (Operation Inst)) - (do compiler.Monad<Operation> + (-> Phase (List Synthesis) (Operation Inst)) + (do phase.Monad<Operation> [[@begin start] translation.anchor #let [end (|> argsS list.size dec (n/+ start)) pairs (list.zip2 (list.n/range start end) @@ -60,8 +61,8 @@ (_.GOTO @begin))))) (def: #export (scope translate [start initsS+ iterationS]) - (-> Compiler [Nat (List Synthesis) Synthesis] (Operation Inst)) - (do compiler.Monad<Operation> + (-> Phase [Nat (List Synthesis) Synthesis] (Operation Inst)) + (do phase.Monad<Operation> [@begin _.make-label initsI+ (monad.map @ translate initsS+) iterationI (translation.with-anchor [@begin start] 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 f1d639b72..c32e80d56 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux @@ -5,27 +5,28 @@ [data [text format]] - [language - [compiler ("operation/" Monad<Operation>)]]] + [compiler + [default + [phase ("operation/." Monad<Operation>)]]]] [luxc [lang [host - [jvm (#+ Inst Operation) - ["$i" inst] + ["." jvm (#+ Inst Operation) + ["_" inst] ["$t" type]]]]]) (def: #export (bit value) (-> Bit (Operation Inst)) - (operation/wrap ($i.GETSTATIC "java.lang.Boolean" - (if value "TRUE" "FALSE") - ($t.class "java.lang.Boolean" (list))))) + (operation/wrap (_.GETSTATIC "java.lang.Boolean" + (if value "TRUE" "FALSE") + ($t.class "java.lang.Boolean" (list))))) (do-template [<name> <type> <load> <wrap>] [(def: #export (<name> value) (-> <type> (Operation Inst)) (operation/wrap (|>> (<load> value) <wrap>)))] - [i64 Int $i.long ($i.wrap #jvm.Long)] - [f64 Frac $i.double ($i.wrap #jvm.Double)] - [text Text $i.string (<|)] + [i64 Int _.long (_.wrap #jvm.Long)] + [f64 Frac _.double (_.wrap #jvm.Double)] + [text Text _.string (<|)] ) diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure.jvm.lux deleted file mode 100644 index 49c91204a..000000000 --- a/new-luxc/source/luxc/lang/translation/jvm/procedure.jvm.lux +++ /dev/null @@ -1,28 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (data [maybe] - text/format - (coll (dictionary ["dict" unordered #+ Dict])))) - (luxc ["&" lang] - (lang (host ["$" jvm]) - ["ls" synthesis])) - (/ ["/." common] - ["/." host])) - -(exception: #export (Unknown-Procedure {message Text}) - message) - -(def: procedures - /common.Bundle - (|> /common.procedures - (dict.merge /host.procedures))) - -(def: #export (translate-procedure translate name args) - (-> (-> ls.Synthesis (Meta $.Inst)) Text (List ls.Synthesis) - (Meta $.Inst)) - (<| (maybe.default (&.throw Unknown-Procedure (%t name))) - (do maybe.Monad<Maybe> - [proc (dict.get name procedures)] - (wrap (proc translate args))))) 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 6447ec20a..2334f9cc2 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 @@ -20,7 +20,7 @@ (host ["$" jvm] (jvm ["$t" type] ["$d" def] - ["$i" inst])))) + ["_" inst])))) (/// [".T" runtime] [".T" case] [".T" function] @@ -110,32 +110,32 @@ (wrap (proc inputsI)))))) ## [Instructions] -(def: lux-intI $.Inst (|>> $i.I2L ($i.wrap #$.Long))) -(def: jvm-intI $.Inst (|>> ($i.unwrap #$.Long) $i.L2I)) +(def: lux-intI $.Inst (|>> _.I2L (_.wrap #$.Long))) +(def: jvm-intI $.Inst (|>> (_.unwrap #$.Long) _.L2I)) (def: (array-writeI arrayI idxI elemI) (-> $.Inst $.Inst $.Inst $.Inst) - (|>> arrayI ($i.CHECKCAST ($t.descriptor $Object-Array)) - $i.DUP + (|>> arrayI (_.CHECKCAST ($t.descriptor $Object-Array)) + _.DUP idxI jvm-intI elemI - $i.AASTORE)) + _.AASTORE)) (def: (predicateI tester) (-> (-> $.Label $.Inst) $.Inst) - (<| $i.with-label (function (_ @then)) - $i.with-label (function (_ @end)) + (<| _.with-label (function (_ @then)) + _.with-label (function (_ @end)) (|>> (tester @then) - ($i.GETSTATIC "java.lang.Boolean" "FALSE" ($t.class "java.lang.Boolean" (list))) - ($i.GOTO @end) - ($i.label @then) - ($i.GETSTATIC "java.lang.Boolean" "TRUE" ($t.class "java.lang.Boolean" (list))) - ($i.label @end) + (_.GETSTATIC "java.lang.Boolean" "FALSE" ($t.class "java.lang.Boolean" (list))) + (_.GOTO @end) + (_.label @then) + (_.GETSTATIC "java.lang.Boolean" "TRUE" ($t.class "java.lang.Boolean" (list))) + (_.label @end) ))) -(def: unitI $.Inst ($i.string hostL.unit)) +(def: unitI $.Inst (_.string hostL.unit)) ## [Procedures] ## [[Lux]] @@ -143,7 +143,7 @@ Binary (|>> leftI rightI - (predicateI $i.IF_ACMPEQ))) + (predicateI _.IF_ACMPEQ))) (def: (lux//if [testI thenI elseI]) Trinary @@ -152,10 +152,10 @@ (def: (lux//try riskyI) Unary (|>> riskyI - ($i.CHECKCAST hostL.function-class) - ($i.INVOKESTATIC hostL.runtime-class "try" - ($t.method (list $Function) (#.Some $Object-Array) (list)) - #0))) + (_.CHECKCAST hostL.function-class) + (_.INVOKESTATIC hostL.runtime-class "try" + ($t.method (list $Function) (#.Some $Object-Array) (list)) + #0))) (exception: #export (Wrong-Syntax {message Text}) message) @@ -187,48 +187,48 @@ (do-template [<name> <op>] [(def: (<name> [inputI maskI]) Binary - (|>> inputI ($i.unwrap #$.Long) - maskI ($i.unwrap #$.Long) - <op> ($i.wrap #$.Long)))] + (|>> inputI (_.unwrap #$.Long) + maskI (_.unwrap #$.Long) + <op> (_.wrap #$.Long)))] - [bit//and $i.LAND] - [bit//or $i.LOR] - [bit//xor $i.LXOR] + [bit//and _.LAND] + [bit//or _.LOR] + [bit//xor _.LXOR] ) (do-template [<name> <op>] [(def: (<name> [inputI shiftI]) Binary - (|>> inputI ($i.unwrap #$.Long) + (|>> inputI (_.unwrap #$.Long) shiftI jvm-intI <op> - ($i.wrap #$.Long)))] + (_.wrap #$.Long)))] - [bit//left-shift $i.LSHL] - [bit//arithmetic-right-shift $i.LSHR] - [bit//logical-right-shift $i.LUSHR] + [bit//left-shift _.LSHL] + [bit//arithmetic-right-shift _.LSHR] + [bit//logical-right-shift _.LUSHR] ) ## [[Arrays]] (def: (array//new lengthI) Unary - (|>> lengthI jvm-intI ($i.ANEWARRAY ($t.binary-name "java.lang.Object")))) + (|>> lengthI jvm-intI (_.ANEWARRAY ($t.binary-name "java.lang.Object")))) (def: (array//get [arrayI idxI]) Binary - (<| $i.with-label (function (_ @is-null)) - $i.with-label (function (_ @end)) - (|>> arrayI ($i.CHECKCAST ($t.descriptor $Object-Array)) + (<| _.with-label (function (_ @is-null)) + _.with-label (function (_ @end)) + (|>> arrayI (_.CHECKCAST ($t.descriptor $Object-Array)) idxI jvm-intI - $i.AALOAD - $i.DUP - ($i.IFNULL @is-null) + _.AALOAD + _.DUP + (_.IFNULL @is-null) runtimeT.someI - ($i.GOTO @end) - ($i.label @is-null) - $i.POP + (_.GOTO @end) + (_.label @is-null) + _.POP runtimeT.noneI - ($i.label @end)))) + (_.label @end)))) (def: (array//put [arrayI idxI elemI]) Trinary @@ -236,12 +236,12 @@ (def: (array//remove [arrayI idxI]) Binary - (array-writeI arrayI idxI $i.NULL)) + (array-writeI arrayI idxI _.NULL)) (def: (array//size arrayI) Unary - (|>> arrayI ($i.CHECKCAST ($t.descriptor $Object-Array)) - $i.ARRAYLENGTH + (|>> arrayI (_.CHECKCAST ($t.descriptor $Object-Array)) + _.ARRAYLENGTH lux-intI)) ## [[Numbers]] @@ -252,32 +252,32 @@ (do-template [<name> <const> <type>] [(def: (<name> _) Nullary - (|>> <const> ($i.wrap <type>)))] + (|>> <const> (_.wrap <type>)))] - [frac//smallest ($i.double Double::MIN_VALUE) #$.Double] - [frac//min ($i.double (f/* -1.0 Double::MAX_VALUE)) #$.Double] - [frac//max ($i.double Double::MAX_VALUE) #$.Double] + [frac//smallest (_.double Double::MIN_VALUE) #$.Double] + [frac//min (_.double (f/* -1.0 Double::MAX_VALUE)) #$.Double] + [frac//max (_.double Double::MAX_VALUE) #$.Double] ) (do-template [<name> <type> <op>] [(def: (<name> [subjectI paramI]) Binary - (|>> subjectI ($i.unwrap <type>) - paramI ($i.unwrap <type>) + (|>> subjectI (_.unwrap <type>) + paramI (_.unwrap <type>) <op> - ($i.wrap <type>)))] + (_.wrap <type>)))] - [int//add #$.Long $i.LADD] - [int//sub #$.Long $i.LSUB] - [int//mul #$.Long $i.LMUL] - [int//div #$.Long $i.LDIV] - [int//rem #$.Long $i.LREM] + [int//add #$.Long _.LADD] + [int//sub #$.Long _.LSUB] + [int//mul #$.Long _.LMUL] + [int//div #$.Long _.LDIV] + [int//rem #$.Long _.LREM] - [frac//add #$.Double $i.DADD] - [frac//sub #$.Double $i.DSUB] - [frac//mul #$.Double $i.DMUL] - [frac//div #$.Double $i.DDIV] - [frac//rem #$.Double $i.DREM] + [frac//add #$.Double _.DADD] + [frac//sub #$.Double _.DSUB] + [frac//mul #$.Double _.DMUL] + [frac//div #$.Double _.DDIV] + [frac//rem #$.Double _.DREM] ) (do-template [<eq> <lt> <unwrap> <cmp>] @@ -287,13 +287,13 @@ (|>> subjectI <unwrap> paramI <unwrap> <cmp> - ($i.int <reference>) - (predicateI $i.IF_ICMPEQ)))] + (_.int <reference>) + (predicateI _.IF_ICMPEQ)))] [<eq> 0] [<lt> -1])] - [int//eq int//lt ($i.unwrap #$.Long) $i.LCMP] - [frac//eq frac//lt ($i.unwrap #$.Double) $i.DCMPG] + [int//eq int//lt (_.unwrap #$.Long) _.LCMP] + [frac//eq frac//lt (_.unwrap #$.Double) _.DCMPG] ) (do-template [<name> <prepare> <transform>] @@ -301,15 +301,15 @@ Unary (|>> inputI <prepare> <transform>))] - [int//to-frac ($i.unwrap #$.Long) (<| ($i.wrap #$.Double) $i.L2D)] - [int//char ($i.unwrap #$.Long) - ((|>> $i.L2I $i.I2C ($i.INVOKESTATIC "java.lang.Character" "toString" ($t.method (list $t.char) (#.Some $String) (list)) #0)))] + [int//to-frac (_.unwrap #$.Long) (<| (_.wrap #$.Double) _.L2D)] + [int//char (_.unwrap #$.Long) + ((|>> _.L2I _.I2C (_.INVOKESTATIC "java.lang.Character" "toString" ($t.method (list $t.char) (#.Some $String) (list)) #0)))] - [frac//to-int ($i.unwrap #$.Double) (<| ($i.wrap #$.Long) $i.D2L)] - [frac//encode ($i.unwrap #$.Double) - ($i.INVOKESTATIC "java.lang.Double" "toString" ($t.method (list $t.double) (#.Some $String) (list)) #0)] - [frac//decode ($i.CHECKCAST "java.lang.String") - ($i.INVOKESTATIC hostL.runtime-class "decode_frac" ($t.method (list $String) (#.Some $Object-Array) (list)) #0)] + [frac//to-int (_.unwrap #$.Double) (<| (_.wrap #$.Long) _.D2L)] + [frac//encode (_.unwrap #$.Double) + (_.INVOKESTATIC "java.lang.Double" "toString" ($t.method (list $t.double) (#.Some $String) (list)) #0)] + [frac//decode (_.CHECKCAST "java.lang.String") + (_.INVOKESTATIC hostL.runtime-class "decode_frac" ($t.method (list $String) (#.Some $Object-Array) (list)) #0)] ) ## [[Text]] @@ -317,8 +317,8 @@ [(def: (<name> inputI) Unary (|>> inputI - ($i.CHECKCAST "java.lang.String") - ($i.INVOKEVIRTUAL <class> <method> ($t.method (list) (#.Some <outputT>) (list)) #0) + (_.CHECKCAST "java.lang.String") + (_.INVOKEVIRTUAL <class> <method> ($t.method (list) (#.Some <outputT>) (list)) #0) <post>))] [text//size "java.lang.String" "length" lux-intI $t.int] @@ -332,16 +332,16 @@ <op> <post>))] [text//eq id id - ($i.INVOKEVIRTUAL "java.lang.Object" "equals" ($t.method (list $Object) (#.Some $t.boolean) (list)) #0) - ($i.wrap #$.Boolean)] - [text//lt ($i.CHECKCAST "java.lang.String") ($i.CHECKCAST "java.lang.String") - ($i.INVOKEVIRTUAL "java.lang.String" "compareTo" ($t.method (list $String) (#.Some $t.int) (list)) #0) - (<| (predicateI $i.IF_ICMPEQ) ($i.int -1))] - [text//concat ($i.CHECKCAST "java.lang.String") ($i.CHECKCAST "java.lang.String") - ($i.INVOKEVIRTUAL "java.lang.String" "concat" ($t.method (list $String) (#.Some $String) (list)) #0) + (_.INVOKEVIRTUAL "java.lang.Object" "equals" ($t.method (list $Object) (#.Some $t.boolean) (list)) #0) + (_.wrap #$.Boolean)] + [text//lt (_.CHECKCAST "java.lang.String") (_.CHECKCAST "java.lang.String") + (_.INVOKEVIRTUAL "java.lang.String" "compareTo" ($t.method (list $String) (#.Some $t.int) (list)) #0) + (<| (predicateI _.IF_ICMPEQ) (_.int -1))] + [text//concat (_.CHECKCAST "java.lang.String") (_.CHECKCAST "java.lang.String") + (_.INVOKEVIRTUAL "java.lang.String" "concat" ($t.method (list $String) (#.Some $String) (list)) #0) id] - [text//char ($i.CHECKCAST "java.lang.String") jvm-intI - ($i.INVOKESTATIC hostL.runtime-class "text_char" ($t.method (list $String $t.int) (#.Some $Variant) (list)) #0) + [text//char (_.CHECKCAST "java.lang.String") jvm-intI + (_.INVOKESTATIC hostL.runtime-class "text_char" ($t.method (list $String $t.int) (#.Some $Variant) (list)) #0) id] ) @@ -353,30 +353,30 @@ extraI <pre-extra> <op>))] - [text//clip ($i.CHECKCAST "java.lang.String") jvm-intI jvm-intI - ($i.INVOKESTATIC hostL.runtime-class "text_clip" - ($t.method (list $String $t.int $t.int) (#.Some $Variant) (list)) #0)] + [text//clip (_.CHECKCAST "java.lang.String") jvm-intI jvm-intI + (_.INVOKESTATIC hostL.runtime-class "text_clip" + ($t.method (list $String $t.int $t.int) (#.Some $Variant) (list)) #0)] ) (def: index-method $.Method ($t.method (list $String $t.int) (#.Some $t.int) (list))) (def: (text//index [textI partI startI]) Trinary - (<| $i.with-label (function (_ @not-found)) - $i.with-label (function (_ @end)) - (|>> textI ($i.CHECKCAST "java.lang.String") - partI ($i.CHECKCAST "java.lang.String") + (<| _.with-label (function (_ @not-found)) + _.with-label (function (_ @end)) + (|>> textI (_.CHECKCAST "java.lang.String") + partI (_.CHECKCAST "java.lang.String") startI jvm-intI - ($i.INVOKEVIRTUAL "java.lang.String" "indexOf" index-method #0) - $i.DUP - ($i.int -1) - ($i.IF_ICMPEQ @not-found) + (_.INVOKEVIRTUAL "java.lang.String" "indexOf" index-method #0) + _.DUP + (_.int -1) + (_.IF_ICMPEQ @not-found) lux-intI runtimeT.someI - ($i.GOTO @end) - ($i.label @not-found) - $i.POP + (_.GOTO @end) + (_.label @not-found) + _.POP runtimeT.noneI - ($i.label @end)))) + (_.label @end)))) ## [[Math]] (def: math-unary-method ($t.method (list $t.double) (#.Some $t.double) (list))) @@ -386,9 +386,9 @@ [(def: (<name> inputI) Unary (|>> inputI - ($i.unwrap #$.Double) - ($i.INVOKESTATIC "java.lang.Math" <method> math-unary-method #0) - ($i.wrap #$.Double)))] + (_.unwrap #$.Double) + (_.INVOKESTATIC "java.lang.Math" <method> math-unary-method #0) + (_.wrap #$.Double)))] [math//cos "cos"] [math//sin "sin"] @@ -408,10 +408,10 @@ (do-template [<name> <method>] [(def: (<name> [inputI paramI]) Binary - (|>> inputI ($i.unwrap #$.Double) - paramI ($i.unwrap #$.Double) - ($i.INVOKESTATIC "java.lang.Math" <method> math-binary-method #0) - ($i.wrap #$.Double)))] + (|>> inputI (_.unwrap #$.Double) + paramI (_.unwrap #$.Double) + (_.INVOKESTATIC "java.lang.Math" <method> math-binary-method #0) + (_.wrap #$.Double)))] [math//atan2 "atan2"] [math//pow "pow"] @@ -420,103 +420,103 @@ (def: (math//round inputI) Unary (|>> inputI - ($i.unwrap #$.Double) - ($i.INVOKESTATIC "java.lang.Math" "round" ($t.method (list $t.double) (#.Some $t.long) (list)) #0) - $i.L2D - ($i.wrap #$.Double))) + (_.unwrap #$.Double) + (_.INVOKESTATIC "java.lang.Math" "round" ($t.method (list $t.double) (#.Some $t.long) (list)) #0) + _.L2D + (_.wrap #$.Double))) ## [[IO]] (def: string-method $.Method ($t.method (list $String) #.None (list))) (def: (io//log messageI) Unary - (|>> ($i.GETSTATIC "java.lang.System" "out" ($t.class "java.io.PrintStream" (list))) + (|>> (_.GETSTATIC "java.lang.System" "out" ($t.class "java.io.PrintStream" (list))) messageI - ($i.CHECKCAST "java.lang.String") - ($i.INVOKEVIRTUAL "java.io.PrintStream" "println" string-method #0) + (_.CHECKCAST "java.lang.String") + (_.INVOKEVIRTUAL "java.io.PrintStream" "println" string-method #0) unitI)) (def: (io//error messageI) Unary - (|>> ($i.NEW "java.lang.Error") - $i.DUP + (|>> (_.NEW "java.lang.Error") + _.DUP messageI - ($i.CHECKCAST "java.lang.String") - ($i.INVOKESPECIAL "java.lang.Error" "<init>" string-method #0) - $i.ATHROW)) + (_.CHECKCAST "java.lang.String") + (_.INVOKESPECIAL "java.lang.Error" "<init>" string-method #0) + _.ATHROW)) (def: (io//exit codeI) Unary (|>> codeI jvm-intI - ($i.INVOKESTATIC "java.lang.System" "exit" ($t.method (list $t.int) #.None (list)) #0) - $i.NULL)) + (_.INVOKESTATIC "java.lang.System" "exit" ($t.method (list $t.int) #.None (list)) #0) + _.NULL)) (def: (io//current-time []) Nullary - (|>> ($i.INVOKESTATIC "java.lang.System" "currentTimeMillis" ($t.method (list) (#.Some $t.long) (list)) #0) - ($i.wrap #$.Long))) + (|>> (_.INVOKESTATIC "java.lang.System" "currentTimeMillis" ($t.method (list) (#.Some $t.long) (list)) #0) + (_.wrap #$.Long))) ## [[Atoms]] (def: atom-class Text "java.util.concurrent.atomic.AtomicReference") (def: (atom//new initI) Unary - (|>> ($i.NEW atom-class) - $i.DUP + (|>> (_.NEW atom-class) + _.DUP initI - ($i.INVOKESPECIAL atom-class "<init>" ($t.method (list $Object) #.None (list)) #0))) + (_.INVOKESPECIAL atom-class "<init>" ($t.method (list $Object) #.None (list)) #0))) (def: (atom//read atomI) Unary (|>> atomI - ($i.CHECKCAST atom-class) - ($i.INVOKEVIRTUAL atom-class "get" ($t.method (list) (#.Some $Object) (list)) #0))) + (_.CHECKCAST atom-class) + (_.INVOKEVIRTUAL atom-class "get" ($t.method (list) (#.Some $Object) (list)) #0))) (def: (atom//compare-and-swap [atomI oldI newI]) Trinary (|>> atomI - ($i.CHECKCAST atom-class) + (_.CHECKCAST atom-class) oldI newI - ($i.INVOKEVIRTUAL atom-class "compareAndSet" ($t.method (list $Object $Object) (#.Some $t.boolean) (list)) #0) - ($i.wrap #$.Boolean))) + (_.INVOKEVIRTUAL atom-class "compareAndSet" ($t.method (list $Object $Object) (#.Some $t.boolean) (list)) #0) + (_.wrap #$.Boolean))) ## [[Box]] (def: empty-boxI $.Inst - (|>> ($i.int 1) ($i.ANEWARRAY ($t.binary-name "java.lang.Object")))) + (|>> (_.int 1) (_.ANEWARRAY ($t.binary-name "java.lang.Object")))) (def: check-boxI $.Inst - ($i.CHECKCAST ($t.descriptor $Object-Array))) + (_.CHECKCAST ($t.descriptor $Object-Array))) (def: (box//new initI) Unary (|>> empty-boxI - $i.DUP ($i.int 0) initI $i.AASTORE)) + _.DUP (_.int 0) initI _.AASTORE)) (def: (box//read boxI) Unary (|>> boxI check-boxI - ($i.int 0) $i.AALOAD)) + (_.int 0) _.AALOAD)) (def: (box//write [valueI boxI]) Binary (|>> boxI check-boxI - ($i.int 0) valueI $i.AASTORE + (_.int 0) valueI _.AASTORE unitI)) ## [[Processes]] (def: (process//parallelism-level []) Nullary - (|>> ($i.INVOKESTATIC "java.lang.Runtime" "getRuntime" ($t.method (list) (#.Some ($t.class "java.lang.Runtime" (list))) (list)) #0) - ($i.INVOKEVIRTUAL "java.lang.Runtime" "availableProcessors" ($t.method (list) (#.Some $t.int) (list)) #0) + (|>> (_.INVOKESTATIC "java.lang.Runtime" "getRuntime" ($t.method (list) (#.Some ($t.class "java.lang.Runtime" (list))) (list)) #0) + (_.INVOKEVIRTUAL "java.lang.Runtime" "availableProcessors" ($t.method (list) (#.Some $t.int) (list)) #0) lux-intI)) (def: (process//schedule [millisecondsI procedureI]) Binary - (|>> millisecondsI ($i.unwrap #$.Long) - procedureI ($i.CHECKCAST hostL.function-class) - ($i.INVOKESTATIC hostL.runtime-class "schedule" - ($t.method (list $t.long $Function) (#.Some $Object) (list)) #0))) + (|>> millisecondsI (_.unwrap #$.Long) + procedureI (_.CHECKCAST hostL.function-class) + (_.INVOKESTATIC hostL.runtime-class "schedule" + ($t.method (list $t.long $Function) (#.Some $Object) (list)) #0))) ## [Bundles] (def: lux-procs diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.jvm.lux index ddf345a13..370f07f82 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.jvm.lux @@ -19,7 +19,7 @@ (host ["$" jvm] (jvm ["$t" type] ["$d" def] - ["$i" inst])) + ["_" inst])) ["la" analysis] (extension (analysis ["&." host])) ["ls" synthesis])) @@ -38,47 +38,47 @@ $.Inst <inst>)] - [L2S (|>> $i.L2I $i.I2S)] - [L2B (|>> $i.L2I $i.I2B)] - [L2C (|>> $i.L2I $i.I2C)] + [L2S (|>> _.L2I _.I2S)] + [L2B (|>> _.L2I _.I2B)] + [L2C (|>> _.L2I _.I2C)] ) (do-template [<name> <unwrap> <conversion> <wrap>] [(def: (<name> inputI) @.Unary - (if (is? $i.NOP <conversion>) + (if (is? _.NOP <conversion>) (|>> inputI - ($i.unwrap <unwrap>) - ($i.wrap <wrap>)) + (_.unwrap <unwrap>) + (_.wrap <wrap>)) (|>> inputI - ($i.unwrap <unwrap>) + (_.unwrap <unwrap>) <conversion> - ($i.wrap <wrap>))))] + (_.wrap <wrap>))))] - [convert//double-to-float #$.Double $i.D2F #$.Float] - [convert//double-to-int #$.Double $i.D2I #$.Int] - [convert//double-to-long #$.Double $i.D2L #$.Long] - [convert//float-to-double #$.Float $i.F2D #$.Double] - [convert//float-to-int #$.Float $i.F2I #$.Int] - [convert//float-to-long #$.Float $i.F2L #$.Long] - [convert//int-to-byte #$.Int $i.I2B #$.Byte] - [convert//int-to-char #$.Int $i.I2C #$.Char] - [convert//int-to-double #$.Int $i.I2D #$.Double] - [convert//int-to-float #$.Int $i.I2F #$.Float] - [convert//int-to-long #$.Int $i.I2L #$.Long] - [convert//int-to-short #$.Int $i.I2S #$.Short] - [convert//long-to-double #$.Long $i.L2D #$.Double] - [convert//long-to-float #$.Long $i.L2F #$.Float] - [convert//long-to-int #$.Long $i.L2I #$.Int] + [convert//double-to-float #$.Double _.D2F #$.Float] + [convert//double-to-int #$.Double _.D2I #$.Int] + [convert//double-to-long #$.Double _.D2L #$.Long] + [convert//float-to-double #$.Float _.F2D #$.Double] + [convert//float-to-int #$.Float _.F2I #$.Int] + [convert//float-to-long #$.Float _.F2L #$.Long] + [convert//int-to-byte #$.Int _.I2B #$.Byte] + [convert//int-to-char #$.Int _.I2C #$.Char] + [convert//int-to-double #$.Int _.I2D #$.Double] + [convert//int-to-float #$.Int _.I2F #$.Float] + [convert//int-to-long #$.Int _.I2L #$.Long] + [convert//int-to-short #$.Int _.I2S #$.Short] + [convert//long-to-double #$.Long _.L2D #$.Double] + [convert//long-to-float #$.Long _.L2F #$.Float] + [convert//long-to-int #$.Long _.L2I #$.Int] [convert//long-to-short #$.Long L2S #$.Short] [convert//long-to-byte #$.Long L2B #$.Byte] [convert//long-to-char #$.Long L2C #$.Char] - [convert//char-to-byte #$.Char $i.I2B #$.Byte] - [convert//char-to-short #$.Char $i.I2S #$.Short] - [convert//char-to-int #$.Char $i.NOP #$.Int] - [convert//char-to-long #$.Char $i.I2L #$.Long] - [convert//byte-to-long #$.Byte $i.I2L #$.Long] - [convert//short-to-long #$.Short $i.I2L #$.Long] + [convert//char-to-byte #$.Char _.I2B #$.Byte] + [convert//char-to-short #$.Char _.I2S #$.Short] + [convert//char-to-int #$.Char _.NOP #$.Int] + [convert//char-to-long #$.Char _.I2L #$.Long] + [convert//byte-to-long #$.Byte _.I2L #$.Long] + [convert//short-to-long #$.Short _.I2L #$.Long] ) (def: conversion-procs @@ -114,96 +114,96 @@ (do-template [<name> <op> <unwrapX> <unwrapY> <wrap>] [(def: (<name> [xI yI]) @.Binary - (|>> xI ($i.unwrap <unwrapX>) - yI ($i.unwrap <unwrapY>) - <op> ($i.wrap <wrap>)))] - - [int//+ $i.IADD #$.Int #$.Int #$.Int] - [int//- $i.ISUB #$.Int #$.Int #$.Int] - [int//* $i.IMUL #$.Int #$.Int #$.Int] - [int/// $i.IDIV #$.Int #$.Int #$.Int] - [int//% $i.IREM #$.Int #$.Int #$.Int] - [int//and $i.IAND #$.Int #$.Int #$.Int] - [int//or $i.IOR #$.Int #$.Int #$.Int] - [int//xor $i.IXOR #$.Int #$.Int #$.Int] - [int//shl $i.ISHL #$.Int #$.Int #$.Int] - [int//shr $i.ISHR #$.Int #$.Int #$.Int] - [int//ushr $i.IUSHR #$.Int #$.Int #$.Int] + (|>> xI (_.unwrap <unwrapX>) + yI (_.unwrap <unwrapY>) + <op> (_.wrap <wrap>)))] + + [int//+ _.IADD #$.Int #$.Int #$.Int] + [int//- _.ISUB #$.Int #$.Int #$.Int] + [int//* _.IMUL #$.Int #$.Int #$.Int] + [int/// _.IDIV #$.Int #$.Int #$.Int] + [int//% _.IREM #$.Int #$.Int #$.Int] + [int//and _.IAND #$.Int #$.Int #$.Int] + [int//or _.IOR #$.Int #$.Int #$.Int] + [int//xor _.IXOR #$.Int #$.Int #$.Int] + [int//shl _.ISHL #$.Int #$.Int #$.Int] + [int//shr _.ISHR #$.Int #$.Int #$.Int] + [int//ushr _.IUSHR #$.Int #$.Int #$.Int] - [long//+ $i.LADD #$.Long #$.Long #$.Long] - [long//- $i.LSUB #$.Long #$.Long #$.Long] - [long//* $i.LMUL #$.Long #$.Long #$.Long] - [long/// $i.LDIV #$.Long #$.Long #$.Long] - [long//% $i.LREM #$.Long #$.Long #$.Long] - [long//and $i.LAND #$.Long #$.Long #$.Long] - [long//or $i.LOR #$.Long #$.Long #$.Long] - [long//xor $i.LXOR #$.Long #$.Long #$.Long] - [long//shl $i.LSHL #$.Long #$.Int #$.Long] - [long//shr $i.LSHR #$.Long #$.Int #$.Long] - [long//ushr $i.LUSHR #$.Long #$.Int #$.Long] - - [float//+ $i.FADD #$.Float #$.Float #$.Float] - [float//- $i.FSUB #$.Float #$.Float #$.Float] - [float//* $i.FMUL #$.Float #$.Float #$.Float] - [float/// $i.FDIV #$.Float #$.Float #$.Float] - [float//% $i.FREM #$.Float #$.Float #$.Float] + [long//+ _.LADD #$.Long #$.Long #$.Long] + [long//- _.LSUB #$.Long #$.Long #$.Long] + [long//* _.LMUL #$.Long #$.Long #$.Long] + [long/// _.LDIV #$.Long #$.Long #$.Long] + [long//% _.LREM #$.Long #$.Long #$.Long] + [long//and _.LAND #$.Long #$.Long #$.Long] + [long//or _.LOR #$.Long #$.Long #$.Long] + [long//xor _.LXOR #$.Long #$.Long #$.Long] + [long//shl _.LSHL #$.Long #$.Int #$.Long] + [long//shr _.LSHR #$.Long #$.Int #$.Long] + [long//ushr _.LUSHR #$.Long #$.Int #$.Long] + + [float//+ _.FADD #$.Float #$.Float #$.Float] + [float//- _.FSUB #$.Float #$.Float #$.Float] + [float//* _.FMUL #$.Float #$.Float #$.Float] + [float/// _.FDIV #$.Float #$.Float #$.Float] + [float//% _.FREM #$.Float #$.Float #$.Float] - [double//+ $i.DADD #$.Double #$.Double #$.Double] - [double//- $i.DSUB #$.Double #$.Double #$.Double] - [double//* $i.DMUL #$.Double #$.Double #$.Double] - [double/// $i.DDIV #$.Double #$.Double #$.Double] - [double//% $i.DREM #$.Double #$.Double #$.Double] + [double//+ _.DADD #$.Double #$.Double #$.Double] + [double//- _.DSUB #$.Double #$.Double #$.Double] + [double//* _.DMUL #$.Double #$.Double #$.Double] + [double/// _.DDIV #$.Double #$.Double #$.Double] + [double//% _.DREM #$.Double #$.Double #$.Double] ) (def: boolean-class ($t.class "java.lang.Boolean" (list))) -(def: falseI ($i.GETSTATIC "java.lang.Boolean" "FALSE" boolean-class)) -(def: trueI ($i.GETSTATIC "java.lang.Boolean" "TRUE" boolean-class)) +(def: falseI (_.GETSTATIC "java.lang.Boolean" "FALSE" boolean-class)) +(def: trueI (_.GETSTATIC "java.lang.Boolean" "TRUE" boolean-class)) (do-template [<name> <op> <unwrapX> <unwrapY> <wrap>] [(def: (<name> [xI yI]) @.Binary - (<| $i.with-label (function (_ @then)) - $i.with-label (function (_ @end)) - (|>> xI ($i.unwrap <unwrapX>) - yI ($i.unwrap <unwrapY>) + (<| _.with-label (function (_ @then)) + _.with-label (function (_ @end)) + (|>> xI (_.unwrap <unwrapX>) + yI (_.unwrap <unwrapY>) (<op> @then) falseI - ($i.GOTO @end) - ($i.label @then) + (_.GOTO @end) + (_.label @then) trueI - ($i.label @end))))] + (_.label @end))))] - [int//= $i.IF_ICMPEQ #$.Int #$.Int #$.Boolean] - [int//< $i.IF_ICMPLT #$.Int #$.Int #$.Boolean] + [int//= _.IF_ICMPEQ #$.Int #$.Int #$.Boolean] + [int//< _.IF_ICMPLT #$.Int #$.Int #$.Boolean] - [char//= $i.IF_ICMPEQ #$.Char #$.Char #$.Boolean] - [char//< $i.IF_ICMPLT #$.Char #$.Char #$.Boolean] + [char//= _.IF_ICMPEQ #$.Char #$.Char #$.Boolean] + [char//< _.IF_ICMPLT #$.Char #$.Char #$.Boolean] ) (do-template [<name> <op> <reference> <unwrapX> <unwrapY> <wrap>] [(def: (<name> [xI yI]) @.Binary - (<| $i.with-label (function (_ @then)) - $i.with-label (function (_ @end)) - (|>> xI ($i.unwrap <unwrapX>) - yI ($i.unwrap <unwrapY>) + (<| _.with-label (function (_ @then)) + _.with-label (function (_ @end)) + (|>> xI (_.unwrap <unwrapX>) + yI (_.unwrap <unwrapY>) <op> - ($i.int <reference>) - ($i.IF_ICMPEQ @then) + (_.int <reference>) + (_.IF_ICMPEQ @then) falseI - ($i.GOTO @end) - ($i.label @then) + (_.GOTO @end) + (_.label @then) trueI - ($i.label @end))))] + (_.label @end))))] - [long//= $i.LCMP 0 #$.Long #$.Long #$.Boolean] - [long//< $i.LCMP -1 #$.Long #$.Long #$.Boolean] + [long//= _.LCMP 0 #$.Long #$.Long #$.Boolean] + [long//< _.LCMP -1 #$.Long #$.Long #$.Boolean] - [float//= $i.FCMPG 0 #$.Float #$.Float #$.Boolean] - [float//< $i.FCMPG -1 #$.Float #$.Float #$.Boolean] + [float//= _.FCMPG 0 #$.Float #$.Float #$.Boolean] + [float//< _.FCMPG -1 #$.Float #$.Float #$.Boolean] - [double//= $i.DCMPG 0 #$.Double #$.Double #$.Boolean] - [double//< $i.DCMPG -1 #$.Double #$.Double #$.Boolean] + [double//= _.DCMPG 0 #$.Double #$.Double #$.Boolean] + [double//< _.DCMPG -1 #$.Double #$.Double #$.Boolean] ) (def: int-procs @@ -281,9 +281,9 @@ (def: (array//length arrayI) @.Unary (|>> arrayI - $i.ARRAYLENGTH - $i.I2L - ($i.wrap #$.Long))) + _.ARRAYLENGTH + _.I2L + (_.wrap #$.Long))) (def: (array//new proc translate inputs) (-> Text @.Proc) @@ -302,9 +302,9 @@ "char" $t.char _ ($t.class class (list))))]] (wrap (|>> lengthI - ($i.unwrap #$.Long) - $i.L2I - ($i.array arrayJT)))) + (_.unwrap #$.Long) + _.L2I + (_.array arrayJT)))) _ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs)))) @@ -317,19 +317,19 @@ [arrayI (translate arrayS) idxI (translate idxS) #let [loadI (case class - "boolean" (|>> $i.BALOAD ($i.wrap #$.Boolean)) - "byte" (|>> $i.BALOAD ($i.wrap #$.Byte)) - "short" (|>> $i.SALOAD ($i.wrap #$.Short)) - "int" (|>> $i.IALOAD ($i.wrap #$.Int)) - "long" (|>> $i.LALOAD ($i.wrap #$.Long)) - "float" (|>> $i.FALOAD ($i.wrap #$.Float)) - "double" (|>> $i.DALOAD ($i.wrap #$.Double)) - "char" (|>> $i.CALOAD ($i.wrap #$.Char)) - _ $i.AALOAD)]] + "boolean" (|>> _.BALOAD (_.wrap #$.Boolean)) + "byte" (|>> _.BALOAD (_.wrap #$.Byte)) + "short" (|>> _.SALOAD (_.wrap #$.Short)) + "int" (|>> _.IALOAD (_.wrap #$.Int)) + "long" (|>> _.LALOAD (_.wrap #$.Long)) + "float" (|>> _.FALOAD (_.wrap #$.Float)) + "double" (|>> _.DALOAD (_.wrap #$.Double)) + "char" (|>> _.CALOAD (_.wrap #$.Char)) + _ _.AALOAD)]] (wrap (|>> arrayI idxI - ($i.unwrap #$.Long) - $i.L2I + (_.unwrap #$.Long) + _.L2I loadI))) _ @@ -344,20 +344,20 @@ idxI (translate idxS) valueI (translate valueS) #let [storeI (case class - "boolean" (|>> ($i.unwrap #$.Boolean) $i.BASTORE) - "byte" (|>> ($i.unwrap #$.Byte) $i.BASTORE) - "short" (|>> ($i.unwrap #$.Short) $i.SASTORE) - "int" (|>> ($i.unwrap #$.Int) $i.IASTORE) - "long" (|>> ($i.unwrap #$.Long) $i.LASTORE) - "float" (|>> ($i.unwrap #$.Float) $i.FASTORE) - "double" (|>> ($i.unwrap #$.Double) $i.DASTORE) - "char" (|>> ($i.unwrap #$.Char) $i.CASTORE) - _ $i.AASTORE)]] + "boolean" (|>> (_.unwrap #$.Boolean) _.BASTORE) + "byte" (|>> (_.unwrap #$.Byte) _.BASTORE) + "short" (|>> (_.unwrap #$.Short) _.SASTORE) + "int" (|>> (_.unwrap #$.Int) _.IASTORE) + "long" (|>> (_.unwrap #$.Long) _.LASTORE) + "float" (|>> (_.unwrap #$.Float) _.FASTORE) + "double" (|>> (_.unwrap #$.Double) _.DASTORE) + "char" (|>> (_.unwrap #$.Char) _.CASTORE) + _ _.AASTORE)]] (wrap (|>> arrayI - $i.DUP + _.DUP idxI - ($i.unwrap #$.Long) - $i.L2I + (_.unwrap #$.Long) + _.L2I valueI storeI))) @@ -376,33 +376,33 @@ (def: (object//null _) @.Nullary - $i.NULL) + _.NULL) (def: (object//null? objectI) @.Unary - (<| $i.with-label (function (_ @then)) - $i.with-label (function (_ @end)) + (<| _.with-label (function (_ @then)) + _.with-label (function (_ @end)) (|>> objectI - ($i.IFNULL @then) + (_.IFNULL @then) falseI - ($i.GOTO @end) - ($i.label @then) + (_.GOTO @end) + (_.label @then) trueI - ($i.label @end)))) + (_.label @end)))) (def: (object//synchronized [monitorI exprI]) @.Binary (|>> monitorI - $i.DUP - $i.MONITORENTER + _.DUP + _.MONITORENTER exprI - $i.SWAP - $i.MONITOREXIT)) + _.SWAP + _.MONITOREXIT)) (def: (object//throw exceptionI) @.Unary (|>> exceptionI - $i.ATHROW)) + _.ATHROW)) (def: (object//class proc translate inputs) (-> Text @.Proc) @@ -410,12 +410,12 @@ (^ (list [_ (#.Text class)])) (do macro.Monad<Meta> [] - (wrap (|>> ($i.string class) - ($i.INVOKESTATIC "java.lang.Class" "forName" - ($t.method (list ($t.class "java.lang.String" (list))) - (#.Some ($t.class "java.lang.Class" (list))) - (list)) - #0)))) + (wrap (|>> (_.string class) + (_.INVOKESTATIC "java.lang.Class" "forName" + ($t.method (list ($t.class "java.lang.String" (list))) + (#.Some ($t.class "java.lang.Class" (list))) + (list)) + #0)))) _ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs)))) @@ -427,8 +427,8 @@ (do macro.Monad<Meta> [objectI (translate objectS)] (wrap (|>> objectI - ($i.INSTANCEOF class) - ($i.wrap #$.Boolean)))) + (_.INSTANCEOF class) + (_.wrap #$.Boolean)))) _ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs)))) @@ -443,10 +443,10 @@ ## Wrap (^template [<primitive> <object> <type>] [<primitive> <object>] - (wrap (|>> valueI ($i.wrap <type>))) + (wrap (|>> valueI (_.wrap <type>))) [<object> <primitive>] - (wrap (|>> valueI ($i.unwrap <type>)))) + (wrap (|>> valueI (_.unwrap <type>)))) (["boolean" "java.lang.Boolean" #$.Boolean] ["byte" "java.lang.Byte" #$.Byte] ["short" "java.lang.Short" #$.Short] @@ -505,11 +505,11 @@ "double" #$.Double "char" #$.Char _ (undefined))] - (wrap (|>> ($i.GETSTATIC class field (#$.Primitive primitive)) - ($i.wrap primitive)))) + (wrap (|>> (_.GETSTATIC class field (#$.Primitive primitive)) + (_.wrap primitive)))) #.None - (wrap ($i.GETSTATIC class field ($t.class unboxed (list)))))) + (wrap (_.GETSTATIC class field ($t.class unboxed (list)))))) _ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs)))) @@ -533,15 +533,15 @@ "char" #$.Char _ (undefined))] (wrap (|>> valueI - ($i.unwrap primitive) - ($i.PUTSTATIC class field (#$.Primitive primitive)) - ($i.string hostL.unit)))) + (_.unwrap primitive) + (_.PUTSTATIC class field (#$.Primitive primitive)) + (_.string hostL.unit)))) #.None (wrap (|>> valueI - ($i.CHECKCAST class) - ($i.PUTSTATIC class field ($t.class class (list))) - ($i.string hostL.unit))))) + (_.CHECKCAST class) + (_.PUTSTATIC class field ($t.class class (list))) + (_.string hostL.unit))))) _ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs)))) @@ -565,14 +565,14 @@ "char" #$.Char _ (undefined))] (wrap (|>> objectI - ($i.CHECKCAST class) - ($i.GETFIELD class field (#$.Primitive primitive)) - ($i.wrap primitive)))) + (_.CHECKCAST class) + (_.GETFIELD class field (#$.Primitive primitive)) + (_.wrap primitive)))) #.None (wrap (|>> objectI - ($i.CHECKCAST class) - ($i.GETFIELD class field ($t.class unboxed (list))))))) + (_.CHECKCAST class) + (_.GETFIELD class field ($t.class unboxed (list))))))) _ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs)))) @@ -597,19 +597,19 @@ "char" #$.Char _ (undefined))] (wrap (|>> objectI - ($i.CHECKCAST class) - $i.DUP + (_.CHECKCAST class) + _.DUP valueI - ($i.unwrap primitive) - ($i.PUTFIELD class field (#$.Primitive primitive))))) + (_.unwrap primitive) + (_.PUTFIELD class field (#$.Primitive primitive))))) #.None (wrap (|>> objectI - ($i.CHECKCAST class) - $i.DUP + (_.CHECKCAST class) + _.DUP valueI - ($i.CHECKCAST unboxed) - ($i.PUTFIELD class field ($t.class unboxed (list))))))) + (_.CHECKCAST unboxed) + (_.PUTFIELD class field ($t.class unboxed (list))))))) _ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs)))) @@ -676,10 +676,10 @@ (do macro.Monad<Meta> [argsTI (monad.map @ (translate-arg translate) argsS) returnT (method-return-type unboxed)] - (wrap (|>> ($i.fuse (list/map product.right argsTI)) - ($i.INVOKESTATIC class method - ($t.method (list/map product.left argsTI) returnT (list)) - #0)))) + (wrap (|>> (_.fuse (list/map product.right argsTI)) + (_.INVOKESTATIC class method + ($t.method (list/map product.left argsTI) returnT (list)) + #0)))) _ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs)))) @@ -695,8 +695,8 @@ argsTI (monad.map @ (translate-arg translate) argsS) returnT (method-return-type unboxed)] (wrap (|>> objectI - ($i.CHECKCAST class) - ($i.fuse (list/map product.right argsTI)) + (_.CHECKCAST class) + (_.fuse (list/map product.right argsTI)) (<invoke> class method ($t.method (list/map product.left argsTI) returnT (list)) <interface?>)))) @@ -704,9 +704,9 @@ _ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs))))] - [invoke//virtual $i.INVOKEVIRTUAL #0] - [invoke//special $i.INVOKESPECIAL #0] - [invoke//interface $i.INVOKEINTERFACE #1] + [invoke//virtual _.INVOKEVIRTUAL #0] + [invoke//special _.INVOKESPECIAL #0] + [invoke//interface _.INVOKEINTERFACE #1] ) (def: (invoke//constructor proc translate inputs) @@ -715,12 +715,12 @@ (^ (list& [_ (#.Text class)] argsS)) (do macro.Monad<Meta> [argsTI (monad.map @ (translate-arg translate) argsS)] - (wrap (|>> ($i.NEW class) - $i.DUP - ($i.fuse (list/map product.right argsTI)) - ($i.INVOKESPECIAL class "<init>" - ($t.method (list/map product.left argsTI) #.None (list)) - #0)))) + (wrap (|>> (_.NEW class) + _.DUP + (_.fuse (list/map product.right argsTI)) + (_.INVOKESPECIAL class "<init>" + ($t.method (list/map product.left argsTI) #.None (list)) + #0)))) _ (&.throw @.Wrong-Syntax (@.wrong-syntax proc inputs)))) 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 3686b9210..ba606a437 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux @@ -3,19 +3,20 @@ [control [monad (#+ do)]] [data - [text ("text/" Hash<Text>) + [text ("text/." Hash<Text>) format]] - [language - ["." name] - ["." reference (#+ Register Variable)] - ["." compiler ("operation/" Monad<Operation>) - ["." translation]]]] + [compiler + [default + ["." name] + ["." reference (#+ Register Variable)] + ["." phase ("operation/." Monad<Operation>) + ["." translation]]]]] [luxc [lang [host [jvm (#+ Inst Operation) ["$t" type] - ["$i" inst]]]]] + ["_" inst]]]]] ["." //]) (do-template [<name> <prefix>] @@ -29,16 +30,16 @@ (def: (foreign variable) (-> Register (Operation Inst)) - (do compiler.Monad<Operation> + (do phase.Monad<Operation> [function-class translation.context] - (wrap (|>> ($i.ALOAD +0) - ($i.GETFIELD function-class - (|> variable .nat foreign-name) - //.$Object))))) + (wrap (|>> (_.ALOAD +0) + (_.GETFIELD function-class + (|> variable .nat foreign-name) + //.$Object))))) (def: local (-> Register (Operation Inst)) - (|>> $i.ALOAD operation/wrap)) + (|>> _.ALOAD operation/wrap)) (def: #export (variable variable) (-> Variable (Operation Inst)) @@ -49,7 +50,7 @@ (#reference.Foreign variable) (foreign variable))) -(def: #export (constant [def-module def-name]) - (-> Ident (Operation Inst)) - (let [bytecode-name (format def-module "/" (name.normalize def-name) (%n (text/hash def-name)))] - (operation/wrap ($i.GETSTATIC bytecode-name //.value-field //.$Object)))) +(def: #export (constant [module short]) + (-> Name (Operation Inst)) + (let [bytecode-name (format module "/" (name.normalize short) (%n (text/hash short)))] + (operation/wrap (_.GETSTATIC bytecode-name //.value-field //.$Object)))) 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 86fe53d1e..86efad1ab 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux @@ -6,19 +6,20 @@ [text format] [collection - [list ("list/" Functor<List>)]]] + ["." list ("list/." Functor<List>)]]] ["." math] - [language - ["." compiler - [analysis (#+ Arity)] - ["." translation]]]] + [compiler + [default + ["." phase + [analysis (#+ Arity)] + ["." translation]]]]] [luxc [lang [host ["$" jvm (#+ Inst Method Def Operation) ["$t" type] ["$d" def] - ["$i" inst]]]]] + ["_" inst]]]]] ["." // (#+ ByteCode)]) (def: $Object $.Type ($t.class "java.lang.Object" (list))) @@ -37,10 +38,10 @@ (def: #export logI Inst - (let [outI ($i.GETSTATIC "java.lang.System" "out" ($t.class "java.io.PrintStream" (list))) - printI (function (_ method) ($i.INVOKEVIRTUAL "java.io.PrintStream" method ($t.method (list $Object) #.None (list)) #0))] - (|>> outI ($i.string "LOG: ") (printI "print") - outI $i.SWAP (printI "println")))) + (let [outI (_.GETSTATIC "java.lang.System" "out" ($t.class "java.io.PrintStream" (list))) + printI (function (_ method) (_.INVOKEVIRTUAL "java.io.PrintStream" method ($t.method (list $Object) #.None (list)) #0))] + (|>> outI (_.string "LOG: ") (printI "print") + outI _.SWAP (printI "println")))) (def: variant-method Method @@ -48,51 +49,51 @@ (def: #export variantI Inst - ($i.INVOKESTATIC //.runtime-class "variant_make" variant-method #0)) + (_.INVOKESTATIC //.runtime-class "variant_make" variant-method #0)) (def: #export leftI Inst - (|>> ($i.int 0) - $i.NULL - $i.DUP2_X1 - $i.POP2 + (|>> (_.int 0) + _.NULL + _.DUP2_X1 + _.POP2 variantI)) (def: #export rightI Inst - (|>> ($i.int 1) - ($i.string "") - $i.DUP2_X1 - $i.POP2 + (|>> (_.int 1) + (_.string "") + _.DUP2_X1 + _.POP2 variantI)) (def: #export someI Inst rightI) (def: #export noneI Inst - (|>> ($i.int 0) - $i.NULL - ($i.string //.unit) + (|>> (_.int 0) + _.NULL + (_.string //.unit) variantI)) (def: (try-methodI unsafeI) (-> Inst Inst) - (<| $i.with-label (function (_ @from)) - $i.with-label (function (_ @to)) - $i.with-label (function (_ @handler)) - (|>> ($i.try @from @to @handler "java.lang.Exception") - ($i.label @from) + (<| _.with-label (function (_ @from)) + _.with-label (function (_ @to)) + _.with-label (function (_ @handler)) + (|>> (_.try @from @to @handler "java.lang.Exception") + (_.label @from) unsafeI someI - $i.ARETURN - ($i.label @to) - ($i.label @handler) + _.ARETURN + (_.label @to) + (_.label @handler) noneI - $i.ARETURN))) + _.ARETURN))) (def: #export string-concatI Inst - ($i.INVOKEVIRTUAL "java.lang.String" "concat" ($t.method (list $String) (#.Some $String) (list)) #0)) + (_.INVOKEVIRTUAL "java.lang.String" "concat" ($t.method (list $String) (#.Some $String) (list)) #0)) (def: #export partials-field Text "partials") (def: #export apply-method Text "apply") @@ -104,84 +105,84 @@ (def: adt-methods Def - (let [store-tagI (|>> $i.DUP ($i.int 0) ($i.ILOAD +0) ($i.wrap #$.Int) $i.AASTORE) - store-flagI (|>> $i.DUP ($i.int 1) ($i.ALOAD +1) $i.AASTORE) - store-valueI (|>> $i.DUP ($i.int 2) ($i.ALOAD +2) $i.AASTORE) + (let [store-tagI (|>> _.DUP (_.int 0) (_.ILOAD +0) (_.wrap #$.Int) _.AASTORE) + store-flagI (|>> _.DUP (_.int 1) (_.ALOAD +1) _.AASTORE) + store-valueI (|>> _.DUP (_.int 2) (_.ALOAD +2) _.AASTORE) force-textMT ($t.method (list $Object) (#.Some $String) (list))] (|>> ($d.method #$.Public $.staticM "force_text" force-textMT - (<| $i.with-label (function (_ @is-null)) - $i.with-label (function (_ @normal-object)) - $i.with-label (function (_ @array-loop)) - $i.with-label (function (_ @within-bounds)) - $i.with-label (function (_ @is-first)) - $i.with-label (function (_ @elem-end)) - $i.with-label (function (_ @fold-end)) - (let [on-normal-objectI (|>> ($i.ALOAD +0) - ($i.INVOKEVIRTUAL "java.lang.Object" "toString" ($t.method (list) (#.Some $String) (list)) #0)) - on-null-objectI ($i.string "NULL") - arrayI (|>> ($i.ALOAD +0) - ($i.CHECKCAST ($t.descriptor $Object-Array))) - recurseI ($i.INVOKESTATIC //.runtime-class "force_text" force-textMT #0) - force-elemI (|>> $i.DUP arrayI $i.SWAP $i.AALOAD recurseI) - swap2 (|>> $i.DUP2_X2 ## X,Y => Y,X,Y - $i.POP2 ## Y,X,Y => Y,X + (<| _.with-label (function (_ @is-null)) + _.with-label (function (_ @normal-object)) + _.with-label (function (_ @array-loop)) + _.with-label (function (_ @within-bounds)) + _.with-label (function (_ @is-first)) + _.with-label (function (_ @elem-end)) + _.with-label (function (_ @fold-end)) + (let [on-normal-objectI (|>> (_.ALOAD +0) + (_.INVOKEVIRTUAL "java.lang.Object" "toString" ($t.method (list) (#.Some $String) (list)) #0)) + on-null-objectI (_.string "NULL") + arrayI (|>> (_.ALOAD +0) + (_.CHECKCAST ($t.descriptor $Object-Array))) + recurseI (_.INVOKESTATIC //.runtime-class "force_text" force-textMT #0) + force-elemI (|>> _.DUP arrayI _.SWAP _.AALOAD recurseI) + swap2 (|>> _.DUP2_X2 ## X,Y => Y,X,Y + _.POP2 ## Y,X,Y => Y,X ) - add-spacingI (|>> ($i.string ", ") $i.SWAP string-concatI) - merge-with-totalI (|>> $i.DUP_X2 $i.POP ## TSIP => TPSI + add-spacingI (|>> (_.string ", ") _.SWAP string-concatI) + merge-with-totalI (|>> _.DUP_X2 _.POP ## TSIP => TPSI swap2 ## TPSI => SITP string-concatI ## SITP => SIT - $i.DUP_X2 $i.POP ## SIT => TSI + _.DUP_X2 _.POP ## SIT => TSI ) - foldI (|>> $i.DUP ## TSI => TSII - ($i.IFEQ @is-first) ## TSI - force-elemI add-spacingI merge-with-totalI ($i.GOTO @elem-end) - ($i.label @is-first) ## TSI + foldI (|>> _.DUP ## TSI => TSII + (_.IFEQ @is-first) ## TSI + force-elemI add-spacingI merge-with-totalI (_.GOTO @elem-end) + (_.label @is-first) ## TSI force-elemI merge-with-totalI - ($i.label @elem-end) ## TSI + (_.label @elem-end) ## TSI ) - inc-idxI (|>> ($i.int 1) $i.IADD) - on-array-objectI (|>> ($i.string "[") ## T - arrayI $i.ARRAYLENGTH ## TS - ($i.int 0) ## TSI - ($i.label @array-loop) ## TSI - $i.DUP2 - ($i.IF_ICMPGT @within-bounds) ## TSI - $i.POP2 ($i.string "]") string-concatI ($i.GOTO @fold-end) - ($i.label @within-bounds) - foldI inc-idxI ($i.GOTO @array-loop) - ($i.label @fold-end))]) - (|>> ($i.ALOAD +0) - ($i.IFNULL @is-null) - ($i.ALOAD +0) - ($i.INSTANCEOF ($t.descriptor $Object-Array)) - ($i.IFEQ @normal-object) - on-array-objectI $i.ARETURN - ($i.label @normal-object) on-normal-objectI $i.ARETURN - ($i.label @is-null) on-null-objectI $i.ARETURN))) + inc-idxI (|>> (_.int 1) _.IADD) + on-array-objectI (|>> (_.string "[") ## T + arrayI _.ARRAYLENGTH ## TS + (_.int 0) ## TSI + (_.label @array-loop) ## TSI + _.DUP2 + (_.IF_ICMPGT @within-bounds) ## TSI + _.POP2 (_.string "]") string-concatI (_.GOTO @fold-end) + (_.label @within-bounds) + foldI inc-idxI (_.GOTO @array-loop) + (_.label @fold-end))]) + (|>> (_.ALOAD +0) + (_.IFNULL @is-null) + (_.ALOAD +0) + (_.INSTANCEOF ($t.descriptor $Object-Array)) + (_.IFEQ @normal-object) + on-array-objectI _.ARETURN + (_.label @normal-object) on-normal-objectI _.ARETURN + (_.label @is-null) on-null-objectI _.ARETURN))) ($d.method #$.Public $.staticM "variant_make" ($t.method (list $t.int $Object $Object) (#.Some $Variant) (list)) - (|>> ($i.int 3) - ($i.array $Object) + (|>> (_.int 3) + (_.array $Object) store-tagI store-flagI store-valueI - $i.ARETURN))))) + _.ARETURN))))) (def: #export force-textI Inst - ($i.INVOKESTATIC //.runtime-class "force_text" ($t.method (list $Object) (#.Some $String) (list)) #0)) + (_.INVOKESTATIC //.runtime-class "force_text" ($t.method (list $Object) (#.Some $String) (list)) #0)) -(def: frac-shiftI Inst ($i.double (math.pow 32.0 2.0))) +(def: frac-shiftI Inst (_.double (math.pow 32.0 2.0))) (def: frac-methods Def (|>> ($d.method #$.Public $.staticM "decode_frac" ($t.method (list $String) (#.Some $Object-Array) (list)) (try-methodI - (|>> ($i.ALOAD +0) - ($i.INVOKESTATIC "java.lang.Double" "parseDouble" ($t.method (list $String) (#.Some $t.double) (list)) #0) - ($i.wrap #$.Double)))) + (|>> (_.ALOAD +0) + (_.INVOKESTATIC "java.lang.Double" "parseDouble" ($t.method (list $String) (#.Some $t.double) (list)) #0) + (_.wrap #$.Double)))) )) (def: clz-method Method ($t.method (list $t.long) (#.Some $t.int) (list))) @@ -190,186 +191,186 @@ Def (|>> ($d.method #$.Public $.staticM "text_clip" ($t.method (list $String $t.int $t.int) (#.Some $Variant) (list)) (try-methodI - (|>> ($i.ALOAD +0) - ($i.ILOAD +1) - ($i.ILOAD +2) - ($i.INVOKEVIRTUAL "java.lang.String" "substring" ($t.method (list $t.int $t.int) (#.Some $String) (list)) #0)))) + (|>> (_.ALOAD +0) + (_.ILOAD +1) + (_.ILOAD +2) + (_.INVOKEVIRTUAL "java.lang.String" "substring" ($t.method (list $t.int $t.int) (#.Some $String) (list)) #0)))) ($d.method #$.Public $.staticM "text_char" ($t.method (list $String $t.int) (#.Some $Variant) (list)) (try-methodI - (|>> ($i.ALOAD +0) - ($i.ILOAD +1) - ($i.INVOKEVIRTUAL "java.lang.String" "codePointAt" ($t.method (list $t.int) (#.Some $t.int) (list)) #0) - $i.I2L - ($i.wrap #$.Long)))) + (|>> (_.ALOAD +0) + (_.ILOAD +1) + (_.INVOKEVIRTUAL "java.lang.String" "codePointAt" ($t.method (list $t.int) (#.Some $t.int) (list)) #0) + _.I2L + (_.wrap #$.Long)))) )) (def: pm-methods Def - (let [tuple-sizeI (|>> ($i.ALOAD +0) $i.ARRAYLENGTH) - tuple-elemI (|>> ($i.ALOAD +0) ($i.ILOAD +1) $i.AALOAD) - expected-last-sizeI (|>> ($i.ILOAD +1) ($i.int 1) $i.IADD) - tuple-tailI (|>> ($i.ALOAD +0) tuple-sizeI ($i.int 1) $i.ISUB $i.AALOAD ($i.CHECKCAST ($t.descriptor $Tuple)))] + (let [tuple-sizeI (|>> (_.ALOAD +0) _.ARRAYLENGTH) + tuple-elemI (|>> (_.ALOAD +0) (_.ILOAD +1) _.AALOAD) + expected-last-sizeI (|>> (_.ILOAD +1) (_.int 1) _.IADD) + tuple-tailI (|>> (_.ALOAD +0) tuple-sizeI (_.int 1) _.ISUB _.AALOAD (_.CHECKCAST ($t.descriptor $Tuple)))] (|>> ($d.method #$.Public $.staticM "pm_fail" ($t.method (list) #.None (list)) - (|>> ($i.NEW "java.lang.IllegalStateException") - $i.DUP - ($i.string "Invalid expression for pattern-matching.") - ($i.INVOKESPECIAL "java.lang.IllegalStateException" "<init>" ($t.method (list $String) #.None (list)) #0) - $i.ATHROW)) + (|>> (_.NEW "java.lang.IllegalStateException") + _.DUP + (_.string "Invalid expression for pattern-matching.") + (_.INVOKESPECIAL "java.lang.IllegalStateException" "<init>" ($t.method (list $String) #.None (list)) #0) + _.ATHROW)) ($d.method #$.Public $.staticM "apply_fail" ($t.method (list) #.None (list)) - (|>> ($i.NEW "java.lang.IllegalStateException") - $i.DUP - ($i.string "Error while applying function.") - ($i.INVOKESPECIAL "java.lang.IllegalStateException" "<init>" ($t.method (list $String) #.None (list)) #0) - $i.ATHROW)) + (|>> (_.NEW "java.lang.IllegalStateException") + _.DUP + (_.string "Error while applying function.") + (_.INVOKESPECIAL "java.lang.IllegalStateException" "<init>" ($t.method (list $String) #.None (list)) #0) + _.ATHROW)) ($d.method #$.Public $.staticM "pm_push" ($t.method (list $Stack $Object) (#.Some $Stack) (list)) - (|>> ($i.int 2) - ($i.ANEWARRAY "java.lang.Object") - $i.DUP - ($i.int 0) - ($i.ALOAD +0) - $i.AASTORE - $i.DUP - ($i.int 1) - ($i.ALOAD +1) - $i.AASTORE - $i.ARETURN)) + (|>> (_.int 2) + (_.ANEWARRAY "java.lang.Object") + _.DUP + (_.int 0) + (_.ALOAD +0) + _.AASTORE + _.DUP + (_.int 1) + (_.ALOAD +1) + _.AASTORE + _.ARETURN)) ($d.method #$.Public $.staticM "pm_pop" ($t.method (list $Stack) (#.Some $Stack) (list)) - (|>> ($i.ALOAD +0) - ($i.int 0) - $i.AALOAD - ($i.CHECKCAST ($t.descriptor $Stack)) - $i.ARETURN)) + (|>> (_.ALOAD +0) + (_.int 0) + _.AALOAD + (_.CHECKCAST ($t.descriptor $Stack)) + _.ARETURN)) ($d.method #$.Public $.staticM "pm_peek" ($t.method (list $Stack) (#.Some $Object) (list)) - (|>> ($i.ALOAD +0) - ($i.int 1) - $i.AALOAD - $i.ARETURN)) + (|>> (_.ALOAD +0) + (_.int 1) + _.AALOAD + _.ARETURN)) ($d.method #$.Public $.staticM "pm_variant" ($t.method (list $Variant $Tag $Flag) (#.Some $Object) (list)) - (<| $i.with-label (function (_ @begin)) - $i.with-label (function (_ @just-return)) - $i.with-label (function (_ @then)) - $i.with-label (function (_ @further)) - $i.with-label (function (_ @shorten)) - $i.with-label (function (_ @wrong)) + (<| _.with-label (function (_ @begin)) + _.with-label (function (_ @just-return)) + _.with-label (function (_ @then)) + _.with-label (function (_ @further)) + _.with-label (function (_ @shorten)) + _.with-label (function (_ @wrong)) (let [variant-partI (: (-> Nat Inst) (function (_ idx) - (|>> ($i.int (.int idx)) $i.AALOAD))) + (|>> (_.int (.int idx)) _.AALOAD))) tagI (: Inst - (|>> (variant-partI +0) ($i.unwrap #$.Int))) + (|>> (variant-partI +0) (_.unwrap #$.Int))) flagI (variant-partI +1) datumI (variant-partI +2) - shortenI (|>> ($i.ALOAD +0) tagI ## Get tag - ($i.ILOAD +1) $i.ISUB ## Shorten tag - ($i.ALOAD +0) flagI ## Get flag - ($i.ALOAD +0) datumI ## Get value + shortenI (|>> (_.ALOAD +0) tagI ## Get tag + (_.ILOAD +1) _.ISUB ## Shorten tag + (_.ALOAD +0) flagI ## Get flag + (_.ALOAD +0) datumI ## Get value variantI ## Build sum - $i.ARETURN) - update-tagI (|>> $i.ISUB ($i.ISTORE +1)) - update-variantI (|>> ($i.ALOAD +0) datumI ($i.CHECKCAST ($t.descriptor $Variant)) ($i.ASTORE +0)) - failureI (|>> $i.NULL $i.ARETURN) - return-datumI (|>> ($i.ALOAD +0) datumI $i.ARETURN)]) - (|>> ($i.label @begin) - ($i.ILOAD +1) ## tag - ($i.ALOAD +0) tagI ## tag, sumT - $i.DUP2 ($i.IF_ICMPEQ @then) - $i.DUP2 ($i.IF_ICMPGT @further) - $i.DUP2 ($i.IF_ICMPLT @shorten) - ## $i.POP2 + _.ARETURN) + update-tagI (|>> _.ISUB (_.ISTORE +1)) + update-variantI (|>> (_.ALOAD +0) datumI (_.CHECKCAST ($t.descriptor $Variant)) (_.ASTORE +0)) + failureI (|>> _.NULL _.ARETURN) + return-datumI (|>> (_.ALOAD +0) datumI _.ARETURN)]) + (|>> (_.label @begin) + (_.ILOAD +1) ## tag + (_.ALOAD +0) tagI ## tag, sumT + _.DUP2 (_.IF_ICMPEQ @then) + _.DUP2 (_.IF_ICMPGT @further) + _.DUP2 (_.IF_ICMPLT @shorten) + ## _.POP2 failureI - ($i.label @then) ## tag, sumT - ($i.ALOAD +2) ## tag, sumT, wants-last? - ($i.ALOAD +0) flagI ## tag, sumT, wants-last?, is-last? - ($i.IF_ACMPEQ @just-return) ## tag, sumT - ($i.label @further) ## tag, sumT - ($i.ALOAD +0) flagI ## tag, sumT, last? - ($i.IFNULL @wrong) ## tag, sumT + (_.label @then) ## tag, sumT + (_.ALOAD +2) ## tag, sumT, wants-last? + (_.ALOAD +0) flagI ## tag, sumT, wants-last?, is-last? + (_.IF_ACMPEQ @just-return) ## tag, sumT + (_.label @further) ## tag, sumT + (_.ALOAD +0) flagI ## tag, sumT, last? + (_.IFNULL @wrong) ## tag, sumT update-tagI update-variantI - ($i.GOTO @begin) - ($i.label @just-return) ## tag, sumT - ## $i.POP2 + (_.GOTO @begin) + (_.label @just-return) ## tag, sumT + ## _.POP2 return-datumI - ($i.label @shorten) ## tag, sumT - ($i.ALOAD +2) ($i.IFNULL @wrong) - ## $i.POP2 + (_.label @shorten) ## tag, sumT + (_.ALOAD +2) (_.IFNULL @wrong) + ## _.POP2 shortenI - ($i.label @wrong) ## tag, sumT - ## $i.POP2 + (_.label @wrong) ## tag, sumT + ## _.POP2 failureI))) ($d.method #$.Public $.staticM "pm_left" ($t.method (list $Tuple $t.int) (#.Some $Object) (list)) - (<| $i.with-label (function (_ @begin)) - $i.with-label (function (_ @not-recursive)) - (let [updated-idxI (|>> $i.SWAP $i.ISUB)]) - (|>> ($i.label @begin) + (<| _.with-label (function (_ @begin)) + _.with-label (function (_ @not-recursive)) + (let [updated-idxI (|>> _.SWAP _.ISUB)]) + (|>> (_.label @begin) tuple-sizeI expected-last-sizeI - $i.DUP2 ($i.IF_ICMPGT @not-recursive) + _.DUP2 (_.IF_ICMPGT @not-recursive) ## Recursive - updated-idxI ($i.ISTORE +1) - tuple-tailI ($i.ASTORE +0) - ($i.GOTO @begin) - ($i.label @not-recursive) - ## $i.POP2 + updated-idxI (_.ISTORE +1) + tuple-tailI (_.ASTORE +0) + (_.GOTO @begin) + (_.label @not-recursive) + ## _.POP2 tuple-elemI - $i.ARETURN))) + _.ARETURN))) ($d.method #$.Public $.staticM "pm_right" ($t.method (list $Tuple $t.int) (#.Some $Object) (list)) - (<| $i.with-label (function (_ @begin)) - $i.with-label (function (_ @tail)) - $i.with-label (function (_ @slice)) - (let [updated-idxI (|>> ($i.ILOAD +1) ($i.int 1) $i.IADD tuple-sizeI $i.ISUB) - sliceI (|>> ($i.ALOAD +0) ($i.ILOAD +1) tuple-sizeI - ($i.INVOKESTATIC "java.util.Arrays" "copyOfRange" ($t.method (list $Object-Array $t.int $t.int) (#.Some $Object-Array) (list)) #0))]) - (|>> ($i.label @begin) + (<| _.with-label (function (_ @begin)) + _.with-label (function (_ @tail)) + _.with-label (function (_ @slice)) + (let [updated-idxI (|>> (_.ILOAD +1) (_.int 1) _.IADD tuple-sizeI _.ISUB) + sliceI (|>> (_.ALOAD +0) (_.ILOAD +1) tuple-sizeI + (_.INVOKESTATIC "java.util.Arrays" "copyOfRange" ($t.method (list $Object-Array $t.int $t.int) (#.Some $Object-Array) (list)) #0))]) + (|>> (_.label @begin) tuple-sizeI expected-last-sizeI - $i.DUP2 ($i.IF_ICMPEQ @tail) - ($i.IF_ICMPGT @slice) + _.DUP2 (_.IF_ICMPEQ @tail) + (_.IF_ICMPGT @slice) ## Must recurse - tuple-tailI ($i.ASTORE +0) - updated-idxI ($i.ISTORE +1) - ($i.GOTO @begin) - ($i.label @slice) + tuple-tailI (_.ASTORE +0) + updated-idxI (_.ISTORE +1) + (_.GOTO @begin) + (_.label @slice) sliceI - $i.ARETURN - ($i.label @tail) - ## $i.POP2 + _.ARETURN + (_.label @tail) + ## _.POP2 tuple-elemI - $i.ARETURN))) + _.ARETURN))) ))) (def: io-methods Def - (let [string-writerI (|>> ($i.NEW "java.io.StringWriter") - $i.DUP - ($i.INVOKESPECIAL "java.io.StringWriter" "<init>" ($t.method (list) #.None (list)) #0)) - print-writerI (|>> ($i.NEW "java.io.PrintWriter") - $i.SWAP - $i.DUP2 - $i.POP - $i.SWAP - ($i.boolean #1) - ($i.INVOKESPECIAL "java.io.PrintWriter" "<init>" ($t.method (list ($t.class "java.io.Writer" (list)) $t.boolean) #.None (list)) #0) + (let [string-writerI (|>> (_.NEW "java.io.StringWriter") + _.DUP + (_.INVOKESPECIAL "java.io.StringWriter" "<init>" ($t.method (list) #.None (list)) #0)) + print-writerI (|>> (_.NEW "java.io.PrintWriter") + _.SWAP + _.DUP2 + _.POP + _.SWAP + (_.boolean #1) + (_.INVOKESPECIAL "java.io.PrintWriter" "<init>" ($t.method (list ($t.class "java.io.Writer" (list)) $t.boolean) #.None (list)) #0) )] (|>> ($d.method #$.Public $.staticM "try" ($t.method (list $Function) (#.Some $Variant) (list)) - (<| $i.with-label (function (_ @from)) - $i.with-label (function (_ @to)) - $i.with-label (function (_ @handler)) - (|>> ($i.try @from @to @handler "java.lang.Throwable") - ($i.label @from) - ($i.ALOAD +0) - $i.NULL - ($i.INVOKEVIRTUAL //.function-class apply-method (apply-signature +1) #0) + (<| _.with-label (function (_ @from)) + _.with-label (function (_ @to)) + _.with-label (function (_ @handler)) + (|>> (_.try @from @to @handler "java.lang.Throwable") + (_.label @from) + (_.ALOAD +0) + _.NULL + (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature +1) #0) rightI - $i.ARETURN - ($i.label @to) - ($i.label @handler) + _.ARETURN + (_.label @to) + (_.label @handler) string-writerI ## TW - $i.DUP2 ## TWTW + _.DUP2 ## TWTW print-writerI ## TWTP - ($i.INVOKEVIRTUAL "java.lang.Throwable" "printStackTrace" ($t.method (list ($t.class "java.io.PrintWriter" (list))) #.None (list)) #0) ## TW - ($i.INVOKEVIRTUAL "java.io.StringWriter" "toString" ($t.method (list) (#.Some $String) (list)) #0) ## TS - $i.SWAP $i.POP leftI - $i.ARETURN))) + (_.INVOKEVIRTUAL "java.lang.Throwable" "printStackTrace" ($t.method (list ($t.class "java.io.PrintWriter" (list))) #.None (list)) #0) ## TW + (_.INVOKEVIRTUAL "java.io.StringWriter" "toString" ($t.method (list) (#.Some $String) (list)) #0) ## TS + _.SWAP _.POP leftI + _.ARETURN))) ))) (def: process-methods @@ -377,55 +378,55 @@ (let [executor-class "java.util.concurrent.ScheduledThreadPoolExecutor" executorT ($t.class executor-class (list)) executor-field "executor" - endI (|>> ($i.string //.unit) - $i.ARETURN) + endI (|>> (_.string //.unit) + _.ARETURN) runnableI (: (-> Inst Inst) (function (_ functionI) - (|>> ($i.NEW //.runnable-class) - $i.DUP + (|>> (_.NEW //.runnable-class) + _.DUP functionI - ($i.INVOKESPECIAL //.runnable-class "<init>" ($t.method (list $Function) #.None (list)) #0)))) + (_.INVOKESPECIAL //.runnable-class "<init>" ($t.method (list $Function) #.None (list)) #0)))) threadI (: (-> Inst Inst) (function (_ runnableI) - (|>> ($i.NEW "java.lang.Thread") - $i.DUP + (|>> (_.NEW "java.lang.Thread") + _.DUP runnableI - ($i.INVOKESPECIAL "java.lang.Thread" "<init>" ($t.method (list $Runnable) #.None (list)) #0))))] + (_.INVOKESPECIAL "java.lang.Thread" "<init>" ($t.method (list $Runnable) #.None (list)) #0))))] (|>> ($d.field #$.Public ($.++F $.finalF $.staticF) executor-field executorT) ($d.method #$.Public $.staticM "<clinit>" ($t.method (list) #.None (list)) - (let [parallelism-levelI (|>> ($i.INVOKESTATIC "java.lang.Runtime" "getRuntime" ($t.method (list) (#.Some $Runtime) (list)) #0) - ($i.INVOKEVIRTUAL "java.lang.Runtime" "availableProcessors" ($t.method (list) (#.Some $t.int) (list)) #0)) - executorI (|>> ($i.NEW executor-class) - $i.DUP + (let [parallelism-levelI (|>> (_.INVOKESTATIC "java.lang.Runtime" "getRuntime" ($t.method (list) (#.Some $Runtime) (list)) #0) + (_.INVOKEVIRTUAL "java.lang.Runtime" "availableProcessors" ($t.method (list) (#.Some $t.int) (list)) #0)) + executorI (|>> (_.NEW executor-class) + _.DUP parallelism-levelI - ($i.INVOKESPECIAL executor-class "<init>" ($t.method (list $t.int) #.None (list)) #0))] + (_.INVOKESPECIAL executor-class "<init>" ($t.method (list $t.int) #.None (list)) #0))] (|>> executorI - ($i.PUTSTATIC //.runtime-class executor-field executorT) - $i.RETURN))) + (_.PUTSTATIC //.runtime-class executor-field executorT) + _.RETURN))) ($d.method #$.Public $.staticM "schedule" ($t.method (list $t.long $Function) (#.Some $Object) (list)) - (let [delayI ($i.LLOAD +0) + (let [delayI (_.LLOAD +0) immediacy-checkI (|>> delayI - ($i.long 0) - $i.LCMP) + (_.long 0) + _.LCMP) time-unit-class "java.util.concurrent.TimeUnit" time-unitT ($t.class time-unit-class (list)) futureT ($t.class "java.util.concurrent.ScheduledFuture" (list)) - executorI ($i.GETSTATIC //.runtime-class executor-field executorT) + executorI (_.GETSTATIC //.runtime-class executor-field executorT) schedule-laterI (|>> executorI - (runnableI ($i.ALOAD +2)) + (runnableI (_.ALOAD +2)) delayI - ($i.GETSTATIC time-unit-class "MILLISECONDS" time-unitT) - ($i.INVOKEVIRTUAL executor-class "schedule" ($t.method (list $Runnable $t.long time-unitT) (#.Some futureT) (list)) #0)) + (_.GETSTATIC time-unit-class "MILLISECONDS" time-unitT) + (_.INVOKEVIRTUAL executor-class "schedule" ($t.method (list $Runnable $t.long time-unitT) (#.Some futureT) (list)) #0)) schedule-immediatelyI (|>> executorI - (runnableI ($i.ALOAD +2)) - ($i.INVOKEVIRTUAL executor-class "execute" ($t.method (list $Runnable) #.None (list)) #0))] - (<| $i.with-label (function (_ @immediately)) + (runnableI (_.ALOAD +2)) + (_.INVOKEVIRTUAL executor-class "execute" ($t.method (list $Runnable) #.None (list)) #0))] + (<| _.with-label (function (_ @immediately)) (|>> immediacy-checkI - ($i.IFEQ @immediately) + (_.IFEQ @immediately) schedule-laterI endI - ($i.label @immediately) + (_.label @immediately) schedule-immediatelyI endI)))) ))) @@ -439,7 +440,7 @@ pm-methods io-methods process-methods))] - (do compiler.Monad<Operation> + (do phase.Monad<Operation> [_ (translation.execute! [//.runtime-class bytecode])] (wrap bytecode)))) @@ -449,27 +450,27 @@ (list/map (function (_ arity) ($d.method #$.Public $.noneM apply-method (apply-signature arity) (let [preI (|> (list.n/range +0 (dec arity)) - (list/map $i.ALOAD) - $i.fuse)] + (list/map _.ALOAD) + _.fuse)] (|>> preI - ($i.INVOKEVIRTUAL //.function-class apply-method (apply-signature (dec arity)) #0) - ($i.CHECKCAST //.function-class) - ($i.ALOAD arity) - ($i.INVOKEVIRTUAL //.function-class apply-method (apply-signature +1) #0) - $i.ARETURN))))) + (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature (dec arity)) #0) + (_.CHECKCAST //.function-class) + (_.ALOAD arity) + (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature +1) #0) + _.ARETURN))))) (list& ($d.abstract-method #$.Public $.noneM apply-method (apply-signature +1))) $d.fuse) bytecode ($d.abstract #$.V1_6 #$.Public $.noneC //.function-class (list) ["java.lang.Object" (list)] (list) (|>> ($d.field #$.Public $.finalF partials-field $t.int) ($d.method #$.Public $.noneM "<init>" ($t.method (list $t.int) #.None (list)) - (|>> ($i.ALOAD +0) - ($i.INVOKESPECIAL "java.lang.Object" "<init>" ($t.method (list) #.None (list)) #0) - ($i.ALOAD +0) - ($i.ILOAD +1) - ($i.PUTFIELD //.function-class partials-field $t.int) - $i.RETURN)) + (|>> (_.ALOAD +0) + (_.INVOKESPECIAL "java.lang.Object" "<init>" ($t.method (list) #.None (list)) #0) + (_.ALOAD +0) + (_.ILOAD +1) + (_.PUTFIELD //.function-class partials-field $t.int) + _.RETURN)) applyI))] - (do compiler.Monad<Operation> + (do phase.Monad<Operation> [_ (translation.execute! [//.function-class bytecode])] (wrap bytecode)))) @@ -479,26 +480,26 @@ bytecode ($d.class #$.V1_6 #$.Public $.finalC //.runnable-class (list) ["java.lang.Object" (list)] (list ["java.lang.Runnable" (list)]) (|>> ($d.field #$.Public $.finalF procedure-field $Function) ($d.method #$.Public $.noneM "<init>" ($t.method (list $Function) #.None (list)) - (|>> ($i.ALOAD +0) - ($i.INVOKESPECIAL "java.lang.Object" "<init>" ($t.method (list) #.None (list)) #0) - ($i.ALOAD +0) - ($i.ALOAD +1) - ($i.PUTFIELD //.runnable-class procedure-field $Function) - $i.RETURN)) + (|>> (_.ALOAD +0) + (_.INVOKESPECIAL "java.lang.Object" "<init>" ($t.method (list) #.None (list)) #0) + (_.ALOAD +0) + (_.ALOAD +1) + (_.PUTFIELD //.runnable-class procedure-field $Function) + _.RETURN)) ($d.method #$.Public $.noneM "run" ($t.method (list) #.None (list)) - (|>> ($i.ALOAD +0) - ($i.GETFIELD //.runnable-class procedure-field $Function) - $i.NULL - ($i.INVOKEVIRTUAL //.function-class apply-method (apply-signature +1) #0) - $i.RETURN)) + (|>> (_.ALOAD +0) + (_.GETFIELD //.runnable-class procedure-field $Function) + _.NULL + (_.INVOKEVIRTUAL //.function-class apply-method (apply-signature +1) #0) + _.RETURN)) ))] - (do compiler.Monad<Operation> + (do phase.Monad<Operation> [_ (translation.execute! [//.runnable-class bytecode])] (wrap bytecode)))) (def: #export translate (Operation [ByteCode ByteCode ByteCode]) - (do compiler.Monad<Operation> + (do phase.Monad<Operation> [runtime-bc translate-runtime function-bc translate-function runnable-bc translate-runnable] diff --git a/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux index 3ed9a8ebc..5abf85c05 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux @@ -40,12 +40,12 @@ (-> Text Type $.Inst Code (Meta Any)) (do macro.Monad<Meta> [current-module macro.current-module-name - #let [def-ident [current-module def-name]]] - (case (macro.get-identifier-ann (ident-for #.alias) metaV) + #let [def-name [current-module def-name]]] + (case (macro.get-identifier-ann (name-of #.alias) metaV) (#.Some real-def) (do @ [[realT realA realV] (macro.find-def real-def) - _ (&module.define def-ident [realT metaV realV])] + _ (&module.define def-name [realT metaV realV])] (wrap [])) _ @@ -70,17 +70,17 @@ [field (Class::getField [commonT.value-field] class)] (Field::get [#.None] field)) (#e.Success #.None) - (&.throw Invalid-Definition-Value (%ident def-ident)) + (&.throw Invalid-Definition-Value (%name def-name)) (#e.Success (#.Some valueV)) (wrap valueV) (#e.Error error) (&.throw Cannot-Evaluate-Definition - (format "Definition: " (%ident def-ident) "\n" + (format "Definition: " (%name def-name) "\n" "Error:\n" error)))) - _ (&module.define def-ident [valueT metaV valueV]) + _ (&module.define def-name [valueT metaV valueV]) _ (if (macro.type? metaV) (case (macro.declared-tags metaV) #.Nil @@ -89,7 +89,7 @@ tags (&module.declare-tags tags (macro.export? metaV) (:coerce Type valueV))) (wrap [])) - #let [_ (log! (format "DEF " (%ident def-ident)))]] + #let [_ (log! (format "DEF " (%name def-name)))]] (commonT.record-artifact (format bytecode-name ".class") bytecode))))) (def: #export (translate-program programI) 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 bc4a3cb95..4c29260f5 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux @@ -1,23 +1,24 @@ (.module: [lux #* [control - [monad (#+ do)] + ["." monad (#+ do)] ["ex" exception (#+ exception:)]] [data [text format] [collection ["." list]]] - [language - ["." compiler - [synthesis (#+ Synthesis)]]]] + [compiler + [default + ["." phase + [synthesis (#+ Synthesis)]]]]] [luxc [lang [host - ["." jvm (#+ Inst Operation Compiler) + ["." jvm (#+ Inst Operation Phase) ["$t" type] - ["$i" inst]]]]] - [//]) + ["_" inst]]]]] + ["." //]) (exception: #export (not-a-tuple {size Nat}) (ex.report ["Expected size" ">= 2"] @@ -26,41 +27,41 @@ (def: $Object jvm.Type ($t.class "java.lang.Object" (list))) (def: #export (tuple translate members) - (-> Compiler (List Synthesis) (Operation Inst)) - (do compiler.Monad<Operation> + (-> Phase (List Synthesis) (Operation Inst)) + (do phase.Monad<Operation> [#let [size (list.size members)] - _ (compiler.assert not-a-tuple size - (n/>= +2 size)) + _ (phase.assert not-a-tuple size + (n/>= +2 size)) membersI (|> members list.enumerate (monad.map @ (function (_ [idx member]) (do @ [memberI (translate member)] - (wrap (|>> $i.DUP - ($i.int (.int idx)) + (wrap (|>> _.DUP + (_.int (.int idx)) memberI - $i.AASTORE))))) - (:: @ map $i.fuse))] - (wrap (|>> ($i.int (.int size)) - ($i.array $Object) + _.AASTORE))))) + (:: @ map _.fuse))] + (wrap (|>> (_.int (.int size)) + (_.array $Object) membersI)))) (def: (flagI tail?) (-> Bit Inst) (if tail? - ($i.string "") - $i.NULL)) + (_.string "") + _.NULL)) (def: #export (variant translate tag tail? member) - (-> Compiler Nat Bit Synthesis (Operation Inst)) - (do compiler.Monad<Operation> + (-> Phase Nat Bit Synthesis (Operation Inst)) + (do phase.Monad<Operation> [memberI (translate member)] - (wrap (|>> ($i.int (.int tag)) + (wrap (|>> (_.int (.int tag)) (flagI tail?) memberI - ($i.INVOKESTATIC //.runtime-class - "variant_make" - ($t.method (list $t.int $Object $Object) - (#.Some ($t.array +1 $Object)) - (list)) - #0))))) + (_.INVOKESTATIC //.runtime-class + "variant_make" + ($t.method (list $t.int $Object $Object) + (#.Some ($t.array +1 $Object)) + (list)) + #0))))) |