typemanager.vb

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

' 
' Visual Basic.Net Compiler
' Copyright (C) 2004 - 2007 Rolf Bjarne Kvinge, [e-mail]
' 
' This library is free software; you can redistribute it and/or
' modify it under the terms of the GNU Lesser General Public
' License as published by the Free Software Foundation; either
' version 2.1 of the License, or (at your option) any later version.
' 
' This library is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
' Lesser General Public License for more details.
' 
' You should have received a copy of the GNU Lesser General Public
' License along with this library; if not, write to the Free Software
' Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
' 

#If DEBUG Then
#Const EXTENDEDDEBUG = 0
#End If

''' <summary>
''' A helper class containing all information about the referenced assemblies,
''' loaded types, etc.
''' </summary>
''' <remarks></remarks>
Public Class TypeManager
#If ENABLECECIL Then
    Private m_CecilAssemblies As New Generic.List(Of Mono.Cecil.AssemblyDefinition)
    Private m_CecilTypes As New CecilTypeList
    Private m_CecilModuleTypes As New CecilTypeList
    Private m_CecilTypesByNamespace As New CecilNamespaceDictionary
    Private m_CecilModulesByNamespace As New CecilNamespaceDictionary
#End If
    ''' <summary>
    ''' All the referenced assemblies
    ''' </summary>
    ''' <remarks></remarks>
    Private m_Assemblies As New Generic.List(Of System.Reflection.Assembly)

    ''' <summary>
    ''' All the types available.
    ''' </summary>
    ''' <remarks></remarks>
    Private m_Types As New TypeList

    ''' <summary>
    ''' All the types indexed by namespace.
    ''' </summary>
    ''' <remarks></remarks>
    Private m_TypesByNamespace As New NamespaceDictionary

    Private m_TypesByNamespaceAndName As New Generic.Dictionary(Of String, Generic.List(Of MemberInfo))

    Private m_TypesByName As New Generic.Dictionary(Of String, Generic.List(Of Type))(NameResolution.StringComparer)
    Private m_TypesByFullName As New Generic.Dictionary(Of String, Generic.List(Of Type))(NameResolution.StringComparer)

    ''' <summary>
    ''' All the modules indexed by namespace.
    ''' </summary>
    ''' <remarks></remarks>
    Private m_ModulesByNamespace As New NamespaceDictionary

    ''' <summary>
    ''' All the namespaces available.
    ''' </summary>
    ''' <remarks></remarks>
    Private m_Namespaces As New Namespaces

    ''' <summary>
    ''' All the types that are modules.
    ''' </summary>
    ''' <remarks></remarks>
    Private m_ModuleTypes As New TypeList

    Private m_Compiler As Compiler


    Private Shared m_GenericTypeCache As New Generic.Dictionary(Of String, GenericTypeDescriptor)(vbnc.NameResolution.StringComparer)
    Private Shared m_TypeDescriptorsOfTypes As New Generic.Dictionary(Of Type, TypeDescriptor)(New TypeComparer)
    Private Shared m_TypeDescriptorsOfTypes2 As New Generic.Dictionary(Of Integer, TypeDescriptor)

    Private Shared m_MemberDescriptorsOfMembers As New Generic.Dictionary(Of Integer, MemberInfo)
    Private Shared m_MemberDescriptorsOfMembers2 As New Generic.Dictionary(Of MemberInfo, MemberInfo)(New MemberComparer)

    Public MemberCache As New Generic.Dictionary(Of Type, MemberCache)(New TypeComparer)

    Function IsTypeNamed(ByVal Type As Type, ByVal Name As String) As Boolean
        If TypeOf Type Is TypeDescriptor Then Return NameResolution.CompareName(Type.Name, Name)
        Dim types As Generic.List(Of Type) = Nothing
        If m_TypesByName.TryGetValue(Name, types) = False Then Return False
        Return types.Contains(Type)
    End Function

    Function IsTypeFullnamed(ByVal Type As Type, ByVal FullName As String) As Boolean
        If TypeOf Type Is TypeDescriptor Then Return NameResolution.CompareName(Type.FullName, FullName)
        Dim types As Generic.List(Of Type) = Nothing
        If m_TypesByFullName.TryGetValue(FullName, types) = False Then Return False
        Return types.Contains(Type)
    End Function

    ReadOnly Property TypesByName() As Generic.Dictionary(Of String, Generic.List(Of Type))
        Get
            Return m_TypesByName
        End Get
    End Property

    Function GetCache(ByVal Type As Type) As MemberCache
        If MemberCache.ContainsKey(Type) Then
            Return MemberCache(Type)
        Else
            Return New MemberCache(Compiler, Type)
        End If
    End Function

    Function ContainsCache(ByVal Type As Type) As Boolean
        Return MemberCache.ContainsKey(Type)
    End Function
    ''' <summary>
    ''' All the referenced assemblies
    ''' </summary>
    ''' <remarks></remarks>
    ReadOnly Property Assemblies() As Generic.List(Of System.Reflection.Assembly)
        Get
            Return m_Assemblies
        End Get
    End Property

#If ENABLECECIL Then
    ReadOnly Property CecilAssemblies() As Generic.List(Of Mono.Cecil.AssemblyDefinition)
        Get
            Return m_CecilAssemblies
        End Get
    End Property

    ReadOnly Property CecilTypes() As CecilTypeList
        Get
            Return m_CecilTypes
        End Get
    End Property
#End If

    ''' <summary>
    ''' All the non-nested types available.
    ''' </summary>
    ''' <remarks></remarks>
    ReadOnly Property Types() As TypeList
        Get
            Return m_Types
        End Get
    End Property

    ''' <summary>
    ''' All the non-nested  types indexed by namespace.
    ''' </summary>
    ''' <remarks></remarks>
    ReadOnly Property TypesByNamespace() As NamespaceDictionary
        Get
            Return m_TypesByNamespace
        End Get
    End Property

    Function GetTypesByNamespaceAndName(ByVal [Namespace] As String, ByVal Name As String) As Generic.List(Of MemberInfo)
        Dim result As Generic.List(Of MemberInfo)
        Dim key As String = String.Concat([Namespace], "?", Name)
        If m_TypesByNamespaceAndName.ContainsKey(key) Then
            result = m_TypesByNamespaceAndName(key)
        Else
            result = New Generic.List(Of MemberInfo)
            Helper.FilterByName(TypesByNamespace([Namespace]), Name, result)
            m_TypesByNamespaceAndName.Add(key, result)
        End If
        Return result
    End Function

    ''' <summary>
    ''' All the namespaces available.
    ''' </summary>
    ''' <remarks></remarks>
    ReadOnly Property Namespaces() As Namespaces
        Get
            Return m_Namespaces
        End Get
    End Property

    ''' <summary>
    ''' All the non-nested types that are modules.
    ''' </summary>
    ''' <remarks></remarks>
    ReadOnly Property ModuleTypes() As TypeList
        Get
            Return m_ModuleTypes
        End Get
    End Property

    ReadOnly Property Compiler() As Compiler
        Get
            Return m_Compiler
        End Get
    End Property

    Sub New(ByVal Compiler As Compiler)
        MyBase.New()
        m_Compiler = Compiler
    End Sub


    ''' <summary>
    ''' Searches for the type with the specified name.
    ''' </summary>
    ''' <param name="Name">The type's name to search for. Not case-sensitive.</param>
    ''' <param name="OnlyCreatedTypes">Specifes whether to search in all types, or only in types compiled now.</param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Overloads Function [GetType](ByVal Name As String, ByVal OnlyCreatedTypes As Boolean) As Generic.List(Of Type)
        Dim result As New Generic.List(Of Type)
        result.AddRange(Me.GetType(Name, Types, OnlyCreatedTypes))
        Return result
    End Function

    Overloads Function [GetType](ByVal Name As String, ByVal InList As IEnumerable, ByVal OnlyCreatedTypes As Boolean) As Generic.List(Of Type)
        Dim result As New Generic.List(Of Type)
        For Each tp As Type In InList
            Dim tpD As TypeDescriptor = TryCast(tp, TypeDescriptor)
            If OnlyCreatedTypes AndAlso tpD Is Nothing Then Continue For
            If IsTypeNamed(tp, Name) OrElse IsTypeFullnamed(tp, Name) Then
