typecache.vb

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

        Next

        If publicfields Then
            getters.AppendLine("    End Sub")
        End If

        vbtypes.AppendLine("    End Sub")
        vbmembers.AppendLine("    End Sub")

        Return variables.ToString & Environment.NewLine & getters.ToString & Environment.NewLine & vbtypes.ToString & Environment.NewLine & vbmembers.ToString
    End Function
#End If

    Public Overloads Function [GetType](ByVal Assembly As Assembly, ByVal FullName As String) As Type
        If Assembly Is Nothing Then Return Nothing
        Return Assembly.GetType(FullName, False, False)
    End Function

    Friend Function GetByRefType(ByVal Type As Type) As Type
        Return Type.MakeByRefType
    End Function

    Friend Function GetArrayType(ByVal Type As Type) As Type
        Return Type.MakeArrayType()
    End Function

    Friend Function GetProperty(ByVal Type As Type, ByVal Name As String, ByVal ParamArray Types() As Type) As PropertyInfo
        If Type Is Nothing Then Return Nothing
        Return Type.GetProperty(Name, BindingFlags.Instance Or BindingFlags.Static Or BindingFlags.Public Or BindingFlags.ExactBinding, Nothing, Nothing, Types, Nothing)
    End Function

    Friend Function GetConstructor(ByVal Type As Type, ByVal ParamArray Types() As Type) As ConstructorInfo
        If Type Is Nothing Then Return Nothing
        Return Type.GetConstructor(BindingFlags.Public Or BindingFlags.Static Or BindingFlags.Instance Or BindingFlags.ExactBinding, Nothing, Types, Nothing)
    End Function

    Friend Function GetMethod(ByVal Type As Type, ByVal Name As String, ByVal ParamArray Types() As Type) As MethodInfo
        Dim result As MethodInfo = Nothing
        If Type Is Nothing Then
#If DEBUG Then
            Compiler.Report.WriteLine("Could not load the method '" & Name & "', the specified type was Nothing.")
#End If
            Return Nothing
        End If
        Dim tD As TypeDescriptor = TryCast(Type, TypeDescriptor)
        If tD IsNot Nothing AndAlso False Then
            Dim members As MethodInfo()
            members = tD.GetMethods(BindingFlags.Public Or BindingFlags.Static Or BindingFlags.Instance Or BindingFlags.ExactBinding Or BindingFlags.NonPublic)
            For i As Integer = 0 To members.Length - 1
                If NameResolution.CompareNameOrdinal(members(i).Name, Name) Then
                    Helper.Assert(result Is Nothing)
                    result = members(i)
                End If
            Next
        Else
            result = Type.GetMethod(Name, BindingFlags.Public Or BindingFlags.Static Or BindingFlags.Instance Or BindingFlags.ExactBinding Or BindingFlags.NonPublic, Nothing, Types, Nothing)
        End If


#If DEBUG Then
        If result Is Nothing Then
            Compiler.Report.WriteLine(Report.ReportLevels.Debug, "Could not find the method '" & Name & "' on the type '" & Type.FullName)
        End If
#End If

        Return result
    End Function

    Friend Function GetField(ByVal Type As Type, ByVal Name As String) As FieldInfo
        If Type Is Nothing Then Return Nothing
        Return Type.GetField(Name)
    End Function

