diff options
Diffstat (limited to 'stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux')
| -rw-r--r-- | stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux | 160 |
1 files changed, 80 insertions, 80 deletions
diff --git a/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux b/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux index 5fac5b1d0..a494b0e44 100644 --- a/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux +++ b/stdlib/source/lux/compiler/default/phase/extension/analysis/host.jvm.lux @@ -19,7 +19,7 @@ ["." check]] ["." macro ["s" syntax]] - ["." host]] + ["." host (#+ import:)]] [// ["." common] ["/." // @@ -34,12 +34,12 @@ {#method Type #exceptions (List Type)}) -(host.import: #long java/lang/reflect/Type +(import: #long java/lang/reflect/Type (getTypeName [] String)) (do-template [<name>] [(exception: #export (<name> {jvm-type java/lang/reflect/Type}) - (ex.report ["JVM Type" (java/lang/reflect/Type::getTypeName [] jvm-type)]))] + (ex.report ["JVM Type" (java/lang/reflect/Type::getTypeName jvm-type)]))] [jvm-type-is-not-a-class] [cannot-convert-to-a-class] @@ -421,38 +421,38 @@ _ (////.throw ///.incorrect-arity [extension-name 2 (list.size args)])))) -(host.import: java/lang/Object +(import: java/lang/Object (equals [Object] boolean)) -(host.import: java/lang/ClassLoader) +(import: java/lang/ClassLoader) -(host.import: java/lang/reflect/GenericArrayType +(import: java/lang/reflect/GenericArrayType (getGenericComponentType [] java/lang/reflect/Type)) -(host.import: java/lang/reflect/ParameterizedType +(import: java/lang/reflect/ParameterizedType (getRawType [] java/lang/reflect/Type) (getActualTypeArguments [] (Array java/lang/reflect/Type))) -(host.import: (java/lang/reflect/TypeVariable d) +(import: (java/lang/reflect/TypeVariable d) (getName [] String) (getBounds [] (Array java/lang/reflect/Type))) -(host.import: (java/lang/reflect/WildcardType d) +(import: (java/lang/reflect/WildcardType d) (getLowerBounds [] (Array java/lang/reflect/Type)) (getUpperBounds [] (Array java/lang/reflect/Type))) -(host.import: java/lang/reflect/Modifier +(import: java/lang/reflect/Modifier (#static isStatic [int] boolean) (#static isFinal [int] boolean) (#static isInterface [int] boolean) (#static isAbstract [int] boolean)) -(host.import: java/lang/reflect/Field +(import: java/lang/reflect/Field (getDeclaringClass [] (java/lang/Class Object)) (getModifiers [] int) (getGenericType [] java/lang/reflect/Type)) -(host.import: java/lang/reflect/Method +(import: java/lang/reflect/Method (getName [] String) (getModifiers [] int) (getDeclaringClass [] (Class Object)) @@ -461,14 +461,14 @@ (getGenericReturnType [] java/lang/reflect/Type) (getGenericExceptionTypes [] (Array java/lang/reflect/Type))) -(host.import: (java/lang/reflect/Constructor c) +(import: (java/lang/reflect/Constructor c) (getModifiers [] int) (getDeclaringClass [] (Class c)) (getTypeParameters [] (Array (TypeVariable (Constructor c)))) (getGenericParameterTypes [] (Array java/lang/reflect/Type)) (getGenericExceptionTypes [] (Array java/lang/reflect/Type))) -(host.import: (java/lang/Class c) +(import: (java/lang/Class c) (getName [] String) (getModifiers [] int) (#static forName [String] #try (Class Object)) @@ -484,7 +484,7 @@ (-> Text (Operation (Class Object))) (do ////.Monad<Operation> [] - (case (Class::forName [name]) + (case (Class::forName name) (#e.Success [class]) (wrap class) @@ -496,7 +496,7 @@ (do ////.Monad<Operation> [super (load-class super) sub (load-class sub)] - (wrap (Class::isAssignableFrom [sub] super)))) + (wrap (Class::isAssignableFrom sub super)))) (def: object::throw Handler @@ -562,10 +562,10 @@ (def: (java-type-to-class jvm-type) (-> java/lang/reflect/Type (Operation Text)) (cond (host.instance? Class jvm-type) - (operation/wrap (Class::getName [] (:coerce Class jvm-type))) + (operation/wrap (Class::getName (:coerce Class jvm-type))) (host.instance? ParameterizedType jvm-type) - (java-type-to-class (ParameterizedType::getRawType [] (:coerce ParameterizedType jvm-type))) + (java-type-to-class (ParameterizedType::getRawType (:coerce ParameterizedType jvm-type))) ## else (////.throw cannot-convert-to-a-class jvm-type))) @@ -578,7 +578,7 @@ (def: (java-type-to-lux-type mappings java-type) (-> Mappings java/lang/reflect/Type (Operation Type)) (cond (host.instance? TypeVariable java-type) - (let [var-name (TypeVariable::getName [] (:coerce TypeVariable java-type))] + (let [var-name (TypeVariable::getName (:coerce TypeVariable java-type))] (case (dictionary.get var-name mappings) (#.Some var-type) (operation/wrap var-type) @@ -588,8 +588,8 @@ (host.instance? WildcardType java-type) (let [java-type (:coerce WildcardType java-type)] - (case [(array.read 0 (WildcardType::getUpperBounds [] java-type)) - (array.read 0 (WildcardType::getLowerBounds [] java-type))] + (case [(array.read 0 (WildcardType::getUpperBounds java-type)) + (array.read 0 (WildcardType::getLowerBounds java-type))] (^or [(#.Some bound) _] [_ (#.Some bound)]) (java-type-to-lux-type mappings bound) @@ -598,8 +598,8 @@ (host.instance? Class java-type) (let [java-type (:coerce (Class Object) java-type) - class-name (Class::getName [] java-type)] - (operation/wrap (case (array.size (Class::getTypeParameters [] java-type)) + class-name (Class::getName java-type)] + (operation/wrap (case (array.size (Class::getTypeParameters java-type)) 0 (#.Primitive class-name (list)) @@ -612,21 +612,21 @@ (host.instance? ParameterizedType java-type) (let [java-type (:coerce ParameterizedType java-type) - raw (ParameterizedType::getRawType [] java-type)] + raw (ParameterizedType::getRawType java-type)] (if (host.instance? Class raw) (do ////.Monad<Operation> [paramsT (|> java-type - (ParameterizedType::getActualTypeArguments []) + ParameterizedType::getActualTypeArguments array.to-list (monad.map @ (java-type-to-lux-type mappings)))] - (operation/wrap (#.Primitive (Class::getName [] (:coerce (Class Object) raw)) + (operation/wrap (#.Primitive (Class::getName (:coerce (Class Object) raw)) paramsT))) (////.throw jvm-type-is-not-a-class raw))) (host.instance? GenericArrayType java-type) (do ////.Monad<Operation> [innerT (|> (:coerce GenericArrayType java-type) - (GenericArrayType::getGenericComponentType []) + GenericArrayType::getGenericComponentType (java-type-to-lux-type mappings))] (wrap (#.Primitive "#Array" (list innerT)))) @@ -637,8 +637,8 @@ (-> (Class Object) Type (Operation Mappings)) (case type (#.Primitive name params) - (let [class-name (Class::getName [] class) - class-params (array.to-list (Class::getTypeParameters [] class)) + (let [class-name (Class::getName class) + class-params (array.to-list (Class::getTypeParameters class)) num-class-params (list.size class-params) num-type-params (list.size params)] (cond (not (text/= class-name name)) @@ -655,7 +655,7 @@ ## else (operation/wrap (|> params - (list.zip2 (list/map (TypeVariable::getName []) class-params)) + (list.zip2 (list/map (|>> TypeVariable::getName) class-params)) (dictionary.from-list text.Hash<Text>))) )) @@ -707,15 +707,15 @@ _ (////.assert cannot-cast (format "From class/primitive: " current-name text.new-line " To class/primitive: " to-name text.new-line " For value: " (%code valueC) text.new-line) - (Class::isAssignableFrom [current-class] to-class)) + (Class::isAssignableFrom current-class to-class)) candiate-parents (monad.map @ (function (_ java-type) (do @ [class-name (java-type-to-class java-type) class (load-class class-name)] - (wrap [[class-name java-type] (Class::isAssignableFrom [class] to-class)]))) - (list& (Class::getGenericSuperclass [] current-class) - (array.to-list (Class::getGenericInterfaces [] current-class))))] + (wrap [[class-name java-type] (Class::isAssignableFrom class to-class)]))) + (list& (Class::getGenericSuperclass current-class) + (array.to-list (Class::getGenericInterfaces current-class))))] (case (|> candiate-parents (list.filter product.right) (list/map product.left)) @@ -758,14 +758,14 @@ (-> Text Text (Operation [(Class Object) Field])) (do ////.Monad<Operation> [class (load-class class-name)] - (case (Class::getDeclaredField [field-name] class) + (case (Class::getDeclaredField field-name class) (#e.Success field) - (let [owner (Field::getDeclaringClass [] field)] + (let [owner (Field::getDeclaringClass field)] (if (is? owner class) (wrap [class field]) (////.throw mistaken-field-owner (format " Field: " field-name text.new-line - " Owner Class: " (Class::getName [] owner) text.new-line + " Owner Class: " (Class::getName owner) text.new-line "Target Class: " class-name text.new-line)))) (#e.Error _) @@ -775,26 +775,26 @@ (-> Text Text (Operation [Type Bit])) (do ////.Monad<Operation> [[class fieldJ] (find-field class-name field-name) - #let [modifiers (Field::getModifiers [] fieldJ)]] - (if (Modifier::isStatic [modifiers]) - (let [fieldJT (Field::getGenericType [] fieldJ)] + #let [modifiers (Field::getModifiers fieldJ)]] + (if (Modifier::isStatic modifiers) + (let [fieldJT (Field::getGenericType fieldJ)] (do @ [fieldT (java-type-to-lux-type fresh-mappings fieldJT)] - (wrap [fieldT (Modifier::isFinal [modifiers])]))) + (wrap [fieldT (Modifier::isFinal modifiers)]))) (////.throw not-a-static-field (format class-name "#" field-name))))) (def: (virtual-field class-name field-name objectT) (-> Text Text Type (Operation [Type Bit])) (do ////.Monad<Operation> [[class fieldJ] (find-field class-name field-name) - #let [modifiers (Field::getModifiers [] fieldJ)]] - (if (not (Modifier::isStatic [modifiers])) + #let [modifiers (Field::getModifiers fieldJ)]] + (if (not (Modifier::isStatic modifiers)) (do @ - [#let [fieldJT (Field::getGenericType [] fieldJ) + [#let [fieldJT (Field::getGenericType fieldJ) var-names (|> class - (Class::getTypeParameters []) + Class::getTypeParameters array.to-list - (list/map (TypeVariable::getName [])))] + (list/map (|>> TypeVariable::getName)))] mappings (: (Operation Mappings) (case objectT (#.Primitive _class-name _class-params) @@ -813,7 +813,7 @@ _ (////.throw non-object objectT))) fieldT (java-type-to-lux-type mappings fieldJT)] - (wrap [fieldT (Modifier::isFinal [modifiers])])) + (wrap [fieldT (Modifier::isFinal modifiers)])) (////.throw not-a-virtual-field (format class-name "#" field-name))))) (def: static::get @@ -901,10 +901,10 @@ (def: (java-type-to-parameter type) (-> java/lang/reflect/Type (Operation Text)) (cond (host.instance? Class type) - (operation/wrap (Class::getName [] (:coerce Class type))) + (operation/wrap (Class::getName (:coerce Class type))) (host.instance? ParameterizedType type) - (java-type-to-parameter (ParameterizedType::getRawType [] (:coerce ParameterizedType type))) + (java-type-to-parameter (ParameterizedType::getRawType (:coerce ParameterizedType type))) (or (host.instance? TypeVariable type) (host.instance? WildcardType type)) @@ -912,7 +912,7 @@ (host.instance? GenericArrayType type) (do ////.Monad<Operation> - [componentP (java-type-to-parameter (GenericArrayType::getGenericComponentType [] (:coerce GenericArrayType type)))] + [componentP (java-type-to-parameter (GenericArrayType::getGenericComponentType (:coerce GenericArrayType type)))] (wrap (format componentP "[]"))) ## else @@ -928,22 +928,22 @@ (def: (check-method class method-name method-style arg-classes method) (-> (Class Object) Text Method-Style (List Text) Method (Operation Bit)) (do ////.Monad<Operation> - [parameters (|> (Method::getGenericParameterTypes [] method) + [parameters (|> (Method::getGenericParameterTypes method) array.to-list (monad.map @ java-type-to-parameter)) - #let [modifiers (Method::getModifiers [] method)]] - (wrap (and (Object::equals [class] (Method::getDeclaringClass [] method)) - (text/= method-name (Method::getName [] method)) + #let [modifiers (Method::getModifiers method)]] + (wrap (and (Object::equals class (Method::getDeclaringClass method)) + (text/= method-name (Method::getName method)) (case #Static #Special - (Modifier::isStatic [modifiers]) + (Modifier::isStatic modifiers) _ #1) (case method-style #Special - (not (or (Modifier::isInterface [(Class::getModifiers [] class)]) - (Modifier::isAbstract [modifiers]))) + (not (or (Modifier::isInterface (Class::getModifiers class)) + (Modifier::isAbstract modifiers))) _ #1) @@ -957,10 +957,10 @@ (def: (check-constructor class arg-classes constructor) (-> (Class Object) (List Text) (Constructor Object) (Operation Bit)) (do ////.Monad<Operation> - [parameters (|> (Constructor::getGenericParameterTypes [] constructor) + [parameters (|> (Constructor::getGenericParameterTypes constructor) array.to-list (monad.map @ java-type-to-parameter))] - (wrap (and (Object::equals [class] (Constructor::getDeclaringClass [] constructor)) + (wrap (and (Object::equals class (Constructor::getDeclaringClass constructor)) (n/= (list.size arg-classes) (list.size parameters)) (list/fold (function (_ [expectedJC actualJC] prev) (and prev @@ -981,19 +981,19 @@ (def: (method-signature method-style method) (-> Method-Style Method (Operation Method-Signature)) - (let [owner (Method::getDeclaringClass [] method) - owner-name (Class::getName [] owner) + (let [owner (Method::getDeclaringClass method) + owner-name (Class::getName owner) owner-tvars (case method-style #Static (list) _ - (|> (Class::getTypeParameters [] owner) + (|> (Class::getTypeParameters owner) array.to-list - (list/map (TypeVariable::getName [])))) - method-tvars (|> (Method::getTypeParameters [] method) + (list/map (|>> TypeVariable::getName)))) + method-tvars (|> (Method::getTypeParameters method) array.to-list - (list/map (TypeVariable::getName []))) + (list/map (|>> TypeVariable::getName))) num-owner-tvars (list.size owner-tvars) num-method-tvars (list.size method-tvars) all-tvars (list/compose owner-tvars method-tvars) @@ -1008,11 +1008,11 @@ (list.zip2 all-tvars) (dictionary.from-list text.Hash<Text>))))] (do ////.Monad<Operation> - [inputsT (|> (Method::getGenericParameterTypes [] method) + [inputsT (|> (Method::getGenericParameterTypes method) array.to-list (monad.map @ (java-type-to-lux-type mappings))) - outputT (java-type-to-lux-type mappings (Method::getGenericReturnType [] method)) - exceptionsT (|> (Method::getGenericExceptionTypes [] method) + outputT (java-type-to-lux-type mappings (Method::getGenericReturnType method)) + exceptionsT (|> (Method::getGenericExceptionTypes method) array.to-list (monad.map @ (java-type-to-lux-type mappings))) #let [methodT (<| (type.univ-q num-all-tvars) @@ -1049,7 +1049,7 @@ (do ////.Monad<Operation> [class (load-class class-name) candidates (|> class - (Class::getDeclaredMethods []) + Class::getDeclaredMethods array.to-list (monad.map @ (: (-> Method (Operation Evaluation)) (function (_ method) @@ -1058,7 +1058,7 @@ (cond passes? (:: @ map (|>> #Pass) (method-signature method-style method)) - (text/= method-name (Method::getName [] method)) + (text/= method-name (Method::getName method)) (:: @ map (|>> #Hint) (method-signature method-style method)) ## else @@ -1075,14 +1075,14 @@ (def: (constructor-signature constructor) (-> (Constructor Object) (Operation Method-Signature)) - (let [owner (Constructor::getDeclaringClass [] constructor) - owner-name (Class::getName [] owner) - owner-tvars (|> (Class::getTypeParameters [] owner) + (let [owner (Constructor::getDeclaringClass constructor) + owner-name (Class::getName owner) + owner-tvars (|> (Class::getTypeParameters owner) array.to-list - (list/map (TypeVariable::getName []))) - constructor-tvars (|> (Constructor::getTypeParameters [] constructor) + (list/map (|>> TypeVariable::getName))) + constructor-tvars (|> (Constructor::getTypeParameters constructor) array.to-list - (list/map (TypeVariable::getName []))) + (list/map (|>> TypeVariable::getName))) num-owner-tvars (list.size owner-tvars) all-tvars (list/compose owner-tvars constructor-tvars) num-all-tvars (list.size all-tvars) @@ -1096,10 +1096,10 @@ (list.zip2 all-tvars) (dictionary.from-list text.Hash<Text>))))] (do ////.Monad<Operation> - [inputsT (|> (Constructor::getGenericParameterTypes [] constructor) + [inputsT (|> (Constructor::getGenericParameterTypes constructor) array.to-list (monad.map @ (java-type-to-lux-type mappings))) - exceptionsT (|> (Constructor::getGenericExceptionTypes [] constructor) + exceptionsT (|> (Constructor::getGenericExceptionTypes constructor) array.to-list (monad.map @ (java-type-to-lux-type mappings))) #let [objectT (#.Primitive owner-name (list.reverse owner-tvarsT)) @@ -1115,7 +1115,7 @@ (do ////.Monad<Operation> [class (load-class class-name) candidates (|> class - (Class::getConstructors []) + Class::getConstructors array.to-list (monad.map @ (function (_ constructor) (do @ @@ -1207,7 +1207,7 @@ [#let [argsT (list/map product.left argsTC)] class (load-class class-name) _ (////.assert non-interface class-name - (Modifier::isInterface [(Class::getModifiers [] class)])) + (Modifier::isInterface (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))) outputJC (check-jvm outputT)] |