#If EXTENDEDDEBUG Then
                Compiler.Report.WriteLine("Found type: " & tp.Name)
#End If
                result.Add(tp)
            Else
#If EXTENDEDDEBUG Then
                Compiler.Report.WriteLine("Discarded type: " & tp.Name)
#End If
            End If
            result.AddRange(Me.GetType(Name, tp.GetNestedTypes(BindingFlags.Instance Or BindingFlags.Public Or BindingFlags.NonPublic), OnlyCreatedTypes))
        Next
        Return result
    End Function

    ''' <summary>
    ''' Loads all the referenced assemblies.
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function LoadReferencedAssemblies() As Boolean
        Dim result As Boolean = True
        Dim refAssembly As Reflection.Assembly
        For Each strFile As String In Compiler.CommandLine.References
            refAssembly = LoadAssembly(strFile)
            If refAssembly Is Nothing Then
                Compiler.Report.ShowMessage(Messages.VBNC2017, strFile)
                Return False
            Else
                If Assemblies.Contains(refAssembly) = False Then
                    If Compiler.CommandLine.Verbose Then
                        Compiler.Report.WriteLine("Loaded '" & refAssembly.Location & "' (" & refAssembly.FullName & ")")
                    End If
                    Assemblies.Add(refAssembly)
#If ENABLECECIL Then
                    m_CecilAssemblies.Add(Mono.Cecil.AssemblyFactory.GetAssembly(refAssembly.Location))
