typemanager.vb

来自「大名鼎鼎的mono是.NET平台的跨平台（支持linux」· VB 代码 · 共 729 行 · 第 1/2 页

        Next
        '  End Try
        Return Nothing
    End Function

    ''' <summary>
    ''' Load the type into the various lists.
    ''' </summary>
    ''' <param name="Type"></param>
    ''' <remarks></remarks>
    Private Sub LoadType(ByVal Type As Type)
        'Add the type to the list of all types.
        Me.Types.Add(Type)

        'Add the namespace to the list of all namespaces.
        Me.Namespaces.AddAllNamespaces(Compiler, Type.Namespace, True)

        'Add the type to the list of types by namespace.
        m_TypesByNamespace.AddType(Type)

        'If it is a module add it to the list of all modules and to the list of modules by namespace.
        If Helper.IsModule(Compiler, Type) Then
            m_ModuleTypes.Add(Type)
            m_ModulesByNamespace.AddType(Type)
        End If

        Dim name As String
        Dim fullname As String
        Dim types As Generic.List(Of Type) = Nothing
        name = Type.Name
        fullname = Type.FullName
        If m_TypesByName.TryGetValue(name, types) = False Then
            types = New Generic.List(Of Type)
            m_TypesByName(name) = types
        End If
        types.Add(Type)
        If m_TypesByFullName.TryGetValue(fullname, types) = False Then
            types = New Generic.List(Of Type)
            m_TypesByFullName(fullname) = types
        End If
        types.Add(Type)
    End Sub

#If ENABLECECIL Then
    ''' <summary>
    ''' Load the type into the various lists.
    ''' </summary>
    ''' <param name="Type"></param>
    ''' <remarks></remarks>
    Private Sub LoadType(ByVal Type As Mono.Cecil.TypeDefinition)
        'Add the type to the list of all types.
        Me.CecilTypes.Add(Type)

        'Add the namespace to the list of all namespaces.
        Me.Namespaces.AddAllNamespaces(Compiler, Type.Namespace, True)

        'Add the type to the list of types by namespace.
        m_CecilTypesByNamespace.AddType(Type)

        'If it is a module add it to the list of all modules and to the list of modules by namespace.
        If Helper.IsModule(Compiler, Type) Then
            m_CecilModuleTypes.Add(Type)
            m_cecilModulesByNamespace.AddType(Type)
        End If

    End Sub
#End If
    ''' <summary>
    ''' Finds all the public non-nested types in the referenced assemblies and loads them into the lists.
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function LoadReferencedTypes() As Boolean
        For Each ass As Reflection.Assembly In Assemblies
            Dim types() As Type = ass.GetTypes
            For Each type As Type In types
                If type.IsPublic Then
                    LoadType(type)
                End If
            Next
        Next
#If ENABLECECIL Then
        For Each ass As Mono.Cecil.AssemblyDefinition In CecilAssemblies
            Dim types As Mono.Cecil.TypeDefinitionCollection = ass.MainModule.Types
            For Each type As Mono.Cecil.TypeDefinition In types
                If type.ispublic Then
                    LoadType(type)
                End If
            Next
        Next
