helper.vb

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

    Function GetDefaultGenericConstructor(ByVal tn As ConstructedTypeName) As ConstructorInfo
        Dim result As ConstructorInfo
        Dim candidates() As ConstructorInfo

        Dim openconstructor As ConstructorInfo
        If tn.ResolvedType.GetType.Name = "TypeBuilderInstantiation" Then
            candidates = tn.OpenResolvedType.GetConstructors(BindingFlags.DeclaredOnly Or BindingFlags.Instance Or BindingFlags.Public)
            openconstructor = GetDefaultConstructor(candidates)
            result = TypeBuilder.GetConstructor(tn.ClosedResolvedType, openconstructor)
        Else
            candidates = tn.ClosedResolvedType.GetConstructors(BindingFlags.DeclaredOnly Or BindingFlags.Instance Or BindingFlags.Public)
            result = GetDefaultConstructor(candidates)
            ' result = New GenericConstructorDescriptor(tn, tn.ClosedResolvedType, result)
        End If

        Return result
    End Function

    ''' <summary>
    ''' Returns all the constructors of the type descriptor. (instance + static + public + nonpublic)
    ''' </summary>
    ''' <param name="tp"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Function GetConstructors(ByVal tp As Type) As ConstructorInfo()
        Helper.Assert(tp IsNot Nothing)
        Helper.Assert(TypeOf tp Is TypeBuilder = False AndAlso tp.GetType.Name <> "TypeBuilderInstantiation")
        Return tp.GetConstructors(BindingFlags.Instance Or BindingFlags.Public Or BindingFlags.NonPublic Or BindingFlags.Static Or BindingFlags.DeclaredOnly)
    End Function

    Shared Function GetParameterTypes(ByVal Parameters As ParameterInfo()) As Type()
        Dim result() As Type
        Helper.Assert(Parameters IsNot Nothing)
        ReDim result(Parameters.Length - 1)
        For i As Integer = 0 To Parameters.GetUpperBound(0)
            result(i) = Parameters(i).ParameterType
        Next
        Return result
    End Function

    ''' <summary>
    ''' Checks if the specified type is a VB Module.
    ''' </summary>
    ''' <param name="type"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Shared Function IsModule(ByVal Compiler As Compiler, ByVal type As Type) As Boolean
        Dim result As Boolean
        If TypeOf type Is TypeDescriptor Then
            Return IsModule(Compiler, DirectCast(type, TypeDescriptor))
        ElseIf TypeOf Compiler.TypeCache.MS_VB_CS_StandardModuleAttribute Is TypeDescriptor Then
            'We're compiling the vbruntime, so no external type may be a module (we know that we're not referencing any external assemblies with modules)
            Return False
        ElseIf Compiler.TypeCache.MS_VB_CS_StandardModuleAttribute Is Nothing Then
            Return False
        Else
            result = type.IsClass AndAlso type.IsDefined(Compiler.TypeCache.MS_VB_CS_StandardModuleAttribute, False)
            Return result
        End If
    End Function

#If ENABLECECIL Then
    ''' <summary>
    ''' Checks if the specified type is a VB Module.
    ''' </summary>
    ''' <param name="type"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Shared Function IsModule(ByVal Compiler As Compiler, ByVal type As Mono.Cecil.TypeDefinition) As Boolean
        Dim result As Boolean
        'If TypeOf type Is TypeDescriptor Then
        '    Return IsModule(Compiler, DirectCast(type, TypeDescriptor))
        'Else
        result = type.IsClass AndAlso Compiler.CecilTypeCache.MS_VB_CS_StandardModuleAttribute IsNot Nothing AndAlso type.CustomAttributes.IsDefined(Compiler.CecilTypeCache.MS_VB_CS_StandardModuleAttribute)

        'Compiler.Report.WriteLine("IsModule: type=" & type.FullName & ", result=" & result.ToString)
        'If type.Name = "Constants" Then Stop
        Return result
        'End If
    End Function
#End If

    ''' <summary>
    ''' Checks if the specified type is a VB Module.
    ''' </summary>
    ''' <param name="type"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Shared Function IsModule(ByVal Compiler As Compiler, ByVal type As TypeDescriptor) As Boolean
        If type.Declaration IsNot Nothing Then
            Return type.Declaration.IsModule
        Else
            Return IsModule(Compiler, type.TypeInReflection)
        End If
    End Function

    Shared Function FilterByName(ByVal lst As Generic.List(Of TypeDescriptor), ByVal Name As String) As Generic.List(Of TypeDescriptor)
        Dim result As New Generic.List(Of TypeDescriptor)
        For Each t As TypeDescriptor In lst
            If NameResolution.CompareName(t.Name, Name) Then result.Add(t)
        Next
        Return result
    End Function

    '''' <summary>
    '''' Returns all members from the specified type.
    '''' Included: 
    '''' - all scopes for the compiling code, public and protected for external assemblies.
    '''' - instance and shared members.
    '''' - inherited members.
    '''' </summary>
    '''' <param name="Type"></param>
    '''' <returns></returns>
    '''' <remarks></remarks>
    '<Obsolete()> Shared Function GetMembers(ByVal Compiler As Compiler, ByVal Type As Type) As MemberInfo()
    '    Static cache As New Generic.Dictionary(Of Type, Generic.List(Of MemberInfo))
    '    Dim result As Generic.List(Of MemberInfo)

    '    If TypeOf Type Is TypeDescriptor = False AndAlso cache.ContainsKey(Type) Then
    '        result = cache(Type)
    '    Else
    '        Dim reflectableType As Type
    '        reflectableType = Compiler.TypeManager.GetRegisteredType(Type)

    '        Dim memberCache As MemberCache
    '        If Compiler.TypeManager.MemberCache.ContainsKey(reflectableType) = False Then
    '            memberCache = New MemberCache(Compiler, reflectableType)
    '        Else
    '            memberCache = Compiler.TypeManager.MemberCache(reflectableType)
    '        End If

    '        Dim result2 As Generic.List(Of MemberInfo)
    '        result2 = memberCache.FlattenedCache.GetAllMembers

    '        'result = New Generic.List(Of MemberInfo)
    '        'result.AddRange(reflectableType.GetMembers(Helper.ALLNOBASEMEMBERS))

    '        ''RemoveShadowed(Compiler, result)

    '        'If reflectableType.BaseType IsNot Nothing Then
    '        '    AddMembers(Compiler, Type, result, GetMembers(Compiler, reflectableType.BaseType))
    '        'ElseIf reflectableType.IsGenericParameter = False AndAlso reflectableType.IsInterface Then
    '        '    Dim ifaces() As Type
    '        '    ifaces = reflectableType.GetInterfaces()
    '        '    For Each iface As Type In ifaces
    '        '        Helper.AddMembers(Compiler, reflectableType, result, iface.GetMembers(Helper.ALLMEMBERS))
    '        '    Next
    '        '    Helper.AddMembers(Compiler, reflectableType, result, Compiler.TypeCache.Object.GetMembers(Helper.ALLMEMBERS))
    '        'End If
    '        'result = Helper.FilterExternalInaccessible(Compiler, result)

    '        'Helper.Assert(result.Count <= result2.Count)

    '        result = result2

    '        If TypeOf Type Is TypeDescriptor = False Then cache.Add(Type, result)
    '    End If

    '    Return result.ToArray
    'End Function

    '''' <summary>
    '''' Gets all the members in the specified type with the specified name.
    '''' Returns Nothing if nothing is found.
    '''' </summary>
    '''' <param name="Type"></param>
    '''' <param name="Name"></param>
    '''' <returns></returns>
    '''' <remarks></remarks>
    '<Obsolete()> Shared Function GetMembers(ByVal Compiler As Compiler, ByVal Type As Type, ByVal Name As String) As MemberInfo()
    '    Dim result As New Generic.List(Of MemberInfo)

    '    result.AddRange(GetMembers(Compiler, Type))
    '    result = Helper.FilterByName2(result, Name)

    '    Return result.ToArray
    'End Function

    ''' <summary>
    ''' Creates an integer array of the arguments.
    ''' </summary>
    ''' <param name="Info"></param>
    ''' <param name="Arguments"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Shared Function EmitIntegerArray(ByVal Info As EmitInfo, ByVal Arguments As ArgumentList) As Boolean
        Dim result As Boolean = True

        Dim arrayType As Type = Info.Compiler.TypeCache.System_Int32_Array
        Dim elementType As Type = arrayType.GetElementType
        Dim tmpVar As LocalBuilder = Info.ILGen.DeclareLocal(arrayType)
        Dim elementInfo As EmitInfo = Info.Clone(True, False, elementType)

        'Create the array.
        ArrayCreationExpression.EmitArrayCreation(Info, arrayType, New Generic.List(Of Integer)(New Integer() {Arguments.Count}))

        'Save it into a temporary variable.
        Emitter.EmitStoreVariable(Info, tmpVar)

        'Store every element into its index in the array.
        For i As Integer = 0 To Arguments.Count - 1
            'Load the array variable.
            Emitter.EmitLoadVariable(Info, tmpVar)
            Emitter.EmitLoadI4Value(Info, i)
            'Load all the indices.
            result = Arguments(i).GenerateCode(elementInfo) AndAlso result
            'Store the element in the arry.
            Emitter.EmitStoreElement(elementInfo, elementType, arrayType)
            'Increment the indices.
        Next

        'Load the final array onto the stack.
        Emitter.EmitLoadVariable(Info, tmpVar)

        Return result
    End Function

    Shared Function EmitStoreArrayElement(ByVal Info As EmitInfo, ByVal ArrayVariable As Expression, ByVal Arguments As ArgumentList) As Boolean
        Dim result As Boolean = True
        Dim ArrayType As Type = ArrayVariable.ExpressionType
        Dim ElementType As Type = ArrayType.GetElementType
        Dim isNonPrimitiveValueType As Boolean = ElementType.IsPrimitive = False AndAlso ElementType.IsValueType
        Dim isArraySetValue As Boolean = ArrayType.GetArrayRank > 1
        Dim newValue As Expression = Info.RHSExpression

        Helper.Assert(newValue IsNot Nothing)
        Helper.Assert(newValue.Classification.IsValueClassification)

        result = ArrayVariable.GenerateCode(Info.Clone(True, False, ArrayType)) AndAlso result

        If isArraySetValue Then
            result = newValue.GenerateCode(Info.Clone(True, False, ElementType)) AndAlso result
            If ElementType.IsValueType Then
                Emitter.EmitBox(Info, ElementType)
            End If
            result = EmitIntegerArray(Info, Arguments) AndAlso result
            Emitter.EmitCallOrCallVirt(Info, Info.Compiler.TypeCache.System_Array__SetValue)
        Else
            Dim methodtypes As New Generic.List(Of Type)
            Dim elementInfo As EmitInfo = Info.Clone(True, False, Info.Compiler.TypeCache.System_Int32)
            For i As Integer = 0 To Arguments.Count - 1
                result = Arguments(i).GenerateCode(elementInfo) AndAlso result
                Emitter.EmitConversion(Arguments(i).Expression.ExpressionType, Info.Compiler.TypeCache.System_Int32, Info)
                methodtypes.Add(Info.Compiler.TypeCache.System_Int32)
            Next

            Dim rInfo As EmitInfo = Info.Clone(True, False, ElementType)
            methodtypes.Add(ElementType)

            If isNonPrimitiveValueType Then
                Emitter.EmitLoadElementAddress(Info, ElementType, ArrayType)
                result = Info.RHSExpression.Classification.GenerateCode(rInfo) AndAlso result
                Emitter.EmitStoreObject(Info, ElementType)
            Else
                result = Info.RHSExpression.Classification.GenerateCode(rInfo) AndAlso result
                Emitter.EmitStoreElement(Info, ElementType, ArrayType)
            End If
        End If
        Return result
    End Function

    Shared Function EmitLoadArrayElement(ByVal Info As EmitInfo, ByVal ArrayVariable As Expression, ByVal Arguments As ArgumentList) As Boolean
        Dim result As Boolean = True
        Dim ArrayType As Type = ArrayVariable.ExpressionType
        Dim ElementType As Type = ArrayType.GetElementType
        Dim isNonPrimitiveValueType As Boolean = ElementType.IsPrimitive = False AndAlso ElementType.IsValueType
        Dim isArrayGetValue As Boolean = ArrayType.GetArrayRank > 1

        result = ArrayVariable.GenerateCode(Info) AndAlso result

        If isArrayGetValue Then
            result = Arguments.GenerateCode(Info, Helper.CreateArray(Of Type)(Info.Compiler.TypeCache.System_Int32, Arguments.Length)) AndAlso result
            'result = EmitIntegerArray(Info, Arguments) AndAlso result
            Dim getMethod As MethodInfo
            getMethod = ArrayElementInitializer.GetGetMethod(Info.Compiler, ArrayType)
            Helper.Assert(getMethod IsNot Nothing, "getMethod for type " & ArrayType.FullName & " could not be found (" & ArrayType.GetType.Name & ")")
            Emitter.EmitCallVirt(Info, getMethod)
            'Emitter.EmitCallOrCallVirt(Info, Info.Compiler.TypeCache.Array_GetValue)
            'If ElementType.IsValueType Then
            '    Emitter.EmitUnbox(Info, ElementType)
            'Else
            '    Emitter.EmitCastClass(Info, Info.Compiler.TypeCache.Object, ElementType)
            'End If
        Else
            Dim elementInfo As EmitInfo = Info.Clone(True, False, Info.Compiler.TypeCache.System_Int32)
            Dim methodtypes(Arguments.Count - 1) As Type
            For i As Integer = 0 To Arguments.Count - 1
                result = Arguments(i).GenerateCode(elementInfo) AndAlso result
                Emitter.EmitConversion(Info.Stack.Peek, Info.Compiler.TypeCache.System_Int32, Info)
                methodtypes(i) = Info.Compiler.TypeCache.System_Int32
            Next

            If isNonPrimitiveValueType Then
                Emitter.EmitLoadElementAddress(Info, ElementType, ArrayType)
                Emitter.EmitLoadObject(Info, ElementType)
            Else
                Emitter.EmitLoadElement(Info, ArrayType)
            End If
        End If
        Return result
    End Function

    ''' <summary>
    ''' Emits the instanceexpression (if any), the arguments (if any), the optional arguments (if any) and then calls the method (virt or not).
    ''' </summary>
    ''' <param name="Info"></param>
    ''' <param name="InstanceExpression"></param>
    ''' <param name="Arguments"></param>
    ''' <param name="Method"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>