diff options
Diffstat (limited to 'new-luxc/source/luxc/lang/translation/jvm')
-rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/procedure/host.lux | 168 |
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) |