aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/jvm
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm.lux15
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/case.jvm.lux227
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/common.jvm.lux47
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/eval.jvm.lux6
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/expression.jvm.lux13
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/function.jvm.lux31
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/imports.jvm.lux2
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/loop.jvm.lux25
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/primitive.jvm.lux21
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure.jvm.lux28
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/common.jvm.lux282
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/host.jvm.lux366
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/reference.jvm.lux35
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux555
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/statement.jvm.lux14
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/structure.jvm.lux57
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)))))