#If ENABLECECIL Then

    Protected Overloads Function [GetType](ByVal Assembly As Mono.Cecil.AssemblyDefinition, ByVal FullName As String) As Mono.Cecil.TypeDefinition
        If Assembly Is Nothing Then Return Nothing
        Dim result As Mono.Cecil.TypeDefinition
        result = Assembly.MainModule.Types.Item(FullName)
        If result Is Nothing Then Compiler.Report.WriteLine(String.Format("Could not load the type '{0}' from the assembly '{1}'", FullName, Assembly.Name.FullName))
        Return result
    End Function

    Protected Overloads Function [GetType](ByVal Type As Mono.Cecil.TypeDefinition, ByVal Name As String) As Mono.Cecil.TypeDefinition
        If Type Is Nothing Then Return Nothing
        Dim result As Mono.Cecil.TypeDefinition = Nothing
        For Each item As Mono.Cecil.TypeDefinition In Type.NestedTypes
            If NameResolution.CompareNameOrdinal(item.Name, Name) Then
                result = item
                Exit For
            End If
        Next
        If result Is Nothing Then Compiler.Report.WriteLine(String.Format("Could not load the nested type '{0}' from the type '{1}'", Name, Type.FullName))
        Return result
    End Function

    Protected Function GetByRefType(ByVal Type As Mono.Cecil.TypeDefinition) As Mono.Cecil.TypeReference
        Return New Mono.Cecil.ReferenceType(Type)
    End Function

    Protected Function GetArrayType(ByVal Type As Mono.Cecil.TypeDefinition) As Mono.Cecil.TypeReference
        Return New Mono.Cecil.ArrayType(Type)
    End Function

    Protected Function GetProperty(ByVal Type As Mono.Cecil.TypeDefinition, ByVal Name As String, ByVal ParamArray Types() As Mono.Cecil.TypeReference) As Mono.Cecil.PropertyDefinition
        If Type Is Nothing Then Return Nothing
        Dim properties As Mono.Cecil.PropertyDefinition()
        properties = Type.Properties.GetProperties(Name)
        For i As Integer = 0 To properties.GetUpperBound(0)
            Dim prop As Mono.Cecil.PropertyDefinition = properties(i)
            Dim params As Mono.Cecil.ParameterDefinitionCollection = prop.Parameters

            If IsMatch(Types, params) Then Return prop
        Next

        Return Nothing
    End Function

    Private Function IsMatch(ByVal Types As Mono.Cecil.TypeReference(), ByVal Parameters As Mono.Cecil.ParameterDefinitionCollection) As Boolean
        If Parameters.Count = 0 AndAlso (Types Is Nothing OrElse Types.Length = 0) Then Return True
        If Parameters.Count <> Types.Length Then Return False
        For j As Integer = 0 To Parameters.Count - 1
            If Helper.CompareType(Parameters(j).ParameterType, Types(j)) = False Then Return False
        Next
        Return True
    End Function

    Protected Function GetConstructor(ByVal Type As Mono.Cecil.TypeDefinition, ByVal ParamArray Types() As Mono.Cecil.TypeReference) As Mono.Cecil.MethodDefinition
        Return GetMethod(Type, ".ctor", Types)
    End Function

    Protected Function GetMethod(ByVal Type As Mono.Cecil.TypeDefinition, ByVal Name As String, ByVal ParamArray Types() As Mono.Cecil.TypeReference) As Mono.Cecil.MethodDefinition
        Dim result As Mono.Cecil.MethodDefinition
        If Type Is Nothing Then
#If DEBUG Then
            Compiler.Report.WriteLine("Could not load the method '" & Name & "', the specified type was Nothing.")
#End If
            Return Nothing
        End If

        If Name.StartsWith(".") Then
            result = Type.Constructors.GetConstructor(NameResolution.CompareNameOrdinal(Name, ".cctor"), Types)
        Else
            result = Type.Methods.GetMethod(Name, Types)
        End If
#If DEBUG Then
            If result Is Nothing Then
                Compiler.Report.WriteLine(Report.ReportLevels.Debug, "Could not find the method '" & Name & "' on the type '" & Type.FullName)
            End If
#End If

            Return result
    End Function

    Protected Function GetField(ByVal Type As Mono.Cecil.TypeDefinition, ByVal Name As String) As Mono.Cecil.FieldDefinition
        If Type Is Nothing Then Return Nothing
        Return Type.Fields.GetField(Name)
    End Function
#End If

    Sub Init()
        InitOptimizations()
        InitAssemblies()
        InitInternal()
        InitVBNCTypes()
    End Sub

    Protected MustOverride Sub InitInternal()

    Protected MustOverride Sub InitOptimizations()

    Protected MustOverride Sub InitAssemblies()

    Protected MustOverride Sub InitVBNCTypes()

    Public MustOverride Sub InitInternalVB()

    Public Overridable Sub InitInternalVBMembers()

    End Sub

End Class

Public Class TypeCache
    Inherits TypeCacheBase

    'The assemblies
    Public mscorlib As System.Reflection.Assembly
    Protected vbruntime As System.Reflection.Assembly
    Protected winforms As System.Reflection.Assembly

    'Special vbnc types
    Public [Nothing] As System.Type
    Public DelegateUnresolvedType As System.Type

    'Stupid MS type system with some optimizations requires this
    Public System_MonoType As Type
    Public System_RuntimeType As Type
    Public System_Reflection_Emit_TypeBuilder As Type
    Public System_Reflection_Emit_TypeBuilderInstantiation As Type
    Public System_Reflection_Emit_SymbolType As Type

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

    Friend Function GetVBType(ByVal Name As String) As Type
        Dim result As Type = Nothing

        If Compiler.CommandLine.NoVBRuntimeRef AndAlso vbruntime Is Nothing Then
            Dim tps As Generic.List(Of Type)