aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
authorEduardo Julian2019-05-16 21:18:23 -0400
committerEduardo Julian2019-05-16 21:18:23 -0400
commitea0cff44a5f003f8956ffbce9ea5f6957fdf4c92 (patch)
tree2e1d18dc3cc41576e9cb128ab203a8f955e66ceb /stdlib
parent0a06ea82722b863af8d0f75762068054008b27ac (diff)
Yet more fiddling with types for JVM interop.
+ Some progress on anonymous classes. + More elaborate handling of JVM arrays.
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/data/collection/array.lux2
-rw-r--r--stdlib/source/lux/data/text.lux2
-rw-r--r--stdlib/source/lux/host.jvm.lux132
-rw-r--r--stdlib/source/lux/target/jvm/type.lux41
-rw-r--r--stdlib/source/lux/tool/compiler/phase.lux7
-rw-r--r--stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux486
6 files changed, 396 insertions, 274 deletions
diff --git a/stdlib/source/lux/data/collection/array.lux b/stdlib/source/lux/data/collection/array.lux
index b6f877d73..cac39d65f 100644
--- a/stdlib/source/lux/data/collection/array.lux
+++ b/stdlib/source/lux/data/collection/array.lux
@@ -50,7 +50,7 @@
(~~ (static @.jvm))
(|> array
(:coerce <array-type>)
- "jvm array length"
+ "jvm array length object"
"jvm conversion int-to-long"
"jvm object cast"
(: <index-type>)
diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux
index a9cec1526..ad5d49ae2 100644
--- a/stdlib/source/lux/data/text.lux
+++ b/stdlib/source/lux/data/text.lux
@@ -189,7 +189,7 @@
(def: (hash input)
(`` (for {(~~ (static @.old))
(|> input
- (: (primitive "java.lang.String" []))
+ (: (primitive "java.lang.String"))
"jvm invokevirtual:java.lang.String:hashCode:"
"jvm convert int-to-long"
(:coerce Nat))
diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux
index d93edbfe4..495d8a7ce 100644
--- a/stdlib/source/lux/host.jvm.lux
+++ b/stdlib/source/lux/host.jvm.lux
@@ -1811,27 +1811,27 @@
{type (..type^ imports (list))}
size)
{#.doc (doc "Create an array of the given type, with the given size."
- (array Object 10))}
- (case type
- (^template [<primitive> <array-op>]
- (^ (#jvm.Primitive <primitive>))
- (wrap (list (` (<array-op> (~ size))))))
- ([#jvm.Boolean "jvm znewarray"]
- [#jvm.Byte "jvm bnewarray"]
- [#jvm.Short "jvm snewarray"]
- [#jvm.Int "jvm inewarray"]
- [#jvm.Long "jvm lnewarray"]
- [#jvm.Float "jvm fnewarray"]
- [#jvm.Double "jvm dnewarray"]
- [#jvm.Char "jvm cnewarray"])
-
- _
- (wrap (list (` ("jvm anewarray" (~ (type$ type)) (~ size)))))))
+ (array java/lang/Object 10))}
+ (let [g!size (` (|> (~ size)
+ (.: .Nat)
+ (.:coerce (.primitive "java.lang.Long"))
+ "jvm object cast"
+ "jvm conversion long-to-int"))]
+ (case type
+ (^template [<primitive> <array-op>]
+ (^ (#jvm.Primitive <primitive>))
+ (wrap (list (` (<array-op> (~ g!size))))))
+ ([#jvm.Boolean "jvm array new boolean"]
+ [#jvm.Byte "jvm array new byte"]
+ [#jvm.Short "jvm array new short"]
+ [#jvm.Int "jvm array new int"]
+ [#jvm.Long "jvm array new long"]
+ [#jvm.Float "jvm array new float"]
+ [#jvm.Double "jvm array new double"]
+ [#jvm.Char "jvm array new char"])
-(syntax: #export (array-length array)
- {#.doc (doc "Gives the length of an array."
- (array-length my-array))}
- (wrap (list (` ("jvm arraylength" (~ array))))))
+ _
+ (wrap (list (` ("jvm array new object" (~ (type$ type)) (~ g!size))))))))
(def: (type->class-name type)
(-> .Type (Meta Text))
@@ -1855,6 +1855,35 @@
_
(macro.fail (format "Cannot convert to JVM type: " (type.to-text type))))))
+(syntax: #export (array-length array)
+ {#.doc (doc "Gives the length of an array."
+ (array-length my-array))}
+ (case array
+ [_ (#.Identifier array-name)]
+ (do macro.monad
+ [array-type (macro.find-type array-name)
+ array-jvm-type (type->class-name array-type)
+ #let [g!extension (code.text (case array-jvm-type
+ "[Z" "jvm array length boolean"
+ "[B" "jvm array length byte"
+ "[S" "jvm array length short"
+ "[I" "jvm array length int"
+ "[J" "jvm array length long"
+ "[F" "jvm array length float"
+ "[D" "jvm array length double"
+ "[C" "jvm array length char"
+ _ "jvm array length object"))]]
+ (wrap (list (` (.|> ((~ g!extension) (~ array))
+ "jvm conversion int-to-long"
+ "jvm object cast"
+ (.: (.primitive "java.lang.Long"))
+ (.:coerce .Nat))))))
+
+ _
+ (with-gensyms [g!array]
+ (wrap (list (` (let [(~ g!array) (~ array)]
+ (..array-length (~ g!array)))))))))
+
(syntax: #export (array-read idx array)
{#.doc (doc "Loads an element from an array."
(array-read 10 my-array))}
@@ -1862,22 +1891,29 @@
[_ (#.Identifier array-name)]
(do macro.monad
[array-type (macro.find-type array-name)
- array-jvm-type (type->class-name array-type)]
+ array-jvm-type (type->class-name array-type)
+ #let [g!idx (` (.|> (~ idx)
+ (.: .Nat)
+ (.:coerce (.primitive "java.lang.Long"))
+ "jvm object cast"
+ "jvm conversion long-to-int"))]]
(case array-jvm-type
- (^template [<type> <array-op>]
+ (^template [<type> <array-op> <box>]
<type>
- (wrap (list (` (<array-op> (~ array) (~ idx))))))
- (["[Z" "jvm zaload"]
- ["[B" "jvm baload"]
- ["[S" "jvm saload"]
- ["[I" "jvm iaload"]
- ["[J" "jvm jaload"]
- ["[F" "jvm faload"]
- ["[D" "jvm daload"]
- ["[C" "jvm caload"])
+ (wrap (list (` (.|> (<array-op> (~ g!idx) (~ array))
+ "jvm object cast"
+ (.: (.primitive <box>)))))))
+ (["[Z" "jvm array read boolean" "java.lang.Boolean"]
+ ["[B" "jvm array read byte" "java.lang.Byte"]
+ ["[S" "jvm array read short" "java.lang.Short"]
+ ["[I" "jvm array read int" "java.lang.Integer"]
+ ["[J" "jvm array read long" "java.lang.Long"]
+ ["[F" "jvm array read float" "java.lang.Float"]
+ ["[D" "jvm array read double" "java.lang.Double"]
+ ["[C" "jvm array read char" "java.lang.Character"])
_
- (wrap (list (` ("jvm aaload" (~ array) (~ idx)))))))
+ (wrap (list (` ("jvm array read object" (~ g!idx) (~ array)))))))
_
(with-gensyms [g!array]
@@ -1891,22 +1927,30 @@
[_ (#.Identifier array-name)]
(do macro.monad
[array-type (macro.find-type array-name)
- array-jvm-type (type->class-name array-type)]
+ array-jvm-type (type->class-name array-type)
+ #let [g!idx (` (.|> (~ idx)
+ (.: .Nat)
+ (.:coerce (.primitive "java.lang.Long"))
+ "jvm object cast"
+ "jvm conversion long-to-int"))]]
(case array-jvm-type
- (^template [<type> <array-op>]
+ (^template [<type> <array-op> <box>]
<type>
- (wrap (list (` (<array-op> (~ array) (~ idx) (~ value))))))
- (["[Z" "jvm zastore"]
- ["[B" "jvm bastore"]
- ["[S" "jvm sastore"]
- ["[I" "jvm iastore"]
- ["[J" "jvm jastore"]
- ["[F" "jvm fastore"]
- ["[D" "jvm dastore"]
- ["[C" "jvm castore"])
+ (let [g!value (` (.|> (~ value)
+ (.:coerce (.primitive <box>))
+ "jvm object cast"))]
+ (wrap (list (` (<array-op> (~ g!idx) (~ g!value) (~ array)))))))
+ (["[Z" "jvm array write boolean" "java.lang.Boolean"]
+ ["[B" "jvm array write byte" "java.lang.Byte"]
+ ["[S" "jvm array write short" "java.lang.Short"]
+ ["[I" "jvm array write int" "java.lang.Integer"]
+ ["[J" "jvm array write long" "java.lang.Long"]
+ ["[F" "jvm array write float" "java.lang.Float"]
+ ["[D" "jvm array write double" "java.lang.Double"]
+ ["[C" "jvm array write char" "java.lang.Character"])
_
- (wrap (list (` ("jvm aastore" (~ array) (~ idx) (~ value)))))))
+ (wrap (list (` ("jvm array write object" (~ g!idx) (~ value) (~ array)))))))
_
(with-gensyms [g!array]
diff --git a/stdlib/source/lux/target/jvm/type.lux b/stdlib/source/lux/target/jvm/type.lux
index 98880e5a8..d8851d978 100644
--- a/stdlib/source/lux/target/jvm/type.lux
+++ b/stdlib/source/lux/target/jvm/type.lux
@@ -28,6 +28,7 @@
(template [<name> <reflection>]
[(def: #export <name> <reflection>)]
+ [void-reflection "void"]
[boolean-reflection "boolean"]
[byte-reflection "byte"]
[short-reflection "short"]
@@ -38,14 +39,14 @@
[char-reflection "char"]
)
-(def: array-prefix "[")
+(def: #export array-prefix "[")
(def: object-prefix "L")
(def: var-prefix "T")
(def: wildcard-descriptor "*")
(def: lower-prefix "-")
(def: upper-prefix "+")
(def: object-suffix ";")
-(def: object-class "java.lang.Object")
+(def: #export object-class "java.lang.Object")
(def: valid-var-characters/head
(format "abcdefghijklmnopqrstuvwxyz"
@@ -278,24 +279,24 @@
))))
(def: #export parse-signature
- (-> Text (Error Type))
- (<t>.run (<>.rec
- (function (_ recur)
- ($_ <>.or
- ($_ <>.or
- (<t>.this ..boolean-descriptor)
- (<t>.this ..byte-descriptor)
- (<t>.this ..short-descriptor)
- (<t>.this ..int-descriptor)
- (<t>.this ..long-descriptor)
- (<t>.this ..float-descriptor)
- (<t>.this ..double-descriptor)
- (<t>.this ..char-descriptor)
- )
- ..parse-generic
- (<>.after (<t>.this ..array-prefix)
- recur)
- )))))
+ (Parser Type)
+ (<>.rec
+ (function (_ recur)
+ ($_ <>.or
+ ($_ <>.or
+ (<t>.this ..boolean-descriptor)
+ (<t>.this ..byte-descriptor)
+ (<t>.this ..short-descriptor)
+ (<t>.this ..int-descriptor)
+ (<t>.this ..long-descriptor)
+ (<t>.this ..float-descriptor)
+ (<t>.this ..double-descriptor)
+ (<t>.this ..char-descriptor)
+ )
+ ..parse-generic
+ (<>.after (<t>.this ..array-prefix)
+ recur)
+ ))))
(def: #export (method args return exceptions)
(-> (List Type) (Maybe Type) (List Generic) Method)
diff --git a/stdlib/source/lux/tool/compiler/phase.lux b/stdlib/source/lux/tool/compiler/phase.lux
index a6b080a19..6137e9fd6 100644
--- a/stdlib/source/lux/tool/compiler/phase.lux
+++ b/stdlib/source/lux/tool/compiler/phase.lux
@@ -1,7 +1,7 @@
(.module:
[lux #*
[abstract
- [monad (#+ do)]]
+ [monad (#+ Monad do)]]
[control
["." state]
["ex" exception (#+ Exception exception:)]
@@ -10,7 +10,7 @@
["s" code]]]
[data
["." product]
- ["." error (#+ Error) ("#;." functor)]
+ ["." error (#+ Error) ("#@." functor)]
["." text
format]]
[time
@@ -23,6 +23,7 @@
(state.State' Error s o))
(def: #export monad
+ (All [s] (Monad (Operation s)))
(state.with error.monad))
(type: #export (Phase s i o)
@@ -73,7 +74,7 @@
(def: #export (lift error)
(All [s a] (-> (Error a) (Operation s a)))
(function (_ state)
- (error;map (|>> [state]) error)))
+ (error@map (|>> [state]) error)))
(syntax: #export (assert exception message test)
(wrap (list (` (if (~ test)
diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux
index 61d65e67f..947bbc69f 100644
--- a/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux
+++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux
@@ -6,7 +6,8 @@
["." monad (#+ do)]]
[control
["p" parser
- ["s" code (#+ Parser)]]
+ ["s" code (#+ Parser)]
+ ["<t>" text]]
["." exception (#+ exception:)]
pipe]
[data
@@ -53,6 +54,117 @@
["_jvm_upper" upper-relationship-name upper-relationship-type]
)
+## TODO: Get rid of this template block and use the definition in
+## lux/host.jvm.lux ASAP
+(template [<name> <class>]
+ [(def: #export <name> .Type (#.Primitive <class> #.Nil))]
+
+ ## Boxes
+ [Boolean "java.lang.Boolean"]
+ [Byte "java.lang.Byte"]
+ [Short "java.lang.Short"]
+ [Integer "java.lang.Integer"]
+ [Long "java.lang.Long"]
+ [Float "java.lang.Float"]
+ [Double "java.lang.Double"]
+ [Character "java.lang.Character"]
+ [String "java.lang.String"]
+
+ ## Primitives
+ [boolean jvm.boolean-reflection]
+ [byte jvm.byte-reflection]
+ [short jvm.short-reflection]
+ [int jvm.int-reflection]
+ [long jvm.long-reflection]
+ [float jvm.float-reflection]
+ [double jvm.double-reflection]
+ [char jvm.char-reflection]
+ )
+
+(type: Mapping
+ (Dictionary Var .Type))
+
+(def: fresh-mapping Mapping (dictionary.new text.hash))
+
+(exception: #export (unknown-jvm-type-var {var Var})
+ (exception.report
+ ["Var" (%t var)]))
+
+(def: (generic-type mapping generic)
+ (-> Mapping Generic (Check .Type))
+ (case generic
+ (#jvm.Var var)
+ (case (dictionary.get var mapping)
+ #.None
+ (check.throw ..unknown-jvm-type-var var)
+
+ (#.Some type)
+ (check@wrap type))
+
+ (#jvm.Wildcard wildcard)
+ (case wildcard
+ #.None
+ (do check.monad
+ [[id type] check.existential]
+ (wrap type))
+
+ (#.Some [bound limit])
+ (do check.monad
+ [limitT (generic-type mapping limit)]
+ (case bound
+ #jvm.Lower
+ (wrap (lower-relationship-type limitT))
+
+ #jvm.Upper
+ (wrap (upper-relationship-type limitT)))))
+
+ (#jvm.Class name parameters)
+ (do check.monad
+ [parametersT+ (monad.map @ (generic-type mapping) parameters)]
+ (wrap (#.Primitive name parametersT+)))))
+
+(def: (class-type mapping [name parameters])
+ (-> Mapping Class (Check .Type))
+ (do check.monad
+ [parametersT+ (monad.map @ (generic-type mapping) parameters)]
+ (wrap (#.Primitive name parametersT+))))
+
+(def: (jvm-type mapping type)
+ (-> Mapping Type (Check .Type))
+ (case type
+ (#jvm.Primitive primitive)
+ (check@wrap (case primitive
+ #jvm.Boolean ..boolean
+ #jvm.Byte ..byte
+ #jvm.Short ..short
+ #jvm.Int ..int
+ #jvm.Long ..long
+ #jvm.Float ..float
+ #jvm.Double ..double
+ #jvm.Char ..char))
+
+ (#jvm.Generic generic)
+ (generic-type mapping generic)
+
+ (#jvm.Array type)
+ (case type
+ (#jvm.Primitive primitive)
+ (check@wrap (#.Primitive (jvm.descriptor (jvm.array 1 type)) (list)))
+
+ _
+ (do check.monad
+ [elementT (jvm-type mapping type)]
+ (wrap (.type (Array elementT)))))))
+
+(def: (return-type mapping type)
+ (-> Mapping Return (Check .Type))
+ (case type
+ #.None
+ (check@wrap Any)
+
+ (#.Some type)
+ (jvm-type mapping type)))
+
(def: (custom [syntax handler])
(All [s]
(-> [(Parser s)
@@ -161,33 +273,6 @@
[cannot-correspond-type-with-a-class]
)
-## TODO: Get rid of this template block and use the definition in
-## lux/host.jvm.lux ASAP
-(template [<name> <class>]
- [(def: #export <name> .Type (#.Primitive <class> #.Nil))]
-
- ## Boxes
- [Boolean "java.lang.Boolean"]
- [Byte "java.lang.Byte"]
- [Short "java.lang.Short"]
- [Integer "java.lang.Integer"]
- [Long "java.lang.Long"]
- [Float "java.lang.Float"]
- [Double "java.lang.Double"]
- [Character "java.lang.Character"]
- [String "java.lang.String"]
-
- ## Primitives
- [boolean "boolean"]
- [byte "byte"]
- [short "short"]
- [int "int"]
- [long "long"]
- [float "float"]
- [double "double"]
- [char "char"]
- )
-
(def: bundle::conversion
Bundle
(<| (///bundle.prefix "conversion")
@@ -237,8 +322,8 @@
(///bundle.install "ushr" (//common.binary <type> Integer <type>))
)))]
- [bundle::int "int" ..long]
- [bundle::long "long" ..long]
+ [bundle::int jvm.int-reflection ..long]
+ [bundle::long jvm.long-reflection ..long]
)
(template [<name> <prefix> <type>]
@@ -255,13 +340,13 @@
(///bundle.install "<" (//common.binary <type> <type> Bit))
)))]
- [bundle::float "float" ..float]
- [bundle::double "double" ..double]
+ [bundle::float jvm.float-reflection ..float]
+ [bundle::double jvm.double-reflection ..double]
)
(def: bundle::char
Bundle
- (<| (///bundle.prefix "char")
+ (<| (///bundle.prefix jvm.char-reflection)
(|> ///bundle.empty
(///bundle.install "=" (//common.binary ..char ..char Bit))
(///bundle.install "<" (//common.binary ..char ..char Bit))
@@ -269,14 +354,14 @@
(def: #export boxes
(Dictionary Text Text)
- (|> (list ["boolean" "java.lang.Boolean"]
- ["byte" "java.lang.Byte"]
- ["short" "java.lang.Short"]
- ["int" "java.lang.Integer"]
- ["long" "java.lang.Long"]
- ["float" "java.lang.Float"]
- ["double" "java.lang.Double"]
- ["char" "java.lang.Character"])
+ (|> (list [jvm.boolean-reflection "java.lang.Boolean"]
+ [jvm.byte-reflection "java.lang.Byte"]
+ [jvm.short-reflection "java.lang.Short"]
+ [jvm.int-reflection "java.lang.Integer"]
+ [jvm.long-reflection "java.lang.Long"]
+ [jvm.float-reflection "java.lang.Float"]
+ [jvm.double-reflection "java.lang.Double"]
+ [jvm.char-reflection "java.lang.Character"])
(dictionary.from-list text.hash)))
(def: (array-type-info allow-primitives? arrayT)
@@ -303,13 +388,27 @@
(#.Primitive class _)
(if (dictionary.contains? class boxes)
- (/////analysis.throw primitives-cannot-have-type-parameters class)
+ (/////analysis.throw ..primitives-cannot-have-type-parameters class)
(////@wrap [level class]))
_
(/////analysis.throw non-array arrayT))))
-(def: array::length
+(def: (primitive-array-length-handler primitive-type)
+ (-> Type Handler)
+ (function (_ extension-name analyse args)
+ (case args
+ (^ (list arrayC))
+ (do ////.monad
+ [_ (typeA.infer ..int)
+ arrayA (typeA.with-type (#.Primitive (jvm.descriptor (jvm.array 1 primitive-type)) (list))
+ (analyse arrayC))]
+ (wrap (#/////analysis.Extension extension-name (list arrayA))))
+
+ _
+ (/////analysis.throw ///.incorrect-arity [extension-name 1 (list.size args)]))))
+
+(def: array::length::object
Handler
(function (_ extension-name analyse args)
(case args
@@ -363,14 +462,47 @@
(/////analysis.throw ///.incorrect-arity [extension-name 1 (list.size args)]))))
(def: (check-jvm objectT)
- (-> .Type (Operation Text))
+ (-> .Type (Operation Type))
(case objectT
- (#.Primitive name _)
- (////@wrap name)
+ (#.Primitive name #.Nil)
+ (case name
+ (^ (static jvm.boolean-reflection)) (////@wrap jvm.boolean)
+ (^ (static jvm.byte-reflection)) (////@wrap jvm.byte)
+ (^ (static jvm.short-reflection)) (////@wrap jvm.short)
+ (^ (static jvm.int-reflection)) (////@wrap jvm.int)
+ (^ (static jvm.long-reflection)) (////@wrap jvm.long)
+ (^ (static jvm.float-reflection)) (////@wrap jvm.float)
+ (^ (static jvm.double-reflection)) (////@wrap jvm.double)
+ (^ (static jvm.char-reflection)) (////@wrap jvm.char)
+ _ (if (text.starts-with? jvm.array-prefix name)
+ (////.lift (<t>.run jvm.parse-signature name))
+ (////@wrap (jvm.class name (list)))))
+
+ (^ (#.Primitive (static array.type-name)
+ (list elementT)))
+ (|> elementT
+ check-jvm
+ (////@map (jvm.array 1)))
+
+ (#.Primitive name parameters)
+ (do ////.monad
+ [parameters (monad.map @ check-jvm parameters)
+ parameters (monad.map @ (function (_ parameter)
+ (case parameter
+ (#jvm.Generic generic)
+ (wrap generic)
+
+ _
+ (/////analysis.throw ..primitives-cannot-have-type-parameters name)))
+ parameters)]
+ (////@wrap (jvm.class name parameters)))
+
+ (#.Named name anonymous)
+ (check-jvm anonymous)
(^template [<tag>]
(<tag> id)
- (////@wrap "java.lang.Object"))
+ (////@wrap (jvm.class "java.lang.Object" (list))))
([#.Var]
[#.Ex])
@@ -394,16 +526,16 @@
(def: (check-object objectT)
(-> .Type (Operation Text))
(do ////.monad
- [name (check-jvm objectT)]
- (if (dictionary.contains? name boxes)
+ [name (:: @ map jvm.reflection-class (check-jvm objectT))]
+ (if (dictionary.contains? name ..boxes)
(/////analysis.throw ..primitives-are-not-objects [name])
(////@wrap name))))
(def: (check-return type)
(-> .Type (Operation Text))
(if (is? .Any type)
- (////@wrap "void")
- (check-jvm type)))
+ (////@wrap jvm.void-descriptor)
+ (////@map jvm.signature (check-jvm type))))
(def: (read-primitive-array-handler lux-type jvm-type)
(-> .Type Type Handler)
@@ -495,39 +627,49 @@
Bundle
(<| (///bundle.prefix "array")
(|> ///bundle.empty
- (///bundle.install "length" array::length)
+ (dictionary.merge (<| (///bundle.prefix "length")
+ (|> ///bundle.empty
+ (///bundle.install jvm.boolean-reflection (primitive-array-length-handler jvm.boolean))
+ (///bundle.install jvm.byte-reflection (primitive-array-length-handler jvm.byte))
+ (///bundle.install jvm.short-reflection (primitive-array-length-handler jvm.short))
+ (///bundle.install jvm.int-reflection (primitive-array-length-handler jvm.int))
+ (///bundle.install jvm.long-reflection (primitive-array-length-handler jvm.long))
+ (///bundle.install jvm.float-reflection (primitive-array-length-handler jvm.float))
+ (///bundle.install jvm.double-reflection (primitive-array-length-handler jvm.double))
+ (///bundle.install jvm.char-reflection (primitive-array-length-handler jvm.char))
+ (///bundle.install "object" array::length::object))))
(dictionary.merge (<| (///bundle.prefix "new")
(|> ///bundle.empty
- (///bundle.install "boolean" (new-primitive-array-handler jvm.boolean))
- (///bundle.install "byte" (new-primitive-array-handler jvm.byte))
- (///bundle.install "short" (new-primitive-array-handler jvm.short))
- (///bundle.install "int" (new-primitive-array-handler jvm.int))
- (///bundle.install "long" (new-primitive-array-handler jvm.long))
- (///bundle.install "float" (new-primitive-array-handler jvm.float))
- (///bundle.install "double" (new-primitive-array-handler jvm.double))
- (///bundle.install "char" (new-primitive-array-handler jvm.char))
+ (///bundle.install jvm.boolean-reflection (new-primitive-array-handler jvm.boolean))
+ (///bundle.install jvm.byte-reflection (new-primitive-array-handler jvm.byte))
+ (///bundle.install jvm.short-reflection (new-primitive-array-handler jvm.short))
+ (///bundle.install jvm.int-reflection (new-primitive-array-handler jvm.int))
+ (///bundle.install jvm.long-reflection (new-primitive-array-handler jvm.long))
+ (///bundle.install jvm.float-reflection (new-primitive-array-handler jvm.float))
+ (///bundle.install jvm.double-reflection (new-primitive-array-handler jvm.double))
+ (///bundle.install jvm.char-reflection (new-primitive-array-handler jvm.char))
(///bundle.install "object" array::new::object))))
(dictionary.merge (<| (///bundle.prefix "read")
(|> ///bundle.empty
- (///bundle.install "boolean" (read-primitive-array-handler ..boolean jvm.boolean))
- (///bundle.install "byte" (read-primitive-array-handler ..byte jvm.byte))
- (///bundle.install "short" (read-primitive-array-handler ..short jvm.short))
- (///bundle.install "int" (read-primitive-array-handler ..int jvm.int))
- (///bundle.install "long" (read-primitive-array-handler ..long jvm.long))
- (///bundle.install "float" (read-primitive-array-handler ..float jvm.float))
- (///bundle.install "double" (read-primitive-array-handler ..double jvm.double))
- (///bundle.install "char" (read-primitive-array-handler ..char jvm.char))
+ (///bundle.install jvm.boolean-reflection (read-primitive-array-handler ..boolean jvm.boolean))
+ (///bundle.install jvm.byte-reflection (read-primitive-array-handler ..byte jvm.byte))
+ (///bundle.install jvm.short-reflection (read-primitive-array-handler ..short jvm.short))
+ (///bundle.install jvm.int-reflection (read-primitive-array-handler ..int jvm.int))
+ (///bundle.install jvm.long-reflection (read-primitive-array-handler ..long jvm.long))
+ (///bundle.install jvm.float-reflection (read-primitive-array-handler ..float jvm.float))
+ (///bundle.install jvm.double-reflection (read-primitive-array-handler ..double jvm.double))
+ (///bundle.install jvm.char-reflection (read-primitive-array-handler ..char jvm.char))
(///bundle.install "object" array::read::object))))
(dictionary.merge (<| (///bundle.prefix "write")
(|> ///bundle.empty
- (///bundle.install "boolean" (write-primitive-array-handler ..boolean jvm.boolean))
- (///bundle.install "byte" (write-primitive-array-handler ..byte jvm.byte))
- (///bundle.install "short" (write-primitive-array-handler ..short jvm.short))
- (///bundle.install "int" (write-primitive-array-handler ..int jvm.int))
- (///bundle.install "long" (write-primitive-array-handler ..long jvm.long))
- (///bundle.install "float" (write-primitive-array-handler ..float jvm.float))
- (///bundle.install "double" (write-primitive-array-handler ..double jvm.double))
- (///bundle.install "char" (write-primitive-array-handler ..char jvm.char))
+ (///bundle.install jvm.boolean-reflection (write-primitive-array-handler ..boolean jvm.boolean))
+ (///bundle.install jvm.byte-reflection (write-primitive-array-handler ..byte jvm.byte))
+ (///bundle.install jvm.short-reflection (write-primitive-array-handler ..short jvm.short))
+ (///bundle.install jvm.int-reflection (write-primitive-array-handler ..int jvm.int))
+ (///bundle.install jvm.long-reflection (write-primitive-array-handler ..long jvm.long))
+ (///bundle.install jvm.float-reflection (write-primitive-array-handler ..float jvm.float))
+ (///bundle.install jvm.double-reflection (write-primitive-array-handler ..double jvm.double))
+ (///bundle.install jvm.char-reflection (write-primitive-array-handler ..char jvm.char))
(///bundle.install "object" array::write::object))))
)))
@@ -727,11 +869,6 @@
## else
(/////analysis.throw cannot-convert-to-a-class jvm-type)))
-(type: Mapping
- (Dictionary Var .Type))
-
-(def: fresh-mapping Mapping (dictionary.new text.hash))
-
(def: (java-type-to-lux-type mapping java-type)
(-> Mapping java/lang/reflect/Type (Operation .Type))
(<| (case (host.check TypeVariable java-type)
@@ -760,17 +897,25 @@
(#.Some java-type)
(let [java-type (:coerce (java/lang/Class java/lang/Object) java-type)
class-name (java/lang/Class::getName java-type)]
- (////@wrap (case (array.size (java/lang/Class::getTypeParameters java-type))
- 0
- (case class-name
- "void"
- Any
-
- _
- (#.Primitive class-name (list)))
-
- arity
- (|> (list.indices arity)
+ (case (array.size (java/lang/Class::getTypeParameters java-type))
+ 0
+ (case class-name
+ (^ (static jvm.void-reflection))
+ (////@wrap Any)
+
+ _
+ (if (text.starts-with? jvm.array-prefix class-name)
+ (case (<t>.run jvm.parse-signature (jvm.binary-name class-name))
+ (#error.Success jtype)
+ (typeA.with-env
+ (jvm-type fresh-mapping jtype))
+
+ (#error.Failure error)
+ (/////analysis.fail error))
+ (////@wrap (#.Primitive class-name (list)))))
+
+ arity
+ (////@wrap (|> (list.indices arity)
list.reverse
(list@map (|>> (n/* 2) inc #.Parameter))
(#.Primitive class-name)
@@ -832,8 +977,11 @@
(dictionary.from-list text.hash)))
))
+ (#.Named name anonymousT)
+ (correspond-type-params class anonymousT)
+
_
- (/////analysis.throw non-jvm-type type)))
+ (/////analysis.throw ..non-jvm-type type)))
(def: (class-candiate-parents from-name fromT to-name to-class)
(-> Text .Type Text (java/lang/Class java/lang/Object) (Operation (List [[Text .Type] Bit])))
@@ -861,7 +1009,7 @@
(monad.map ////.monad
(function (_ superT)
(do ////.monad
- [super-name (check-jvm superT)
+ [super-name (:: @ map jvm.reflection-class (check-jvm superT))
super-class (load-class super-name)]
(wrap [[super-name superT]
(java/lang/Class::isAssignableFrom super-class to-class)])))
@@ -877,24 +1025,24 @@
(^ (list fromC))
(do ////.monad
[toT (///.lift macro.expected-type)
- to-name (check-jvm toT)
+ to-name (:: @ map jvm.reflection-class (check-jvm toT))
[fromT fromA] (typeA.with-inference
(analyse fromC))
- from-name (check-jvm fromT)
+ from-name (:: @ map jvm.reflection-class (check-jvm fromT))
can-cast? (: (Operation Bit)
(case [from-name to-name]
(^template [<primitive> <object>]
- (^or [<primitive> <object>]
- [<object> <primitive>])
+ (^or (^ [(static <primitive>) <object>])
+ (^ [<object> (static <primitive>)]))
(wrap #1))
- (["boolean" "java.lang.Boolean"]
- ["byte" "java.lang.Byte"]
- ["short" "java.lang.Short"]
- ["int" "java.lang.Integer"]
- ["long" "java.lang.Long"]
- ["float" "java.lang.Float"]
- ["double" "java.lang.Double"]
- ["char" "java.lang.Character"])
+ ([jvm.boolean-reflection "java.lang.Boolean"]
+ [jvm.byte-reflection "java.lang.Byte"]
+ [jvm.short-reflection "java.lang.Short"]
+ [jvm.int-reflection "java.lang.Integer"]
+ [jvm.long-reflection "java.lang.Long"]
+ [jvm.float-reflection "java.lang.Float"]
+ [jvm.double-reflection "java.lang.Double"]
+ [jvm.char-reflection "java.lang.Character"])
_
(do @
@@ -1131,7 +1279,7 @@
(def: reflection-arguments
(-> (List Text) (Operation (List Text)))
- (|>> (monad.map error.monad jvm.parse-signature)
+ (|>> (monad.map error.monad (<t>.run jvm.parse-signature))
(:: error.monad map (list@map jvm.reflection-class))
////.lift))
@@ -1403,12 +1551,19 @@
_ (////.assert non-interface class-name
(Modifier::isInterface (java/lang/Class::getModifiers class)))
[methodT exceptionsT] (method-candidate class-name method #Interface argsT)
- [outputT argsA] (inferenceA.general analyse methodT (list& objectC (list@map product.right argsTC)))
+ [outputT allA] (inferenceA.general analyse methodT (list& objectC (list@map product.right argsTC)))
+ #let [[objectA argsA] (case allA
+ (#.Cons objectA argsA)
+ [objectA argsA]
+
+ _
+ (undefined))]
outputJC (check-return outputT)]
(wrap (#/////analysis.Extension extension-name
(list& (/////analysis.text class-name)
(/////analysis.text method)
(/////analysis.text outputJC)
+ objectA
(decorate-inputs argsT argsA))))))]))
(def: invoke::constructor
@@ -1470,96 +1625,17 @@
(Parser Class)
(s.form (p.and s.text (p.some ..generic))))
-(exception: #export (unknown-jvm-type-var {var Var})
- (exception.report
- ["Var" (%t var)]))
-
-(def: (generic-type mapping generic)
- (-> Mapping Generic (Check .Type))
- (case generic
- (#jvm.Var var)
- (case (dictionary.get var mapping)
- #.None
- (check.throw unknown-jvm-type-var var)
-
- (#.Some type)
- (check@wrap type))
-
- (#jvm.Wildcard wildcard)
- (case wildcard
- #.None
- (do check.monad
- [[id type] check.existential]
- (wrap type))
-
- (#.Some [bound limit])
- (do check.monad
- [limitT (generic-type mapping limit)]
- (case bound
- #jvm.Lower
- (wrap (lower-relationship-type limitT))
-
- #jvm.Upper
- (wrap (upper-relationship-type limitT)))))
-
- (#jvm.Class name parameters)
- (do check.monad
- [parametersT+ (monad.map @ (generic-type mapping) parameters)]
- (wrap (#.Primitive name parametersT+)))))
-
-(def: (class-type mapping [name parameters])
- (-> Mapping Class (Check .Type))
- (do check.monad
- [parametersT+ (monad.map @ (generic-type mapping) parameters)]
- (wrap (#.Primitive name parametersT+))))
-
-(def: (jvm-type mapping type)
- (-> Mapping Type (Check .Type))
- (case type
- (#jvm.Primitive primitive)
- (check@wrap (case primitive
- #jvm.Boolean ..boolean
- #jvm.Byte ..byte
- #jvm.Short ..short
- #jvm.Int ..int
- #jvm.Long ..long
- #jvm.Float ..float
- #jvm.Double ..double
- #jvm.Char ..char))
-
- (#jvm.Generic generic)
- (generic-type mapping generic)
-
- (#jvm.Array type)
- (case type
- (#jvm.Primitive primitive)
- (check@wrap (#.Primitive (jvm.descriptor (jvm.array 1 type)) (list)))
-
- _
- (do check.monad
- [elementT (jvm-type mapping type)]
- (wrap (.type (Array elementT)))))))
-
-(def: (return-type mapping type)
- (-> Mapping Return (Check .Type))
- (case type
- #.None
- (check@wrap Any)
-
- (#.Some type)
- (jvm-type mapping type)))
-
(def: primitive
(Parser Primitive)
($_ p.or
- (s.identifier! ["" "boolean"])
- (s.identifier! ["" "byte"])
- (s.identifier! ["" "short"])
- (s.identifier! ["" "int"])
- (s.identifier! ["" "long"])
- (s.identifier! ["" "float"])
- (s.identifier! ["" "double"])
- (s.identifier! ["" "char"])
+ (s.identifier! ["" jvm.boolean-reflection])
+ (s.identifier! ["" jvm.byte-reflection])
+ (s.identifier! ["" jvm.short-reflection])
+ (s.identifier! ["" jvm.int-reflection])
+ (s.identifier! ["" jvm.long-reflection])
+ (s.identifier! ["" jvm.float-reflection])
+ (s.identifier! ["" jvm.double-reflection])
+ (s.identifier! ["" jvm.char-reflection])
))
(def: type
@@ -1595,7 +1671,7 @@
(def: return
(Parser Return)
- (p.or (s.identifier! ["" "void"])
+ (p.or (s.identifier! ["" jvm.void-reflection])
..type))
(type: #export (Overriden-Method a)
@@ -1677,14 +1753,14 @@
(case type
(#jvm.Primitive primitive)
(case primitive
- #jvm.Boolean (/////analysis.constant ["" "boolean"])
- #jvm.Byte (/////analysis.constant ["" "byte"])
- #jvm.Short (/////analysis.constant ["" "short"])
- #jvm.Int (/////analysis.constant ["" "int"])
- #jvm.Long (/////analysis.constant ["" "long"])
- #jvm.Float (/////analysis.constant ["" "float"])
- #jvm.Double (/////analysis.constant ["" "double"])
- #jvm.Char (/////analysis.constant ["" "char"]))
+ #jvm.Boolean (/////analysis.constant ["" jvm.boolean-reflection])
+ #jvm.Byte (/////analysis.constant ["" jvm.byte-reflection])
+ #jvm.Short (/////analysis.constant ["" jvm.short-reflection])
+ #jvm.Int (/////analysis.constant ["" jvm.int-reflection])
+ #jvm.Long (/////analysis.constant ["" jvm.long-reflection])
+ #jvm.Float (/////analysis.constant ["" jvm.float-reflection])
+ #jvm.Double (/////analysis.constant ["" jvm.double-reflection])
+ #jvm.Char (/////analysis.constant ["" jvm.char-reflection]))
(#jvm.Generic generic)
(generic-analysis generic)
@@ -1696,7 +1772,7 @@
(-> Return Analysis)
(case return
#.None
- (/////analysis.constant ["" "void"])
+ (/////analysis.constant ["" jvm.void-descriptor])
(#.Some type)
(type-analysis type)))