#End If
                End If
            End If
        Next

        Compiler.TypeCache.Init()
#If ENABLECECIL Then
        Compiler.CecilTypeCache.Init()
#End If

        Return result
    End Function

    ''' <summary>
    ''' Loads all the types (referenced and compiled) and all the namespaces as well.
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function LoadReferenced() As Boolean
        Dim result As Boolean = True
        result = LoadReferencedAssemblies() AndAlso result
        If result = False Then Return result


        Dim loadVB As Boolean
        loadVB = Compiler.CommandLine.NoVBRuntimeRef = False
        If Not loadVB Then
            For Each ass As Assembly In Assemblies
                If NameResolution.CompareNameOrdinal(ass.GetName().Name, "Microsoft.VisualBasic") Then
                    loadVB = True
                    Exit For
                End If
            Next
        End If

        If loadVB Then
            Compiler.TypeCache.InitInternalVB()
#If ENABLECECIL Then
            Compiler.CecilTypeCache.InitInternalVB()
#End If
        End If

        result = LoadReferencedTypes() AndAlso result

#If EXTENDEDDEBUG Then
        Compiler.Report.WriteLine(String.Format("{0} assemblies were loaded.", Assemblies.Count.ToString))
        If Compiler.CommandLine.Verbose Then
            For i As Integer = 0 To Assemblies.Count - 1
                Compiler.Report.WriteLine("#" & (i + 1).ToString & ": " & Assemblies(i).FullName & " (location: " & Assemblies(i).Location & ")")
            Next
        End If
        Compiler.Report.WriteLine(String.Format("{0} namespaces were loaded.", Namespaces.Count))
        If Compiler.CommandLine.Verbose Then
            Dim ns As String() = Namespaces.NamespacesAsString
            For i As Integer = 0 To ns.Length - 1
                Compiler.Report.WriteLine("#" & (i + 1).ToString & ": " & ns(i))
            Next
        End If
        Compiler.Report.WriteLine(String.Format("{0} types were loaded.", Types.Count))
        If Compiler.CommandLine.Verbose Then
            For i As Integer = 0 To Types.Count - 1
                'Compiler.Report.WriteLine("#" & (i + 1).ToString & ": " & Types(i).FullName)
            Next
        End If
#End If
        Return result
    End Function

    ''' <summary>
    ''' Tries to load the specified file as an assembly.
    ''' </summary>
    ''' <param name="Filename"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function LoadAssembly(ByVal Filename As String) As Reflection.Assembly
        Dim refAss As Reflection.Assembly
        '  Try
        If IO.File.Exists(Filename) Then
            refAss = Reflection.Assembly.LoadFrom(Filename)
            'If Compiler.CommandLine.Verbose Then Compiler.Report.WriteLine("Loaded '" & Filename & "'")
            Return refAss
        End If

        If IO.File.Exists(IO.Path.Combine(IO.Path.GetDirectoryName(Reflection.Assembly.GetExecutingAssembly.Location), Filename)) Then
            Filename = IO.Path.Combine(IO.Path.GetDirectoryName(Reflection.Assembly.GetExecutingAssembly.Location), Filename)
            refAss = Reflection.Assembly.LoadFrom(Filename)
            'If Compiler.CommandLine.Verbose Then Compiler.Report.WriteLine("Loaded '" & Filename & "'")
            Return refAss
        End If

        '  Catch ex As IO.FileNotFoundException
        For Each strPath As String In Compiler.CommandLine.LibPath
            Dim strFullPath As String = IO.Path.Combine(strPath, Filename)
            Try
                If IO.File.Exists(strFullPath) Then
                    refAss = Reflection.Assembly.LoadFrom(strFullPath)
                    'If Compiler.CommandLine.Verbose Then Compiler.Report.WriteLine("Loaded '" & strFullPath & "'")
                    Return refAss
                End If
            Catch ex2 As Exception
                'Do nothing, just keep on trying
            End Try