aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux/control/concurrency/atom.lux1
-rw-r--r--stdlib/source/lux/host.jvm.lux214
-rw-r--r--stdlib/source/lux/math.lux4
-rw-r--r--stdlib/source/lux/target/jvm/type.lux55
-rw-r--r--stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux138
5 files changed, 235 insertions, 177 deletions
diff --git a/stdlib/source/lux/control/concurrency/atom.lux b/stdlib/source/lux/control/concurrency/atom.lux
index 599545498..d3fc1eca6 100644
--- a/stdlib/source/lux/control/concurrency/atom.lux
+++ b/stdlib/source/lux/control/concurrency/atom.lux
@@ -57,7 +57,6 @@
(~~ (static @.jvm))
(|> (:representation atom)
(java/util/concurrent/atomic/AtomicReference::compareAndSet current new)
- "jvm object cast"
(: (primitive "java.lang.Boolean"))
(:coerce Bit))})))
))
diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux
index cb08e1cce..d93edbfe4 100644
--- a/stdlib/source/lux/host.jvm.lux
+++ b/stdlib/source/lux/host.jvm.lux
@@ -42,14 +42,14 @@
[Character "java.lang.Character"]
## Primitives
- [boolean "boolean"]
- [byte "byte"]
- [short "short"]
- [int "int"]
- [long "long"]
- [float "float"]
- [double "double"]
- [char "char"]
+ [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]
)
(def: (get-static-field class field)
@@ -67,29 +67,40 @@
(def: 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-descriptor "java.lang.Boolean"]
+ [jvm.byte-descriptor "java.lang.Byte"]
+ [jvm.short-descriptor "java.lang.Short"]
+ [jvm.int-descriptor "java.lang.Integer"]
+ [jvm.long-descriptor "java.lang.Long"]
+ [jvm.float-descriptor "java.lang.Float"]
+ [jvm.double-descriptor "java.lang.Double"]
+ [jvm.char-descriptor "java.lang.Character"])
(dictionary.from-list text.hash)))
-(def: (unbox unboxed boxed raw)
- (-> Text Text Code Code)
- (` (|> (~ raw)
- (: (primitive (~ (code.text boxed))))
- "jvm object cast"
- (: (primitive (~ (code.text unboxed)))))))
+(def: reflections
+ (Dictionary Text Text)
+ (|> (list [jvm.boolean-descriptor jvm.boolean-reflection]
+ [jvm.byte-descriptor jvm.byte-reflection]
+ [jvm.short-descriptor jvm.short-reflection]
+ [jvm.int-descriptor jvm.int-reflection]
+ [jvm.long-descriptor jvm.long-reflection]
+ [jvm.float-descriptor jvm.float-reflection]
+ [jvm.double-descriptor jvm.double-reflection]
+ [jvm.char-descriptor jvm.char-reflection])
+ (dictionary.from-list text.hash)))
-(def: (box unboxed boxed raw)
- (-> Text Text Code Code)
- (` (|> (~ raw)
- (: (primitive (~ (code.text unboxed))))
- "jvm object cast"
- (: (primitive (~ (code.text boxed)))))))
+(template [<name> <pre> <post>]
+ [(def: (<name> unboxed boxed raw)
+ (-> Text Text Code Code)
+ (let [unboxed (|> reflections (dictionary.get unboxed) (maybe.default unboxed))]
+ (` (|> (~ raw)
+ (: (primitive (~ (code.text <pre>))))
+ "jvm object cast"
+ (: (primitive (~ (code.text <post>))))))))]
+
+ [unbox boxed unboxed]
+ [box unboxed boxed]
+ )
(template [<name> <op> <from> <to>]
[(template: #export (<name> value)
@@ -460,44 +471,13 @@
(-> [Text Code] Code)
(` [(~ (code.text class)) (~ value)]))
-(def: (simple-class type)
- (-> Type Text)
- (case type
- (#jvm.Primitive prim)
- (case prim
- #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.Array sub)
- (sanitize (jvm.descriptor type))
-
- (#jvm.Generic generic)
- (case generic
- (#jvm.Class class params)
- (sanitize class)
-
- (^or (#jvm.Var name)
- (#jvm.Wildcard #.None)
- (#jvm.Wildcard (#.Some [#jvm.Lower bound])))
- "java.lang.Object"
-
- (#jvm.Wildcard (#.Some [#jvm.Upper bound]))
- (simple-class (#jvm.Generic bound)))
- ))
-
(def: (make-constructor-parser class-name arguments)
(-> Text (List Argument) (Parser Code))
(do p.monad
[args (: (Parser (List Code))
(s.form (p.after (s.this! (' ::new!))
(s.tuple (p.exactly (list.size arguments) s.any)))))
- #let [arguments' (list@map (|>> product.right ..simple-class) arguments)]]
+ #let [arguments' (list@map (|>> product.right jvm.signature) arguments)]]
(wrap (` ("jvm member invoke constructor" (~ (code.text class-name))
(~+ (|> args
(list.zip2 arguments')
@@ -510,7 +490,7 @@
args (: (Parser (List Code))
(s.form (p.after (s.this! (code.identifier ["" dotted-name]))
(s.tuple (p.exactly (list.size arguments) s.any)))))
- #let [arguments' (list@map (|>> product.right ..simple-class) arguments)]]
+ #let [arguments' (list@map (|>> product.right jvm.signature) arguments)]]
(wrap (` ("jvm member invoke static" (~ (code.text class-name)) (~ (code.text method-name))
(~+ (|> args
(list.zip2 arguments')
@@ -524,7 +504,7 @@
args (: (Parser (List Code))
(s.form (p.after (s.this! (code.identifier ["" dotted-name]))
(s.tuple (p.exactly (list.size arguments) s.any)))))
- #let [arguments' (list@map (|>> product.right ..simple-class) arguments)]]
+ #let [arguments' (list@map (|>> product.right jvm.signature) arguments)]]
(wrap (` (<jvm-op> (~ (code.text class-name)) (~ (code.text method-name))
(~' _jvm_this)
(~+ (|> args
@@ -627,14 +607,14 @@
(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^ imports type-vars)
@@ -1031,14 +1011,14 @@
(case type
(#jvm.Primitive primitive)
(case primitive
- #jvm.Boolean (code.local-identifier "boolean")
- #jvm.Byte (code.local-identifier "byte")
- #jvm.Short (code.local-identifier "short")
- #jvm.Int (code.local-identifier "int")
- #jvm.Long (code.local-identifier "long")
- #jvm.Float (code.local-identifier "float")
- #jvm.Double (code.local-identifier "double")
- #jvm.Char (code.local-identifier "char"))
+ #jvm.Boolean (code.local-identifier jvm.boolean-reflection)
+ #jvm.Byte (code.local-identifier jvm.byte-reflection)
+ #jvm.Short (code.local-identifier jvm.short-reflection)
+ #jvm.Int (code.local-identifier jvm.int-reflection)
+ #jvm.Long (code.local-identifier jvm.long-reflection)
+ #jvm.Float (code.local-identifier jvm.float-reflection)
+ #jvm.Double (code.local-identifier jvm.double-reflection)
+ #jvm.Char (code.local-identifier jvm.char-reflection))
(#jvm.Generic generic)
(generic$ generic)
@@ -1142,7 +1122,7 @@
(let [super-replacer (parser->replacer (s.form (do p.monad
[_ (s.this! (' ::super!))
args (s.tuple (p.exactly (list.size arguments) s.any))
- #let [arguments' (list@map (|>> product.right ..simple-class) arguments)]]
+ #let [arguments' (list@map (|>> product.right jvm.signature) arguments)]]
(wrap (` ("jvm member invoke special"
(~ (code.text (product.left super-class)))
(~ (code.text name))
@@ -1375,7 +1355,7 @@
(#.Some value-as-string)
#.None))}
(with-gensyms [g!_ g!unchecked]
- (let [class-name (..simple-class class)
+ (let [class-name (jvm.signature class)
class-type (` (.primitive (~ (code.text class-name))))
check-type (` (.Maybe (~ class-type)))
check-code (` (if ((~ (code.text (format "jvm instanceof" ":" class-name))) (~ g!unchecked))
@@ -1455,7 +1435,7 @@
(with-gensyms [arg-name]
(wrap [maybe? arg-name]))))
import-member-args)
- #let [arg-classes (list@map (|>> product.right ..simple-class) import-member-args)
+ #let [arg-classes (list@map (|>> product.right jvm.signature) import-member-args)
arg-types (list@map (: (-> [Bit Type] Code)
(function (_ [maybe? arg])
(let [arg-type (jvm-type (get@ #import-member-mode commons) arg)]
@@ -1523,11 +1503,20 @@
#AutoPrM
(case unboxed
- "byte" [<byte> (` (<for-byte> (~ raw)))]
- "short" [<short> (` (<for-short> (~ raw)))]
- "int" [<int> (` (<for-int> (~ raw)))]
- "float" [<float> (` (<for-float> (~ raw)))]
- _ [unboxed raw]))]
+ (^ (static jvm.byte-descriptor))
+ [<byte> (` (<for-byte> (~ raw)))]
+
+ (^ (static jvm.short-descriptor))
+ [<short> (` (<for-short> (~ raw)))]
+
+ (^ (static jvm.int-descriptor))
+ [<int> (` (<for-int> (~ raw)))]
+
+ (^ (static jvm.float-descriptor))
+ [<float> (` (<for-float> (~ raw)))]
+
+ _
+ [unboxed raw]))]
(case (dictionary.get unboxed boxes)
(#.Some boxed)
(<unbox/box> unboxed boxed refined)
@@ -1536,15 +1525,15 @@
refined)))]
[auto-convert-input ..unbox
- "byte" ..long-to-byte
- "short" ..long-to-short
- "int" ..long-to-int
- "float" ..double-to-float]
+ jvm.byte-descriptor ..long-to-byte
+ jvm.short-descriptor ..long-to-short
+ jvm.int-descriptor ..long-to-int
+ jvm.float-descriptor ..double-to-float]
[auto-convert-output ..box
- "long" "jvm conversion byte-to-long"
- "long" "jvm conversion short-to-long"
- "long" "jvm conversion int-to-long"
- "double" "jvm conversion float-to-double"]
+ jvm.long-descriptor "jvm conversion byte-to-long"
+ jvm.long-descriptor "jvm conversion short-to-long"
+ jvm.long-descriptor "jvm conversion int-to-long"
+ jvm.double-descriptor "jvm conversion float-to-double"]
)
(def: (un-quote quoted)
@@ -1554,13 +1543,26 @@
(def: (jvm-input [unboxed raw])
(-> [Text Code] [Text Code])
[unboxed (case unboxed
- "byte" (` (.:coerce (.primitive "java.lang.Long") (.: .Int (~ raw))))
- "short" (` (.:coerce (.primitive "java.lang.Long") (.: .Int (~ raw))))
- "int" (` (.:coerce (.primitive "java.lang.Long") (.: .Int (~ raw))))
- "long" (` (.:coerce (.primitive "java.lang.Long") (.: .Int (~ raw))))
- "float" (` (.:coerce (.primitive "java.lang.Double") (.: .Frac (~ raw))))
- "double" (` (.:coerce (.primitive "java.lang.Double") (.: .Frac (~ raw))))
- _ (` ("jvm object cast" (~ raw))))])
+ (^ (static jvm.byte-descriptor))
+ (` (.:coerce (.primitive "java.lang.Long") (.: .Int (~ raw))))
+
+ (^ (static jvm.short-descriptor))
+ (` (.:coerce (.primitive "java.lang.Long") (.: .Int (~ raw))))
+
+ (^ (static jvm.int-descriptor))
+ (` (.:coerce (.primitive "java.lang.Long") (.: .Int (~ raw))))
+
+ (^ (static jvm.long-descriptor))
+ (` (.:coerce (.primitive "java.lang.Long") (.: .Int (~ raw))))
+
+ (^ (static jvm.float-descriptor))
+ (` (.:coerce (.primitive "java.lang.Double") (.: .Frac (~ raw))))
+
+ (^ (static jvm.double-descriptor))
+ (` (.:coerce (.primitive "java.lang.Double") (.: .Frac (~ raw))))
+
+ _
+ (` ("jvm object cast" (~ raw))))])
(def: (jvm-invoke-inputs mode classes inputs)
(-> Primitive-Mode (List Text) (List [Bit Code]) (List Code))
@@ -1641,7 +1643,7 @@
jvm.void-descriptor
(#.Some return)
- (..simple-class return))
+ (jvm.signature return))
jvm-interop (|> [method-return-class
(` ((~ (code.text jvm-op))
(~ (code.text full-name))
@@ -1674,7 +1676,7 @@
(` ((~ getter-name)))
(` ((~ getter-name) (~ g!obj))))
getter-body (<| (auto-convert-output import-field-mode)
- [(..simple-class import-field-type)
+ [(jvm.signature import-field-type)
(if import-field-static?
(get-static-field full-name import-field-name)
(get-virtual-field full-name import-field-name (un-quote g!obj)))])
@@ -1692,7 +1694,7 @@
(let [setter-call (if import-field-static?
(` ((~ setter-name) (~ g!value)))
(` ((~ setter-name) (~ g!value) (~ g!obj))))
- setter-value (|> [(..simple-class import-field-type) (un-quote g!value)]
+ setter-value (|> [(jvm.signature import-field-type) (un-quote g!value)]
..jvm-input
(auto-convert-input import-field-mode))
setter-value (if import-field-maybe?
@@ -1730,7 +1732,7 @@
(def: load-class
(-> Text (Error (primitive "java.lang.Class" [Any])))
(|>> (:coerce (primitive "java.lang.String"))
- ["java.lang.String"]
+ ["Ljava/lang/String;"]
("jvm member invoke static" "java.lang.Class" "forName")
try))
@@ -1915,7 +1917,7 @@
{type (..type^ imports (list))})
{#.doc (doc "Loads the class as a java.lang.Class object."
(class-for java/lang/String))}
- (wrap (list (` ("jvm object class" (~ (code.text (..simple-class type))))))))
+ (wrap (list (` ("jvm object class" (~ (code.text (jvm.signature type))))))))
(def: get-compiler
(Meta Lux)
diff --git a/stdlib/source/lux/math.lux b/stdlib/source/lux/math.lux
index 712e2bf70..1340f31d0 100644
--- a/stdlib/source/lux/math.lux
+++ b/stdlib/source/lux/math.lux
@@ -44,7 +44,7 @@
[(def: #export <name>
(-> Frac Frac)
(|>> !double
- ["double"]
+ ["D"]
("jvm member invoke static" "java.lang.Math" <method>)
!frac))]
@@ -65,7 +65,7 @@
(def: #export (pow param subject)
(-> Frac Frac Frac)
(|> ("jvm member invoke static" "java.lang.Math" "pow"
- ["double" (!double subject)] ["double" (!double param)])
+ ["D" (!double subject)] ["D" (!double param)])
!frac)))}))
(def: #export (round input)
diff --git a/stdlib/source/lux/target/jvm/type.lux b/stdlib/source/lux/target/jvm/type.lux
index ff30cf782..98880e5a8 100644
--- a/stdlib/source/lux/target/jvm/type.lux
+++ b/stdlib/source/lux/target/jvm/type.lux
@@ -25,6 +25,19 @@
["C" char-descriptor]
)
+(template [<name> <reflection>]
+ [(def: #export <name> <reflection>)]
+
+ [boolean-reflection "boolean"]
+ [byte-reflection "byte"]
+ [short-reflection "short"]
+ [int-reflection "int"]
+ [long-reflection "long"]
+ [float-reflection "float"]
+ [double-reflection "double"]
+ [char-reflection "char"]
+ )
+
(def: array-prefix "[")
(def: object-prefix "L")
(def: var-prefix "T")
@@ -128,9 +141,14 @@
0 elemT
_ (#Array (array (dec depth) elemT))))
-(def: #export binary-name
- (-> Text Text)
- (text.replace-all ..syntax-package-separator ..binary-package-separator))
+(template [<name> <from> <to>]
+ [(def: #export <name>
+ (-> Text Text)
+ (text.replace-all <from> <to>))]
+
+ [binary-name ..syntax-package-separator ..binary-package-separator]
+ [syntax-name ..binary-package-separator ..syntax-package-separator]
+ )
(def: #export (descriptor type)
(-> Type Text)
@@ -308,3 +326,34 @@
(|> (get@ #exceptions method)
(list@map (|>> #Generic signature (format "^")))
(text.join-with ""))))
+
+(def: #export (reflection-class type)
+ (-> Type Text)
+ (case type
+ (#Primitive prim)
+ (case prim
+ #Boolean ..boolean-reflection
+ #Byte ..byte-reflection
+ #Short ..short-reflection
+ #Int ..int-reflection
+ #Long ..long-reflection
+ #Float ..float-reflection
+ #Double ..double-reflection
+ #Char ..char-reflection)
+
+ (#Array sub)
+ (syntax-name (descriptor type))
+
+ (#Generic generic)
+ (case generic
+ (#Class class params)
+ (syntax-name class)
+
+ (^or (#Var name)
+ (#Wildcard #.None)
+ (#Wildcard (#.Some [#Lower bound])))
+ ..object-class
+
+ (#Wildcard (#.Some [#Upper bound]))
+ (reflection-class (#Generic bound)))
+ ))
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 91581c37b..61d65e67f 100644
--- a/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux
+++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux
@@ -22,8 +22,8 @@
["." type
["." check (#+ Check) ("#@." monad)]]
[target
- [jvm
- ["_." type (#+ Var Bound Primitive Generic Class Type Argument Return Typed)]]]]
+ ["." jvm #_
+ ["#" type (#+ Var Bound Primitive Generic Class Type Argument Return Typed)]]]]
["." // #_
["#." common]
["/#" //
@@ -336,7 +336,7 @@
(do ////.monad
[lengthA (typeA.with-type ..int
(analyse lengthC))
- _ (typeA.infer (#.Primitive (_type.descriptor (_type.array 1 primitive-type)) (list)))]
+ _ (typeA.infer (#.Primitive (jvm.descriptor (jvm.array 1 primitive-type)) (list)))]
(wrap (#/////analysis.Extension extension-name (list lengthA))))
_
@@ -414,7 +414,7 @@
[_ (typeA.infer lux-type)
idxA (typeA.with-type ..int
(analyse idxC))
- arrayA (typeA.with-type (#.Primitive (_type.descriptor (_type.array 1 jvm-type)) (list))
+ arrayA (typeA.with-type (#.Primitive (jvm.descriptor (jvm.array 1 jvm-type)) (list))
(analyse arrayC))]
(wrap (#/////analysis.Extension extension-name (list idxA arrayA))))
@@ -446,7 +446,7 @@
(def: (write-primitive-array-handler lux-type jvm-type)
(-> .Type Type Handler)
- (let [array-type (#.Primitive (_type.descriptor (_type.array 1 jvm-type)) (list))]
+ (let [array-type (#.Primitive (jvm.descriptor (jvm.array 1 jvm-type)) (list))]
(function (_ extension-name analyse args)
(case args
(^ (list idxC valueC arrayC))
@@ -498,36 +498,36 @@
(///bundle.install "length" array::length)
(dictionary.merge (<| (///bundle.prefix "new")
(|> ///bundle.empty
- (///bundle.install "boolean" (new-primitive-array-handler _type.boolean))
- (///bundle.install "byte" (new-primitive-array-handler _type.byte))
- (///bundle.install "short" (new-primitive-array-handler _type.short))
- (///bundle.install "int" (new-primitive-array-handler _type.int))
- (///bundle.install "long" (new-primitive-array-handler _type.long))
- (///bundle.install "float" (new-primitive-array-handler _type.float))
- (///bundle.install "double" (new-primitive-array-handler _type.double))
- (///bundle.install "char" (new-primitive-array-handler _type.char))
+ (///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 "object" array::new::object))))
(dictionary.merge (<| (///bundle.prefix "read")
(|> ///bundle.empty
- (///bundle.install "boolean" (read-primitive-array-handler ..boolean _type.boolean))
- (///bundle.install "byte" (read-primitive-array-handler ..byte _type.byte))
- (///bundle.install "short" (read-primitive-array-handler ..short _type.short))
- (///bundle.install "int" (read-primitive-array-handler ..int _type.int))
- (///bundle.install "long" (read-primitive-array-handler ..long _type.long))
- (///bundle.install "float" (read-primitive-array-handler ..float _type.float))
- (///bundle.install "double" (read-primitive-array-handler ..double _type.double))
- (///bundle.install "char" (read-primitive-array-handler ..char _type.char))
+ (///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 "object" array::read::object))))
(dictionary.merge (<| (///bundle.prefix "write")
(|> ///bundle.empty
- (///bundle.install "boolean" (write-primitive-array-handler ..boolean _type.boolean))
- (///bundle.install "byte" (write-primitive-array-handler ..byte _type.byte))
- (///bundle.install "short" (write-primitive-array-handler ..short _type.short))
- (///bundle.install "int" (write-primitive-array-handler ..int _type.int))
- (///bundle.install "long" (write-primitive-array-handler ..long _type.long))
- (///bundle.install "float" (write-primitive-array-handler ..float _type.float))
- (///bundle.install "double" (write-primitive-array-handler ..double _type.double))
- (///bundle.install "char" (write-primitive-array-handler ..char _type.char))
+ (///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 "object" array::write::object))))
)))
@@ -1129,10 +1129,17 @@
#Special
#Interface)
+(def: reflection-arguments
+ (-> (List Text) (Operation (List Text)))
+ (|>> (monad.map error.monad jvm.parse-signature)
+ (:: error.monad map (list@map jvm.reflection-class))
+ ////.lift))
+
(def: (check-method class method-name method-style arg-classes method)
(-> (java/lang/Class java/lang/Object) Text Method-Style (List Text) Method (Operation Bit))
(do ////.monad
- [parameters (|> (Method::getGenericParameterTypes method)
+ [arg-classes (reflection-arguments arg-classes)
+ parameters (|> (Method::getGenericParameterTypes method)
array.to-list
(monad.map @ java-type-to-parameter))
#let [modifiers (Method::getModifiers method)]
@@ -1167,7 +1174,8 @@
(def: (check-constructor class arg-classes constructor)
(-> (java/lang/Class java/lang/Object) (List Text) (Constructor java/lang/Object) (Operation Bit))
(do ////.monad
- [parameters (|> (Constructor::getGenericParameterTypes constructor)
+ [arg-classes (reflection-arguments arg-classes)
+ parameters (|> (Constructor::getGenericParameterTypes constructor)
array.to-list
(monad.map @ java-type-to-parameter))]
(wrap (and (java/lang/Object::equals class (Constructor::getDeclaringClass constructor))
@@ -1469,7 +1477,7 @@
(def: (generic-type mapping generic)
(-> Mapping Generic (Check .Type))
(case generic
- (#_type.Var var)
+ (#jvm.Var var)
(case (dictionary.get var mapping)
#.None
(check.throw unknown-jvm-type-var var)
@@ -1477,7 +1485,7 @@
(#.Some type)
(check@wrap type))
- (#_type.Wildcard wildcard)
+ (#jvm.Wildcard wildcard)
(case wildcard
#.None
(do check.monad
@@ -1488,13 +1496,13 @@
(do check.monad
[limitT (generic-type mapping limit)]
(case bound
- #_type.Lower
+ #jvm.Lower
(wrap (lower-relationship-type limitT))
- #_type.Upper
+ #jvm.Upper
(wrap (upper-relationship-type limitT)))))
- (#_type.Class name parameters)
+ (#jvm.Class name parameters)
(do check.monad
[parametersT+ (monad.map @ (generic-type mapping) parameters)]
(wrap (#.Primitive name parametersT+)))))
@@ -1508,24 +1516,24 @@
(def: (jvm-type mapping type)
(-> Mapping Type (Check .Type))
(case type
- (#_type.Primitive primitive)
+ (#jvm.Primitive primitive)
(check@wrap (case primitive
- #_type.Boolean ..boolean
- #_type.Byte ..byte
- #_type.Short ..short
- #_type.Int ..int
- #_type.Long ..long
- #_type.Float ..float
- #_type.Double ..double
- #_type.Char ..char))
+ #jvm.Boolean ..boolean
+ #jvm.Byte ..byte
+ #jvm.Short ..short
+ #jvm.Int ..int
+ #jvm.Long ..long
+ #jvm.Float ..float
+ #jvm.Double ..double
+ #jvm.Char ..char))
- (#_type.Generic generic)
+ (#jvm.Generic generic)
(generic-type mapping generic)
- (#_type.Array type)
+ (#jvm.Array type)
(case type
- (#_type.Primitive primitive)
- (check@wrap (#.Primitive (_type.descriptor (_type.array 1 type)) (list)))
+ (#jvm.Primitive primitive)
+ (check@wrap (#.Primitive (jvm.descriptor (jvm.array 1 type)) (list)))
_
(do check.monad
@@ -1625,24 +1633,24 @@
(def: (generic-analysis generic)
(-> Generic Analysis)
(case generic
- (#_type.Var var)
+ (#jvm.Var var)
(/////analysis.text var)
- (#_type.Wildcard wildcard)
+ (#jvm.Wildcard wildcard)
(case wildcard
#.None
(/////analysis.constant ["" "?"])
(#.Some [bound limit])
(/////analysis.tuple (list (case bound
- #_type.Lower
+ #jvm.Lower
(/////analysis.constant ["" ">"])
- #_type.Upper
+ #jvm.Upper
(/////analysis.constant ["" "<"]))
(generic-analysis limit))))
- (#_type.Class name parameters)
+ (#jvm.Class name parameters)
(/////analysis.tuple (list& (/////analysis.text name)
(list@map generic-analysis parameters)))))
@@ -1667,21 +1675,21 @@
(def: (type-analysis type)
(-> Type Analysis)
(case type
- (#_type.Primitive primitive)
+ (#jvm.Primitive primitive)
(case primitive
- #_type.Boolean (/////analysis.constant ["" "boolean"])
- #_type.Byte (/////analysis.constant ["" "byte"])
- #_type.Short (/////analysis.constant ["" "short"])
- #_type.Int (/////analysis.constant ["" "int"])
- #_type.Long (/////analysis.constant ["" "long"])
- #_type.Float (/////analysis.constant ["" "float"])
- #_type.Double (/////analysis.constant ["" "double"])
- #_type.Char (/////analysis.constant ["" "char"]))
+ #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"]))
- (#_type.Generic generic)
+ (#jvm.Generic generic)
(generic-analysis generic)
- (#_type.Array type)
+ (#jvm.Array type)
(/////analysis.tuple (list (type-analysis type)))))
(def: (return-analysis return)
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 10:08:27 +0000