diff options
author | Eduardo Julian | 2019-05-13 23:17:02 -0400 |
---|---|---|
committer | Eduardo Julian | 2019-05-13 23:17:02 -0400 |
commit | 0a06ea82722b863af8d0f75762068054008b27ac (patch) | |
tree | 3978d90f70af94141abf1611ebe38eba07970a3a /stdlib | |
parent | 9e6c63e80d3a25db4f2dbc9cef5439b59f03ee0a (diff) |
More fiddling with types for JVM interop.
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/lux/control/concurrency/atom.lux | 1 | ||||
-rw-r--r-- | stdlib/source/lux/host.jvm.lux | 214 | ||||
-rw-r--r-- | stdlib/source/lux/math.lux | 4 | ||||
-rw-r--r-- | stdlib/source/lux/target/jvm/type.lux | 55 | ||||
-rw-r--r-- | stdlib/source/lux/tool/compiler/phase/extension/analysis/jvm.lux | 138 |
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) |