aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/jvm/procedure
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/jvm/procedure')
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux70
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux112
2 files changed, 93 insertions, 89 deletions
diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux
index aeaa1d664..cead0848e 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/common.lux
@@ -1,5 +1,5 @@
(.module:
- [lux #*
+ [lux (#- Type)
[abstract
["." monad (#+ do)]]
[control
@@ -10,6 +10,9 @@
format]
[collection
["." dictionary]]]
+ [target
+ [jvm
+ ["_t" type (#+ Type Method)]]]
[tool
[compiler
["." synthesis (#+ Synthesis)]
@@ -23,8 +26,7 @@
[luxc
[lang
[host
- ["$" jvm (#+ Label Inst Method Bundle)
- ["_t" type]
+ ["$" jvm (#+ Label Inst Bundle)
["_" inst]]]]]
["." ///
["." runtime]])
@@ -33,12 +35,12 @@
(#static MIN_VALUE Double)
(#static MAX_VALUE Double))
-(def: $Object-Array $.Type (_t.array 1 ///.$Object))
-(def: $String $.Type (_t.class "java.lang.String" (list)))
-(def: $CharSequence $.Type (_t.class "java.lang.CharSequence" (list)))
+(def: $Object-Array Type (_t.array 1 ///.$Object))
+(def: $String Type (_t.class "java.lang.String" (list)))
+(def: $CharSequence Type (_t.class "java.lang.CharSequence" (list)))
-(def: lux-intI Inst (|>> _.I2L (_.wrap #$.Long)))
-(def: jvm-intI Inst (|>> (_.unwrap #$.Long) _.L2I))
+(def: lux-intI Inst (|>> _.I2L (_.wrap #_t.Long)))
+(def: jvm-intI Inst (|>> (_.unwrap #_t.Long) _.L2I))
(def: check-stringI Inst (_.CHECKCAST "java.lang.String"))
(def: (predicateI tester)
@@ -73,9 +75,9 @@
(template [<name> <op>]
[(def: (<name> [maskI inputI])
(Binary Inst)
- (|>> inputI (_.unwrap #$.Long)
- maskI (_.unwrap #$.Long)
- <op> (_.wrap #$.Long)))]
+ (|>> inputI (_.unwrap #_t.Long)
+ maskI (_.unwrap #_t.Long)
+ <op> (_.wrap #_t.Long)))]
[bit::and _.LAND]
[bit::or _.LOR]
@@ -85,10 +87,10 @@
(template [<name> <op>]
[(def: (<name> [shiftI inputI])
(Binary Inst)
- (|>> inputI (_.unwrap #$.Long)
+ (|>> inputI (_.unwrap #_t.Long)
shiftI jvm-intI
<op>
- (_.wrap #$.Long)))]
+ (_.wrap #_t.Long)))]
[bit::left-shift _.LSHL]
[bit::arithmetic-right-shift _.LSHR]
@@ -100,9 +102,9 @@
(Nullary Inst)
(|>> <const> (_.wrap <type>)))]
- [frac::smallest (_.double (Double::MIN_VALUE)) #$.Double]
- [frac::min (_.double (f/* -1.0 (Double::MAX_VALUE))) #$.Double]
- [frac::max (_.double (Double::MAX_VALUE)) #$.Double]
+ [frac::smallest (_.double (Double::MIN_VALUE)) #_t.Double]
+ [frac::min (_.double (f/* -1.0 (Double::MAX_VALUE))) #_t.Double]
+ [frac::max (_.double (Double::MAX_VALUE)) #_t.Double]
)
(template [<name> <type> <op>]
@@ -113,17 +115,17 @@
<op>
(_.wrap <type>)))]
- [i64::+ #$.Long _.LADD]
- [i64::- #$.Long _.LSUB]
- [int::* #$.Long _.LMUL]
- [int::/ #$.Long _.LDIV]
- [int::% #$.Long _.LREM]
+ [i64::+ #_t.Long _.LADD]
+ [i64::- #_t.Long _.LSUB]
+ [int::* #_t.Long _.LMUL]
+ [int::/ #_t.Long _.LDIV]
+ [int::% #_t.Long _.LREM]
- [frac::+ #$.Double _.DADD]
- [frac::- #$.Double _.DSUB]
- [frac::* #$.Double _.DMUL]
- [frac::/ #$.Double _.DDIV]
- [frac::% #$.Double _.DREM]
+ [frac::+ #_t.Double _.DADD]
+ [frac::- #_t.Double _.DSUB]
+ [frac::* #_t.Double _.DMUL]
+ [frac::/ #_t.Double _.DDIV]
+ [frac::% #_t.Double _.DREM]
)
(template [<eq> <lt> <unwrap> <cmp>]
@@ -139,8 +141,8 @@
[<eq> +0]
[<lt> -1])]
- [i64::= int::< (_.unwrap #$.Long) _.LCMP]
- [frac::= frac::< (_.unwrap #$.Double) _.DCMPG]
+ [i64::= int::< (_.unwrap #_t.Long) _.LCMP]
+ [frac::= frac::< (_.unwrap #_t.Double) _.DCMPG]
)
(template [<name> <prepare> <transform>]
@@ -148,12 +150,12 @@
(Unary Inst)
(|>> inputI <prepare> <transform>))]
- [int::frac (_.unwrap #$.Long) (<| (_.wrap #$.Double) _.L2D)]
- [int::char (_.unwrap #$.Long)
+ [int::frac (_.unwrap #_t.Long) (<| (_.wrap #_t.Double) _.L2D)]
+ [int::char (_.unwrap #_t.Long)
((|>> _.L2I _.I2C (_.INVOKESTATIC "java.lang.Character" "toString" (_t.method (list _t.char) (#.Some $String) (list)) #0)))]
- [frac::int (_.unwrap #$.Double) (<| (_.wrap #$.Long) _.D2L)]
- [frac::encode (_.unwrap #$.Double)
+ [frac::int (_.unwrap #_t.Double) (<| (_.wrap #_t.Long) _.D2L)]
+ [frac::encode (_.unwrap #_t.Double)
(_.INVOKESTATIC "java.lang.Double" "toString" (_t.method (list _t.double) (#.Some $String) (list)) #0)]
[frac::decode ..check-stringI
(_.INVOKESTATIC ///.runtime-class "decode_frac" (_t.method (list $String) (#.Some $Object-Array) (list)) #0)]
@@ -175,7 +177,7 @@
[text::= (<|) (<|)
(_.INVOKEVIRTUAL "java.lang.Object" "equals" (_t.method (list ///.$Object) (#.Some _t.boolean) (list)) #0)
- (_.wrap #$.Boolean)]
+ (_.wrap #_t.Boolean)]
[text::< ..check-stringI ..check-stringI
(_.INVOKEVIRTUAL "java.lang.String" "compareTo" (_t.method (list $String) (#.Some _t.int) (list)) #0)
(predicateI _.IFLT)]
@@ -244,7 +246,7 @@
(def: (io::current-time _)
(Nullary Inst)
(|>> (_.INVOKESTATIC "java.lang.System" "currentTimeMillis" (_t.method (list) (#.Some _t.long) (list)) #0)
- (_.wrap #$.Long)))
+ (_.wrap #_t.Long)))
(def: bundle::lux
Bundle
diff --git a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux
index c4bc66923..7d9cd9cc5 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux
@@ -1,5 +1,5 @@
(.module:
- [lux (#- int char)
+ [lux (#- Type int char)
[abstract
["." monad (#+ do)]]
[control
@@ -14,6 +14,9 @@
[collection
["." list ("#@." functor)]
["." dictionary (#+ Dictionary)]]]
+ [target
+ [jvm
+ ["_t" type (#+ Primitive Type Method)]]]
[tool
[compiler
["." synthesis (#+ Synthesis %synthesis)]
@@ -27,8 +30,7 @@
[luxc
[lang
[host
- ["$" jvm (#+ Primitive Label Inst Method Handler Bundle Operation)
- ["_t" type]
+ ["$" jvm (#+ Label Inst Handler Bundle Operation)
["_" inst]]]]])
(template [<name>]
@@ -57,30 +59,30 @@
(|>> inputI
<conversion>)))]
- [conversion::double-to-float #$.Double _.D2F #$.Float]
- [conversion::double-to-int #$.Double _.D2I #$.Int]
- [conversion::double-to-long #$.Double _.D2L #$.Long]
- [conversion::float-to-double #$.Float _.F2D #$.Double]
- [conversion::float-to-int #$.Float _.F2I #$.Int]
- [conversion::float-to-long #$.Float _.F2L #$.Long]
- [conversion::int-to-byte #$.Int _.I2B #$.Byte]
- [conversion::int-to-char #$.Int _.I2C #$.Char]
- [conversion::int-to-double #$.Int _.I2D #$.Double]
- [conversion::int-to-float #$.Int _.I2F #$.Float]
- [conversion::int-to-long #$.Int _.I2L #$.Long]
- [conversion::int-to-short #$.Int _.I2S #$.Short]
- [conversion::long-to-double #$.Long _.L2D #$.Double]
- [conversion::long-to-float #$.Long _.L2F #$.Float]
- [conversion::long-to-int #$.Long _.L2I #$.Int]
- [conversion::long-to-short #$.Long L2S #$.Short]
- [conversion::long-to-byte #$.Long L2B #$.Byte]
- [conversion::long-to-char #$.Long L2C #$.Char]
- [conversion::char-to-byte #$.Char _.I2B #$.Byte]
- [conversion::char-to-short #$.Char _.I2S #$.Short]
- [conversion::char-to-int #$.Char _.NOP #$.Int]
- [conversion::char-to-long #$.Char _.I2L #$.Long]
- [conversion::byte-to-long #$.Byte _.I2L #$.Long]
- [conversion::short-to-long #$.Short _.I2L #$.Long]
+ [conversion::double-to-float #_t.Double _.D2F #_t.Float]
+ [conversion::double-to-int #_t.Double _.D2I #_t.Int]
+ [conversion::double-to-long #_t.Double _.D2L #_t.Long]
+ [conversion::float-to-double #_t.Float _.F2D #_t.Double]
+ [conversion::float-to-int #_t.Float _.F2I #_t.Int]
+ [conversion::float-to-long #_t.Float _.F2L #_t.Long]
+ [conversion::int-to-byte #_t.Int _.I2B #_t.Byte]
+ [conversion::int-to-char #_t.Int _.I2C #_t.Char]
+ [conversion::int-to-double #_t.Int _.I2D #_t.Double]
+ [conversion::int-to-float #_t.Int _.I2F #_t.Float]
+ [conversion::int-to-long #_t.Int _.I2L #_t.Long]
+ [conversion::int-to-short #_t.Int _.I2S #_t.Short]
+ [conversion::long-to-double #_t.Long _.L2D #_t.Double]
+ [conversion::long-to-float #_t.Long _.L2F #_t.Float]
+ [conversion::long-to-int #_t.Long _.L2I #_t.Int]
+ [conversion::long-to-short #_t.Long L2S #_t.Short]
+ [conversion::long-to-byte #_t.Long L2B #_t.Byte]
+ [conversion::long-to-char #_t.Long L2C #_t.Char]
+ [conversion::char-to-byte #_t.Char _.I2B #_t.Byte]
+ [conversion::char-to-short #_t.Char _.I2S #_t.Short]
+ [conversion::char-to-int #_t.Char _.NOP #_t.Int]
+ [conversion::char-to-long #_t.Char _.I2L #_t.Long]
+ [conversion::byte-to-long #_t.Byte _.I2L #_t.Long]
+ [conversion::short-to-long #_t.Short _.I2L #_t.Long]
)
(def: conversion
@@ -281,7 +283,7 @@
)))
(def: (array-java-type nesting elem-class)
- (-> Nat Text $.Type)
+ (-> Nat Text Type)
(_t.array nesting
(case elem-class
"boolean" _t.boolean
@@ -447,7 +449,7 @@
[objectI (generate objectS)]
(wrap (|>> objectI
(_.INSTANCEOF class)
- (_.wrap #$.Boolean))))
+ (_.wrap #_t.Boolean))))
_
(phase.throw extension.invalid-syntax [proc %synthesis inputs])))
@@ -466,14 +468,14 @@
[<object> <primitive>]
(wrap (|>> valueI (_.unwrap <type>))))
- (["boolean" "java.lang.Boolean" #$.Boolean]
- ["byte" "java.lang.Byte" #$.Byte]
- ["short" "java.lang.Short" #$.Short]
- ["int" "java.lang.Integer" #$.Int]
- ["long" "java.lang.Long" #$.Long]
- ["float" "java.lang.Float" #$.Float]
- ["double" "java.lang.Double" #$.Double]
- ["char" "java.lang.Character" #$.Char])
+ (["boolean" "java.lang.Boolean" #_t.Boolean]
+ ["byte" "java.lang.Byte" #_t.Byte]
+ ["short" "java.lang.Short" #_t.Short]
+ ["int" "java.lang.Integer" #_t.Int]
+ ["long" "java.lang.Long" #_t.Long]
+ ["float" "java.lang.Float" #_t.Float]
+ ["double" "java.lang.Double" #_t.Double]
+ ["char" "java.lang.Character" #_t.Char])
_
(wrap valueI)))
@@ -496,14 +498,14 @@
(def: primitives
(Dictionary Text Primitive)
- (|> (list ["boolean" #$.Boolean]
- ["byte" #$.Byte]
- ["short" #$.Short]
- ["int" #$.Int]
- ["long" #$.Long]
- ["float" #$.Float]
- ["double" #$.Double]
- ["char" #$.Char])
+ (|> (list ["boolean" #_t.Boolean]
+ ["byte" #_t.Byte]
+ ["short" #_t.Short]
+ ["int" #_t.Int]
+ ["long" #_t.Long]
+ ["float" #_t.Float]
+ ["double" #_t.Double]
+ ["char" #_t.Char])
(dictionary.from-list text.hash)))
(def: (static::get proc generate inputs)
@@ -516,7 +518,7 @@
[]
(case (dictionary.get unboxed primitives)
(#.Some primitive)
- (wrap (_.GETSTATIC class field (#$.Primitive primitive)))
+ (wrap (_.GETSTATIC class field (#_t.Primitive primitive)))
#.None
(wrap (_.GETSTATIC class field (_t.class unboxed (list))))))
@@ -536,7 +538,7 @@
(case (dictionary.get unboxed primitives)
(#.Some primitive)
(wrap (|>> valueI
- (_.PUTSTATIC class field (#$.Primitive primitive))
+ (_.PUTSTATIC class field (#_t.Primitive primitive))
(_.string synthesis.unit)))
#.None
@@ -561,7 +563,7 @@
(#.Some primitive)
(wrap (|>> objectI
(_.CHECKCAST class)
- (_.GETFIELD class field (#$.Primitive primitive))))
+ (_.GETFIELD class field (#_t.Primitive primitive))))
#.None
(wrap (|>> objectI
@@ -588,7 +590,7 @@
(_.CHECKCAST class)
_.DUP
valueI
- (_.PUTFIELD class field (#$.Primitive primitive))))
+ (_.PUTFIELD class field (#_t.Primitive primitive))))
#.None
(wrap (|>> objectI
@@ -602,7 +604,7 @@
(phase.throw extension.invalid-syntax [proc %synthesis inputs])))
(def: base-type
- (l.Parser $.Type)
+ (l.Parser Type)
($_ p.either
(p.after (l.this "boolean") (p@wrap _t.boolean))
(p.after (l.this "byte") (p@wrap _t.byte))
@@ -618,14 +620,14 @@
))
(def: java-type
- (l.Parser $.Type)
+ (l.Parser Type)
(do p.monad
[raw base-type
nesting (p.some (l.this "[]"))]
(wrap (_t.array (list.size nesting) raw))))
(def: (generate-type argD)
- (-> Text (Operation $.Type))
+ (-> Text (Operation Type))
(case (l.run argD java-type)
(#error.Failure error)
(phase.throw invalid-syntax-for-jvm-type argD)
@@ -635,7 +637,7 @@
(def: (generate-arg generate argS)
(-> (-> Synthesis (Operation Inst)) Synthesis
- (Operation [$.Type Inst]))
+ (Operation [Type Inst]))
(case argS
(^ (synthesis.tuple (list (synthesis.text argD) argS)))
(do phase.monad
@@ -647,7 +649,7 @@
(phase.throw invalid-syntax-for-argument-generation "")))
(def: (method-return-type description)
- (-> Text (Operation (Maybe $.Type)))
+ (-> Text (Operation (Maybe Type)))
(case description
"void"
(phase@wrap #.None)
@@ -656,7 +658,7 @@
(phase@map (|>> #.Some) (generate-type description))))
(def: (prepare-argI [type argI])
- (-> [$.Type Inst] Inst)
+ (-> [Type Inst] Inst)
(case (_t.class-name type)
(#.Some class-name)
(|>> argI