aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/source/luxc/lang/translation/jvm
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/jvm')
-rw-r--r--new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux168
1 files changed, 92 insertions, 76 deletions
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 45e025d0b..2e39860fc 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux
@@ -61,60 +61,60 @@
<conversion>
(_.wrap <wrap>))))]
- [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 _.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]
+ [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]
)
(def: conversion
Bundle
- (<| (bundle.prefix "convert")
+ (<| (bundle.prefix "conversion")
(|> (: Bundle bundle.empty)
- (bundle.install "double-to-float" (unary convert::double-to-float))
- (bundle.install "double-to-int" (unary convert::double-to-int))
- (bundle.install "double-to-long" (unary convert::double-to-long))
- (bundle.install "float-to-double" (unary convert::float-to-double))
- (bundle.install "float-to-int" (unary convert::float-to-int))
- (bundle.install "float-to-long" (unary convert::float-to-long))
- (bundle.install "int-to-byte" (unary convert::int-to-byte))
- (bundle.install "int-to-char" (unary convert::int-to-char))
- (bundle.install "int-to-double" (unary convert::int-to-double))
- (bundle.install "int-to-float" (unary convert::int-to-float))
- (bundle.install "int-to-long" (unary convert::int-to-long))
- (bundle.install "int-to-short" (unary convert::int-to-short))
- (bundle.install "long-to-double" (unary convert::long-to-double))
- (bundle.install "long-to-float" (unary convert::long-to-float))
- (bundle.install "long-to-int" (unary convert::long-to-int))
- (bundle.install "long-to-short" (unary convert::long-to-short))
- (bundle.install "long-to-byte" (unary convert::long-to-byte))
- (bundle.install "long-to-char" (unary convert::long-to-char))
- (bundle.install "char-to-byte" (unary convert::char-to-byte))
- (bundle.install "char-to-short" (unary convert::char-to-short))
- (bundle.install "char-to-int" (unary convert::char-to-int))
- (bundle.install "char-to-long" (unary convert::char-to-long))
- (bundle.install "byte-to-long" (unary convert::byte-to-long))
- (bundle.install "short-to-long" (unary convert::short-to-long))
+ (bundle.install "double-to-float" (unary conversion::double-to-float))
+ (bundle.install "double-to-int" (unary conversion::double-to-int))
+ (bundle.install "double-to-long" (unary conversion::double-to-long))
+ (bundle.install "float-to-double" (unary conversion::float-to-double))
+ (bundle.install "float-to-int" (unary conversion::float-to-int))
+ (bundle.install "float-to-long" (unary conversion::float-to-long))
+ (bundle.install "int-to-byte" (unary conversion::int-to-byte))
+ (bundle.install "int-to-char" (unary conversion::int-to-char))
+ (bundle.install "int-to-double" (unary conversion::int-to-double))
+ (bundle.install "int-to-float" (unary conversion::int-to-float))
+ (bundle.install "int-to-long" (unary conversion::int-to-long))
+ (bundle.install "int-to-short" (unary conversion::int-to-short))
+ (bundle.install "long-to-double" (unary conversion::long-to-double))
+ (bundle.install "long-to-float" (unary conversion::long-to-float))
+ (bundle.install "long-to-int" (unary conversion::long-to-int))
+ (bundle.install "long-to-short" (unary conversion::long-to-short))
+ (bundle.install "long-to-byte" (unary conversion::long-to-byte))
+ (bundle.install "long-to-char" (unary conversion::long-to-char))
+ (bundle.install "char-to-byte" (unary conversion::char-to-byte))
+ (bundle.install "char-to-short" (unary conversion::char-to-short))
+ (bundle.install "char-to-int" (unary conversion::char-to-int))
+ (bundle.install "char-to-long" (unary conversion::char-to-long))
+ (bundle.install "byte-to-long" (unary conversion::byte-to-long))
+ (bundle.install "short-to-long" (unary conversion::short-to-long))
)))
(template [<name> <op> <unwrapX> <unwrapY> <wrap>]
@@ -284,37 +284,49 @@
(bundle.install "<" (binary char::<))
)))
-(def: (array::length arrayD arrayI)
- (Binary Inst)
- (|>> arrayI
- (_.CHECKCAST arrayD)
- _.ARRAYLENGTH
- _.I2L
- (_.wrap #$.Long)))
+(def: (array-java-type nesting elem-class)
+ (-> Nat Text $.Type)
+ (_t.array nesting
+ (case elem-class
+ "boolean" _t.boolean
+ "byte" _t.byte
+ "short" _t.short
+ "int" _t.int
+ "long" _t.long
+ "float" _t.float
+ "double" _t.double
+ "char" _t.char
+ _ (_t.class elem-class (list)))))
+
+(def: (array::length proc generate inputs)
+ Handler
+ (case inputs
+ (^ (list (synthesis.i64 nesting)
+ (synthesis.text elem-class)
+ arrayS))
+ (do phase.monad
+ [arrayI (generate arrayS)]
+ (wrap (|>> arrayI
+ (_.CHECKCAST (_t.descriptor (array-java-type (.nat nesting) elem-class)))
+ _.ARRAYLENGTH
+ _.I2L
+ (_.wrap #$.Long))))
+
+ _
+ (phase.throw extension.invalid-syntax [proc %synthesis inputs])))
(def: (array::new proc generate inputs)
Handler
(case inputs
- (^ (list (synthesis.i64 level)
- (synthesis.text class)
+ (^ (list (synthesis.i64 nesting)
+ (synthesis.text elem-class)
lengthS))
(do phase.monad
- [lengthI (generate lengthS)
- #let [arrayJT (_t.array (.nat level)
- (case class
- "boolean" _t.boolean
- "byte" _t.byte
- "short" _t.short
- "int" _t.int
- "long" _t.long
- "float" _t.float
- "double" _t.double
- "char" _t.char
- _ (_t.class class (list))))]]
+ [lengthI (generate lengthS)]
(wrap (|>> lengthI
(_.unwrap #$.Long)
_.L2I
- (_.array arrayJT))))
+ (_.array (array-java-type (.nat nesting) elem-class)))))
_
(phase.throw extension.invalid-syntax [proc %synthesis inputs])))
@@ -322,13 +334,14 @@
(def: (array::read proc generate inputs)
Handler
(case inputs
- (^ (list (synthesis.text class)
+ (^ (list (synthesis.i64 nesting)
+ (synthesis.text elem-class)
idxS
arrayS))
(do phase.monad
[arrayI (generate arrayS)
idxI (generate idxS)
- #let [loadI (case class
+ #let [loadI (case elem-class
"boolean" (|>> _.BALOAD (_.wrap #$.Boolean))
"byte" (|>> _.BALOAD (_.wrap #$.Byte))
"short" (|>> _.SALOAD (_.wrap #$.Short))
@@ -339,6 +352,7 @@
"char" (|>> _.CALOAD (_.wrap #$.Char))
_ _.AALOAD)]]
(wrap (|>> arrayI
+ (_.CHECKCAST (_t.descriptor (array-java-type (.nat nesting) elem-class)))
idxI
(_.unwrap #$.Long)
_.L2I
@@ -350,7 +364,8 @@
(def: (array::write proc generate inputs)
Handler
(case inputs
- (^ (list (synthesis.text class)
+ (^ (list (synthesis.i64 nesting)
+ (synthesis.text elem-class)
idxS
valueS
arrayS))
@@ -358,7 +373,7 @@
[arrayI (generate arrayS)
idxI (generate idxS)
valueI (generate valueS)
- #let [storeI (case class
+ #let [storeI (case elem-class
"boolean" (|>> (_.unwrap #$.Boolean) _.BASTORE)
"byte" (|>> (_.unwrap #$.Byte) _.BASTORE)
"short" (|>> (_.unwrap #$.Short) _.SASTORE)
@@ -369,6 +384,7 @@
"char" (|>> (_.unwrap #$.Char) _.CASTORE)
_ _.AASTORE)]]
(wrap (|>> arrayI
+ (_.CHECKCAST (_t.descriptor (array-java-type (.nat nesting) elem-class)))
_.DUP
idxI
(_.unwrap #$.Long)
@@ -383,7 +399,7 @@
Bundle
(<| (bundle.prefix "array")
(|> (: Bundle bundle.empty)
- (bundle.install "length" (unary array::length))
+ (bundle.install "length" array::length)
(bundle.install "new" array::new)
(bundle.install "read" array::read)
(bundle.install "write" array::write)