Moved "lux/target" to "lux/meta/target".

1 files changed, 385 insertions, 0 deletions

diff --git a/stdlib/source/library/lux/meta/target/jvm/reflection.lux b/stdlib/source/library/lux/meta/target/jvm/reflection.lux
new file mode 100644
index 000000000..3c5145a9d
--- /dev/null
+++ b/stdlib/source/library/lux/meta/target/jvm/reflection.lux
@@ -0,0 +1,385 @@
+(.require
+ [library
+  [lux (.except Primitive parameter type)
+   ["[0]" ffi (.only import)]
+   [abstract
+    ["[0]" monad (.only do)]]
+   [control
+    ["[0]" try (.only Try) (.use "[1]#[0]" functor)]
+    ["[0]" exception (.only exception)]]
+   [data
+    ["[0]" text (.use "[1]#[0]" equivalence)
+     ["%" \\format (.only format)]
+     ["<t>" \\parser]]
+    [collection
+     ["[0]" list (.use "[1]#[0]" mix functor)]
+     ["[0]" array]
+     ["[0]" dictionary]]]
+   [math
+    [number
+     ["n" nat]]]
+   [meta
+    ["[0]" type]
+    [macro
+     ["^" pattern]]]]]
+ ["[0]" //
+  [encoding
+   ["[1][0]" name (.only External)]]
+  ["/" type (.only)
+   [category (.only Void Value Return Method Primitive Object Class Array Parameter)]
+   ["[1][0]" lux (.only Mapping)]
+   ["[1][0]" descriptor]
+   ["[1][0]" reflection]
+   ["[1][0]" parser]]])
+
+(import java/lang/String
+  "[1]::[0]")
+
+(import java/lang/Object
+  "[1]::[0]"
+  (toString [] java/lang/String)
+  (getClass [] (java/lang/Class java/lang/Object)))
+
+(import java/lang/reflect/Type
+  "[1]::[0]"
+  (getTypeName [] java/lang/String))
+
+(import java/lang/reflect/GenericArrayType
+  "[1]::[0]"
+  (getGenericComponentType [] java/lang/reflect/Type))
+
+(import java/lang/reflect/ParameterizedType
+  "[1]::[0]"
+  (getRawType [] java/lang/reflect/Type)
+  (getActualTypeArguments [] [java/lang/reflect/Type]))
+
+(import (java/lang/reflect/TypeVariable d)
+  "[1]::[0]"
+  (getName [] java/lang/String)
+  (getBounds [] [java/lang/reflect/Type]))
+
+(import (java/lang/reflect/WildcardType d)
+  "[1]::[0]"
+  (getLowerBounds [] [java/lang/reflect/Type])
+  (getUpperBounds [] [java/lang/reflect/Type]))
+
+(import java/lang/reflect/Modifier
+  "[1]::[0]"
+  ("static" isStatic [int] boolean)
+  ("static" isFinal [int] boolean)
+  ("static" isInterface [int] boolean)
+  ("static" isAbstract [int] boolean))
+
+(import java/lang/annotation/Annotation
+  "[1]::[0]")
+
+(import java/lang/Deprecated
+  "[1]::[0]")
+
+(import java/lang/reflect/Field
+  "[1]::[0]"
+  (getDeclaringClass [] (java/lang/Class java/lang/Object))
+  (getModifiers [] int)
+  (getGenericType [] java/lang/reflect/Type)
+  (getDeclaredAnnotations [] [java/lang/annotation/Annotation]))
+
+(import java/lang/ClassLoader
+  "[1]::[0]")
+
+(import (java/lang/Class c)
+  "[1]::[0]"
+  ("static" forName [java/lang/String boolean java/lang/ClassLoader] "try" (java/lang/Class java/lang/Object))
+  (getName [] java/lang/String)
+  (isAssignableFrom [(java/lang/Class java/lang/Object)] boolean)
+  (getTypeParameters [] [(java/lang/reflect/TypeVariable (java/lang/Class c))])
+  (getDeclaredField [java/lang/String] "try" java/lang/reflect/Field)
+  (isArray [] boolean)
+  (getComponentType [] (java/lang/Class java/lang/Object)))
+
+(exception .public (unknown_class [class External])
+  (exception.report
+   "Class" (%.text class)))
+
+(with_template [<name>]
+  [(exception .public (<name> [jvm_type java/lang/reflect/Type])
+     (exception.report
+      "Type" (java/lang/reflect/Type::getTypeName jvm_type)
+      "Class" (|> jvm_type java/lang/Object::getClass java/lang/Object::toString)))]
+
+  [not_a_class]
+  [cannot_convert_to_a_lux_type]
+  )
+
+(def .public (load class_loader name)
+  (-> java/lang/ClassLoader External (Try (java/lang/Class java/lang/Object)))
+  (case (java/lang/Class::forName name false class_loader)
+    {try.#Failure _}
+    (exception.except ..unknown_class [name])
+
+    success
+    success))
+
+(def .public (sub? class_loader super sub)
+  (-> java/lang/ClassLoader External External (Try Bit))
+  (do try.monad
+    [super (..load class_loader super)
+     sub (..load class_loader sub)]
+    (in (java/lang/Class::isAssignableFrom sub super))))
+
+(def (class' parameter reflection)
+  (-> (-> java/lang/reflect/Type (Try (/.Type Parameter)))
+      java/lang/reflect/Type
+      (Try (/.Type Class)))
+  (<| (case (ffi.as java/lang/Class reflection)
+        {.#Some class}
+        (let [class_name (|> class
+                             (as (java/lang/Class java/lang/Object))
+                             java/lang/Class::getName)]
+          (`` (if (or (,, (with_template [<reflection>]
+                            [(text#= (/reflection.reflection <reflection>)
+                                     class_name)]
+
+                            [/reflection.boolean]
+                            [/reflection.byte]
+                            [/reflection.short]
+                            [/reflection.int]
+                            [/reflection.long]
+                            [/reflection.float]
+                            [/reflection.double]
+                            [/reflection.char]))
+                      (text.starts_with? /descriptor.array_prefix class_name))
+                (exception.except ..not_a_class [reflection])
+                {try.#Success (/.class class_name (list))})))
+        _)
+      (case (ffi.as java/lang/reflect/ParameterizedType reflection)
+        {.#Some reflection}
+        (let [raw (java/lang/reflect/ParameterizedType::getRawType reflection)]
+          (case (ffi.as java/lang/Class raw)
+            {.#Some raw'}
+            (let [! try.monad]
+              (|> reflection
+                  java/lang/reflect/ParameterizedType::getActualTypeArguments
+                  (array.list {.#None})
+                  (monad.each ! parameter)
+                  (at ! each (/.class (|> raw'
+                                          (as (java/lang/Class java/lang/Object))
+                                          java/lang/Class::getName)))
+                  (exception.with ..cannot_convert_to_a_lux_type [reflection])))
+
+            _
+            (exception.except ..not_a_class [reflection])))
+        _)
+      ... else
+      (exception.except ..cannot_convert_to_a_lux_type [reflection])))
+
+(def .public (parameter type reflection)
+  (-> (-> java/lang/reflect/Type (Try (/.Type Value)))
+      (-> java/lang/reflect/Type (Try (/.Type Parameter))))
+  (<| (case (ffi.as java/lang/reflect/TypeVariable reflection)
+        {.#Some reflection}
+        {try.#Success (/.var (java/lang/reflect/TypeVariable::getName reflection))}
+        _)
+      (case (ffi.as java/lang/reflect/WildcardType reflection)
+        {.#Some reflection}
+        ... TODO: Instead of having single lower/upper bounds, should
+        ... allow for multiple ones.
+        (case [(array.item 0 (java/lang/reflect/WildcardType::getLowerBounds reflection))
+               (array.item 0 (java/lang/reflect/WildcardType::getUpperBounds reflection))]
+          (^.with_template [<pattern> <kind>]
+            [<pattern>
+             (case (ffi.as java/lang/reflect/GenericArrayType bound)
+               {.#Some it}
+               ... TODO: Array bounds should not be "erased" as they
+               ... are right now.
+               {try.#Success /.wildcard}
+
+               _
+               (at try.monad each <kind> (parameter type bound)))])
+          ([[_ {.#Some bound}] /.upper]
+           [[{.#Some bound} _] /.lower])
+          
+          _
+          {try.#Success /.wildcard})
+        _)
+      (case (ffi.as java/lang/reflect/GenericArrayType reflection)
+        {.#Some reflection}
+        (|> reflection
+            java/lang/reflect/GenericArrayType::getGenericComponentType
+            type
+            (at try.monad each /.array))
+        _)
+      (case (ffi.as java/lang/Class reflection)
+        {.#Some class}
+        (if (java/lang/Class::isArray class)
+          (|> class
+              java/lang/Class::getComponentType
+              type
+              (try#each /.array))
+          (..class' (parameter type) reflection))
+        _)
+      (..class' (parameter type) reflection)))
+
+(def .public (type reflection)
+  (-> java/lang/reflect/Type (Try (/.Type Value)))
+  (<| (case (ffi.as java/lang/Class reflection)
+        {.#Some reflection}
+        (let [class_name (|> reflection
+                             (as (java/lang/Class java/lang/Object))
+                             java/lang/Class::getName)]
+          (`` (cond (,, (with_template [<reflection> <type>]
+                          [(text#= (/reflection.reflection <reflection>)
+                                   class_name)
+                           {try.#Success <type>}]
+
+                          [/reflection.boolean /.boolean]
+                          [/reflection.byte /.byte]
+                          [/reflection.short /.short]
+                          [/reflection.int /.int]
+                          [/reflection.long /.long]
+                          [/reflection.float /.float]
+                          [/reflection.double /.double]
+                          [/reflection.char /.char]))
+                    (if (text.starts_with? /descriptor.array_prefix class_name)
+                      (<t>.result /parser.value (|> class_name //name.internal //name.read))
+                      {try.#Success (/.class class_name (list))}))))
+        _)
+      ... else
+      (..parameter type reflection)))
+
+(def .public class
+  (-> java/lang/reflect/Type
+      (Try (/.Type Class)))
+  (..class' (..parameter ..type)))
+
+(def .public (return reflection)
+  (-> java/lang/reflect/Type (Try (/.Type Return)))
+  (with_expansions [<else> (these (..type reflection))]
+    (case (ffi.as java/lang/Class reflection)
+      {.#Some class}
+      (let [class_name (|> reflection
+                           (as (java/lang/Class java/lang/Object))
+                           java/lang/Class::getName)]
+        (if (text#= (/reflection.reflection /reflection.void)
+                    class_name)
+          {try.#Success /.void}
+          <else>))
+
+      {.#None}
+      <else>)))
+
+(exception .public (cannot_correspond [class (java/lang/Class java/lang/Object)
+                                       type Type])
+  (exception.report
+   "Class" (java/lang/Object::toString class)
+   "Type" (%.type type)))
+
+(exception .public (type_parameter_mismatch [expected Nat
+                                             actual Nat
+                                             class (java/lang/Class java/lang/Object)
+                                             type Type])
+  (exception.report
+   "Expected" (%.nat expected)
+   "Actual" (%.nat actual)
+   "Class" (java/lang/Object::toString class)
+   "Type" (%.type type)))
+
+(exception .public (non_jvm_type [type Type])
+  (exception.report
+   "Type" (%.type type)))
+
+(def .public (correspond class type)
+  (-> (java/lang/Class java/lang/Object) Type (Try Mapping))
+  (case type
+    {.#Primitive (static array.type_name) (list :member:)}
+    (if (java/lang/Class::isArray class)
+      (correspond (java/lang/Class::getComponentType class)
+                  :member:)
+      (exception.except ..cannot_correspond [class type]))
+    
+    {.#Primitive name params}
+    (let [class_name (java/lang/Class::getName class)
+          class_params (array.list {.#None} (java/lang/Class::getTypeParameters class))
+          num_class_params (list.size class_params)
+          num_type_params (list.size params)]
+      (if (text#= class_name name)
+        (if (n.= num_class_params num_type_params)
+          (|> params
+              (list.zipped_2 (list#each (|>> java/lang/reflect/TypeVariable::getName)
+                                        class_params))
+              (list#mix (function (_ [name paramT] mapping)
+                          (dictionary.has name paramT mapping))
+                        /lux.fresh)
+              {try.#Success})
+          (exception.except ..type_parameter_mismatch [num_class_params num_type_params class type]))
+        (exception.except ..cannot_correspond [class type])))
+
+    {.#Named name anonymousT}
+    (correspond class anonymousT)
+
+    {.#Apply inputT abstractionT}
+    (case (type.applied (list inputT) abstractionT)
+      {.#Some outputT}
+      (correspond class outputT)
+
+      {.#None}
+      (exception.except ..non_jvm_type [type]))
+
+    _
+    (exception.except ..non_jvm_type [type])))
+
+(exception .public (mistaken_field_owner [field java/lang/reflect/Field
+                                          owner (java/lang/Class java/lang/Object)
+                                          target (java/lang/Class java/lang/Object)])
+  (exception.report
+   "Field" (java/lang/Object::toString field)
+   "Owner" (java/lang/Object::toString owner)
+   "Target" (java/lang/Object::toString target)))
+
+(with_template [<name>]
+  [(exception .public (<name> [field Text
+                               class (java/lang/Class java/lang/Object)])
+     (exception.report
+      "Field" (%.text field)
+      "Class" (java/lang/Object::toString class)))]
+
+  [unknown_field]
+  [not_a_static_field]
+  [not_a_virtual_field]
+  )
+
+(def .public (field field target)
+  (-> Text (java/lang/Class java/lang/Object) (Try java/lang/reflect/Field))
+  (case (java/lang/Class::getDeclaredField field target)
+    {try.#Success field}
+    (let [owner (java/lang/reflect/Field::getDeclaringClass field)]
+      (if (same? owner target)
+        {try.#Success field}
+        (exception.except ..mistaken_field_owner [field owner target])))
+
+    {try.#Failure _}
+    (exception.except ..unknown_field [field target])))
+
+(def .public deprecated?
+  (-> (array.Array java/lang/annotation/Annotation) Bit)
+  (|>> (array.list {.#None})
+       (list.all (|>> (ffi.as java/lang/Deprecated)))
+       list.empty?
+       not))
+
+(with_template [<name> <exception> <then?> <else?>]
+  [(def .public (<name> field class)
+     (-> Text (java/lang/Class java/lang/Object) (Try [Bit Bit (/.Type Value)]))
+     (do [! try.monad]
+       [fieldJ (..field field class)
+        .let [modifiers (java/lang/reflect/Field::getModifiers fieldJ)]]
+       (case (java/lang/reflect/Modifier::isStatic modifiers)
+         <then?> (|> fieldJ
+                     java/lang/reflect/Field::getGenericType
+                     ..type
+                     (at ! each (|>> [(java/lang/reflect/Modifier::isFinal modifiers)
+                                      (..deprecated? (java/lang/reflect/Field::getDeclaredAnnotations fieldJ))])))
+         <else?> (exception.except <exception> [field class]))))]
+
+  [static_field ..not_a_static_field #1 #0]
+  [virtual_field ..not_a_virtual_field #0 #1]
+  )