#End If
        Return True
    End Function

    ''' <summary>
    ''' Finds all the non-nested types in the compiling code and loads them into the lists.
    ''' </summary>
    ''' <remarks></remarks>
    Public Sub LoadCompiledTypes()
        For Each t As TypeDeclaration In Compiler.theAss.Types
            LoadType(t.TypeDescriptor)
        Next
    End Sub

    ''' <summary>
    ''' Returns all the modules within the specified namespace.
    ''' Never returns nothing and never throws an exception.
    ''' </summary>
    ''' <param name="Namespace"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function GetModulesByNamespace(ByVal [Namespace] As String) As TypeDictionary
        If [Namespace] Is Nothing Then [Namespace] = ""
        If [Namespace].StartsWith("Global.") Then [Namespace] = [Namespace].Substring(7)
        If m_ModulesByNamespace.ContainsKey([Namespace]) Then
            Return m_ModulesByNamespace([Namespace])
        Else
            Return New TypeDictionary()
        End If
    End Function

    ''' <summary>
    ''' Returns all the types within the specified namespace.
    ''' Never returns nothing and never throws an exception.
    ''' </summary>
    ''' <param name="Namespace"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function GetTypesByNamespace(ByVal [Namespace] As String) As TypeDictionary
        If [Namespace] Is Nothing Then [Namespace] = ""
        If m_TypesByNamespace.ContainsKey([Namespace]) Then
            Return m_TypesByNamespace([Namespace])
        Else
            Return New TypeDictionary()
        End If
    End Function

    Sub RegisterReflectionType(ByVal ReflectionType As Type, ByVal Descriptor As TypeDescriptor)
        If m_TypeDescriptorsOfTypes.ContainsKey(ReflectionType) = False Then
            m_TypeDescriptorsOfTypes.Add(ReflectionType, Descriptor)
            m_TypeDescriptorsOfTypes2.Add(ReflectionType.GetHashCode, Descriptor)
        End If
    End Sub

    Function GetRegisteredType(ByVal Type As Type) As Type
        If Type Is Nothing Then Return Nothing
        If TypeOf Type Is TypeDescriptor Then Return Type
        If m_TypeDescriptorsOfTypes2.ContainsKey(Type.GetHashCode) Then Return m_TypeDescriptorsOfTypes2(Type.GetHashCode)
        If m_TypeDescriptorsOfTypes.ContainsKey(Type) Then Return m_TypeDescriptorsOfTypes(Type)
        For Each key As Type In m_TypeDescriptorsOfTypes.Keys
            If key Is Type Then
                For Each item As Generic.KeyValuePair(Of Type, TypeDescriptor) In m_TypeDescriptorsOfTypes
                    If item.Key Is Type Then
                        Return item.Value
                    End If
                Next
                Helper.Assert(False)
            End If
        Next
        Helper.Assert(Helper.IsReflectionType(Type) = False)
        Return Type
    End Function

    Sub RegisterReflectionMember(ByVal ReflectionMember As MemberInfo, ByVal Descriptor As MemberInfo)
        'Console.WriteLine("RegisterReflectionMember (MemberInfo, MemberInfo)")
        'If ReflectionMember Is Nothing Then
        'Console.WriteLine(">ReflectionMember = Nothing")
        'Else
        'Console.WriteLine(">ReflectionMember = " & ReflectionMember.Name)
        'End If
        'If Descriptor Is Nothing Then
        'Console.WriteLine(">Descriptor = Nothing")
        'Else
        'Console.WriteLine(">Descriptor = " & Descriptor.Name)
        'End If
        If m_MemberDescriptorsOfMembers.ContainsKey(ReflectionMember.GetHashCode) = False Then
            m_MemberDescriptorsOfMembers.Add(ReflectionMember.GetHashCode, Descriptor)
            m_MemberDescriptorsOfMembers2.Add(ReflectionMember, Descriptor)
        End If
    End Sub

    Function GetRegisteredMember(ByVal Member As MemberInfo) As MemberInfo
        If Member Is Nothing Then Return Nothing

        If TypeOf Member Is ConstructorDescriptor Then Return Member
        If TypeOf Member Is PropertyDescriptor Then Return Member
        If TypeOf Member Is FieldDescriptor Then Return Member
        If TypeOf Member Is MethodDescriptor Then Return Member
        If TypeOf Member Is TypeDescriptor Then Return Member
        If TypeOf Member Is EventDescriptor Then Return Member

        If m_MemberDescriptorsOfMembers.ContainsKey(Member.GetHashCode) Then Return m_MemberDescriptorsOfMembers(Member.GetHashCode)
        If m_MemberDescriptorsOfMembers2.ContainsKey(Member) Then Return m_MemberDescriptorsOfMembers2(Member)
        For Each item As Generic.KeyValuePair(Of MemberInfo, MemberInfo) In m_MemberDescriptorsOfMembers2
            If item.Key Is Member Then
                Return item.Value
            End If
        Next
        Helper.Assert(Helper.IsReflectionMember(Member) = False)
        Return Member
    End Function

    Function MakeGenericField(ByVal Parent As ParsedObject, ByVal OpenField As FieldInfo, ByVal TypeParameters As Type(), ByVal TypeArguments() As Type, ByVal ClosedType As Type) As GenericFieldDescriptor
        Dim result As GenericFieldDescriptor

        result = New GenericFieldDescriptor(Parent, OpenField, TypeParameters, TypeArguments, ClosedType)

        Return result
    End Function


    ''' <summary>
    ''' Creates a closed method on a generic type.
    ''' </summary>
    ''' <param name="Parent"></param>
    ''' <param name="OpenMethod"></param>
    ''' <param name="TypeParameters"></param>
    ''' <param name="TypeArguments"></param>
    ''' <param name="ClosedType"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function MakeGenericMethod(ByVal Parent As ParsedObject, ByVal OpenMethod As MethodInfo, ByVal TypeParameters As Type(), ByVal TypeArguments() As Type, ByVal ClosedType As Type) As MethodInfo
        Dim result As MethodInfo

        Dim declaringType As Type
        declaringType = OpenMethod.DeclaringType
        declaringType = Helper.ApplyTypeArguments(Parent, declaringType, TypeParameters, TypeArguments)

        If declaringType.IsGenericType = False AndAlso declaringType.IsGenericParameter = False AndAlso declaringType.IsGenericTypeDefinition = False AndAlso declaringType.ContainsGenericParameters = False Then
            result = OpenMethod
        Else
            result = New GenericMethodDescriptor(Parent, OpenMethod, TypeParameters, TypeArguments, declaringType)
        End If

        Return result
    End Function

    ''' <summary>
    ''' Creates a closed method of an open generic method.
    ''' </summary>
    ''' <param name="Parent"></param>
    ''' <param name="OpenMethod"></param>
    ''' <param name="TypeParameters"></param>
    ''' <param name="TypeArguments"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function MakeGenericMethod(ByVal Parent As ParsedObject, ByVal OpenMethod As MethodInfo, ByVal TypeParameters As Type(), ByVal TypeArguments() As Type) As GenericMethodDescriptor
        Dim result As GenericMethodDescriptor

        result = New GenericMethodDescriptor(Parent, OpenMethod, TypeParameters, TypeArguments)

        Return result
    End Function

    Function MakeGenericConstructor(ByVal Parent As ParsedObject, ByVal OpenConstructor As ConstructorInfo, ByVal TypeParameters As Type(), ByVal TypeArguments() As Type, ByVal ClosedType As Type) As GenericConstructorDescriptor
        Dim result As GenericConstructorDescriptor

        result = New GenericConstructorDescriptor(Parent, OpenConstructor, TypeParameters, TypeArguments, ClosedType)

        Return result
    End Function

    Function MakeGenericProperty(ByVal Parent As ParsedObject, ByVal OpenProperty As PropertyInfo, ByVal TypeParameters As Type(), ByVal TypeArguments() As Type, ByVal ClosedType As Type) As GenericPropertyDescriptor
        Dim result As GenericPropertyDescriptor

        result = New GenericPropertyDescriptor(Parent, OpenProperty, TypeParameters, TypeArguments, ClosedType)

        Return result
    End Function

    Function MakeGenericParameter(ByVal Parent As ParsedObject, ByVal OpenParameter As ParameterInfo, ByVal ParameterType As Type) As GenericParameterDescriptor
        Dim result As GenericParameterDescriptor

        result = New GenericParameterDescriptor(Parent, ParameterType, OpenParameter)

        Return result
    End Function

    Function MakeGenericType(ByVal Parent As ParsedObject, ByVal OpenType As Type, ByVal GenericArguments As Type()) As GenericTypeDescriptor
        Dim result As GenericTypeDescriptor
        Dim genericArgumentList As New Generic.List(Of Type)
        Dim genericParameterList As New Generic.List(Of Type)
        Dim genericParameters() As Type

        genericArgumentList.AddRange(GenericArguments)
        genericParameterList.AddRange(OpenType.GetGenericArguments())

        Helper.Assert(genericArgumentList.Count = genericParameterList.Count)

        genericParameters = genericParameterList.ToArray
        GenericArguments = genericArgumentList.ToArray
        result = New GenericTypeDescriptor(Parent, OpenType, genericParameters, GenericArguments)

        'Needs to add this to a cache, otherwise two otherwise equal types might be created with two different 
        'type instances, which is not good as any type comparison would fail.
        Dim key As String = result.FullName
        Helper.Assert(key IsNot Nothing AndAlso key <> "")
        If m_GenericTypeCache.ContainsKey(key) Then
            'Revert to the cached type if it has already been created.
            result = m_GenericTypeCache(key)
        Else
            Dim addToCache As Boolean = True
            For Each item As Type In GenericArguments
                If item.IsGenericParameter Then addToCache = False : Exit For
            Next
            If addToCache Then m_GenericTypeCache.Add(key, result)
        End If

        Return result
    End Function

    Function MakeByRefType(ByVal Parent As ParsedObject, ByVal ElementType As Type) As Type
        Dim result As Type

        result = New ByRefTypeDescriptor(Parent, ElementType)

        Return result
    End Function

    Function MakeArrayType(ByVal Parent As ParsedObject, ByVal ElementType As Type, ByVal Ranks As Integer) As Type
        Dim result As Type

        result = New ArrayTypeDescriptor(Parent, ElementType, Ranks)

        Return result
    End Function

    ReadOnly Property GenericTypeCache() As Generic.Dictionary(Of String, GenericTypeDescriptor)
        Get
            Return m_GenericTypeCache
        End Get
    End Property

    Class TypeComparer
        Implements Collections.Generic.IEqualityComparer(Of Type)

        Public Function Equals1(ByVal x As System.Type, ByVal y As System.Type) As Boolean Implements System.Collections.Generic.IEqualityComparer(Of System.Type).Equals
            Return Helper.CompareType(x, y)
        End Function

        Public Function GetHashCode1(ByVal obj As System.Type) As Integer Implements System.Collections.Generic.IEqualityComparer(Of System.Type).GetHashCode
            Return obj.GetHashCode
        End Function
    End Class

    Class MemberComparer
        Implements Collections.Generic.IEqualityComparer(Of MemberInfo)

        Public Function Equals1(ByVal x As System.Reflection.MemberInfo, ByVal y As System.Reflection.MemberInfo) As Boolean Implements System.Collections.Generic.IEqualityComparer(Of System.Reflection.MemberInfo).Equals
            If x Is Nothing Xor y Is Nothing Then
                Return False
            ElseIf x Is Nothing AndAlso y Is Nothing Then
                Return True
            Else
                Return x.Equals(y)
            End If
        End Function

        Public Function GetHashCode1(ByVal obj As System.Reflection.MemberInfo) As Integer Implements System.Collections.Generic.IEqualityComparer(Of System.Reflection.MemberInfo).GetHashCode
            Return obj.GetHashCode()
        End Function
    End Class
End Class