helper.vb

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

    Shared Function EmitArgumentsAndCallOrCallVirt(ByVal Info As EmitInfo, ByVal InstanceExpression As Expression, ByVal Arguments As ArgumentList, ByVal Method As MethodBase) As Boolean
        Dim result As Boolean = True
        Dim needsConstrained As Boolean
        Dim constrainedLocal As LocalBuilder = Nothing

        needsConstrained = InstanceExpression IsNot Nothing AndAlso InstanceExpression.ExpressionType.IsGenericParameter

        If InstanceExpression IsNot Nothing Then
            Dim ieDesiredType As Type
            Dim ieInfo As EmitInfo

            If needsConstrained Then
                ieDesiredType = InstanceExpression.ExpressionType
            Else
                ieDesiredType = Method.DeclaringType
                If ieDesiredType.IsValueType Then
                    ieDesiredType = Info.Compiler.TypeManager.MakeByRefType(CType(Info.Method, ParsedObject), ieDesiredType)
                End If
            End If

            ieInfo = Info.Clone(True, False, ieDesiredType)

            Dim derefExp As DeRefExpression = TryCast(InstanceExpression, DeRefExpression)
            If needsConstrained AndAlso derefExp IsNot Nothing Then
                result = derefExp.Expression.GenerateCode(Info.Clone(True, False, derefExp.Expression.ExpressionType)) AndAlso result
            Else
                Dim getRef As GetRefExpression = TryCast(InstanceExpression, GetRefExpression)
                If getRef IsNot Nothing AndAlso getRef.Expression.ExpressionType.IsValueType AndAlso Helper.CompareType(Method.DeclaringType, Info.Compiler.TypeCache.System_Object) 
                    result = getRef.Expression.GenerateCode(ieInfo) AndAlso result
                    Emitter.EmitBox(Info, getRef.Expression.ExpressionType)
                Else
                    result = InstanceExpression.GenerateCode(ieInfo) AndAlso result
                End If

                If needsConstrained Then
                    constrainedLocal = Emitter.DeclareLocal(Info, InstanceExpression.ExpressionType)
                    Emitter.EmitStoreVariable(Info, constrainedLocal)
                    Emitter.EmitLoadVariableLocation(Info, constrainedLocal)
                End If
            End If

        End If

        If Arguments IsNot Nothing Then
            Dim methodParameters() As ParameterInfo
            methodParameters = Helper.GetParameters(Info.Compiler, Method)
            result = Arguments.GenerateCode(Info, methodParameters) AndAlso result
        End If

        If needsConstrained Then
            Emitter.EmitConstrainedCallVirt(Info, Method, InstanceExpression.ExpressionType)
        ElseIf InstanceExpression IsNot Nothing AndAlso (TypeOf InstanceExpression Is MyClassExpression OrElse TypeOf InstanceExpression Is MyBaseExpression) Then
            Emitter.EmitCall(Info, Method)
        Else
            Emitter.EmitCallOrCallVirt(Info, Method)
        End If

        If constrainedLocal IsNot Nothing Then
            Emitter.FreeLocal(constrainedLocal)
        End If

        Return result
    End Function

    Shared Function GetInvokeMethod(ByVal Compiler As Compiler, ByVal DelegateType As Type) As MethodInfo
        Helper.Assert(IsDelegate(Compiler, DelegateType), "The type '" & DelegateType.FullName & "' is not a delegate.")
        Return DelegateType.GetMethod(DelegateDeclaration.STR_Invoke, BindingFlags.DeclaredOnly Or BindingFlags.Public Or BindingFlags.Instance)
    End Function

    Shared Function IsDelegate(ByVal Compiler As Compiler, ByVal Type As Type) As Boolean
        Return Helper.IsSubclassOf(Compiler.TypeCache.System_MulticastDelegate, Type)
    End Function

    ''' <summary>
    ''' Returns true if the type has a default property
    ''' </summary>
    ''' <param name="Type"></param>
    ''' <param name="DefaultProperties"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Shared Function HasDefaultProperty(ByVal Compiler As Compiler, ByVal Type As Type, ByRef DefaultProperties As Generic.List(Of PropertyInfo)) As Boolean
        Dim attrib As Reflection.DefaultMemberAttribute
        Dim tD As TypeDescriptor

        tD = TryCast(Type, TypeDescriptor)

        If tD Is Nothing Then
            Dim members As New Generic.List(Of MemberInfo)
            Dim properties As New Generic.List(Of PropertyInfo)

            Helper.Assert(Type IsNot Nothing)
            attrib = CType(System.Attribute.GetCustomAttribute(Type, GetType(DefaultMemberAttribute), True), DefaultMemberAttribute)

            If attrib Is Nothing Then Return False

            'members = Helper.FilterByName(Type.GetMembers(), attrib.MemberName)
            members = Compiler.TypeManager.GetCache(Type).LookupFlattenedMembers(attrib.MemberName)

            If members IsNot Nothing Then
                For Each member As MemberInfo In members
                    If member.MemberType = MemberTypes.Property Then
                        properties.Add(DirectCast(member, PropertyInfo))
                    Else
                        Throw New InternalException("")
                    End If
                Next
            End If
            DefaultProperties = properties
            Return True
        Else
            Dim members As New Generic.List(Of MemberInfo)
            Dim properties As New Generic.List(Of PropertyInfo)
            'members.AddRange(tD.GetMembers())
            members.AddRange(Compiler.TypeManager.GetCache(tD).Cache.GetAllMembers)
            For Each member As MemberInfo In members
                Dim propD As PropertyDescriptor = TryCast(member, PropertyDescriptor)
                Dim prop As PropertyInfo = TryCast(member, PropertyInfo)
                If propD IsNot Nothing Then
                    If propD.IsDefault Then properties.Add(propD)
                ElseIf prop IsNot Nothing Then
                    Helper.NotImplemented() 'I don't know if this is a possibility with generic types.
                End If
            Next
            If properties.Count = 0 Then
                If tD.BaseType IsNot Nothing Then
                    Return Helper.HasDefaultProperty(Compiler, tD.BaseType, DefaultProperties)
                Else
                    Return False
                End If
            Else
                DefaultProperties = properties
                Return True
            End If
        End If
    End Function

    Shared Function GetDefaultMemberAttribute(ByVal Type As Type) As DefaultMemberAttribute
        Dim attrib As Reflection.DefaultMemberAttribute
        Dim tD As TypeDescriptor

        tD = TryCast(Type, TypeDescriptor)

        If tD Is Nothing Then
            attrib = CType(System.Attribute.GetCustomAttribute(Type, GetType(DefaultMemberAttribute), True), DefaultMemberAttribute)
        Else
            Dim types() As Object
            types = tD.GetCustomAttributes(True)
            attrib = Nothing
        End If
        Return attrib
    End Function

    Shared Function IsShadows(ByVal Member As MemberInfo) As Boolean
        Dim result As Boolean = True
        Select Case Member.MemberType
            Case MemberTypes.Method, MemberTypes.Constructor
                Return DirectCast(Member, MethodBase).IsHideBySig = False
            Case MemberTypes.Property
                Return CBool(Helper.GetPropertyAttributes(DirectCast(Member, PropertyInfo)) And MethodAttributes.HideBySig) = False
            Case MemberTypes.Field
                Return True
            Case MemberTypes.TypeInfo
                Return True
            Case MemberTypes.NestedType
                Return True
            Case MemberTypes.Event
                Return DirectCast(Member, EventInfo).GetAddMethod.IsHideBySig = False
            Case Else
                Helper.NotImplemented()
                Throw New InternalException("")
        End Select
    End Function

    Shared Function IsShared(ByVal Member As MemberInfo) As Boolean
        Dim result As Boolean = True
        Select Case Member.MemberType
            Case MemberTypes.Method, MemberTypes.Constructor
                Return DirectCast(Member, MethodBase).IsStatic
            Case MemberTypes.Property
                Dim pInfo As PropertyInfo = DirectCast(Member, PropertyInfo)
                Return CBool(Helper.GetPropertyAttributes(pInfo) And MethodAttributes.Static)
            Case MemberTypes.Field
                Dim fInfo As FieldInfo = DirectCast(Member, FieldInfo)
                Return fInfo.IsStatic
            Case MemberTypes.TypeInfo
                Return False
            Case MemberTypes.NestedType
                Return False
            Case MemberTypes.Event
                Return DirectCast(Member, EventInfo).GetAddMethod.IsStatic
            Case Else
                Throw New InternalException("")
        End Select
    End Function

    Shared Function GetTypes(ByVal Params As ParameterInfo()) As Type()
        Dim result() As Type = Nothing

        If Params Is Nothing Then Return result
        ReDim result(Params.GetUpperBound(0))
        For i As Integer = 0 To Params.GetUpperBound(0)
            result(i) = Params(i).ParameterType
        Next
        Return result
    End Function

    Shared Function GetTypes(ByVal Arguments As Generic.List(Of Argument)) As Type()
        Dim result() As Type = Type.EmptyTypes

        If Arguments Is Nothing Then Return result
        ReDim result(Arguments.Count - 1)
        For i As Integer = 0 To Arguments.Count - 1
            Helper.Assert(Arguments(i) IsNot Nothing)
            If Arguments(i) IsNot Nothing AndAlso Arguments(i).Expression IsNot Nothing Then
                result(i) = Arguments(i).Expression.ExpressionType
            End If
        Next
        Return result
    End Function

    Shared Function GetTypes(ByVal Params As ParameterInfo()()) As Type()()
        Dim result()() As Type

        Helper.Assert(Params IsNot Nothing)

        ReDim result(Params.GetUpperBound(0))
        For i As Integer = 0 To Params.GetUpperBound(0)
            result(i) = Helper.GetTypes(Params(i))
        Next

        Return result
    End Function

#If ENABLECECIL Then
    Shared Function GetTypeDefinition(ByVal Compiler As Compiler, ByVal Type As Type) As Mono.Cecil.TypeReference
        Dim tD As TypeDescriptor = TryCast(Type, TypeDescriptor)
        If tD IsNot Nothing Then
            Return tD.Declaration.CecilType
        Else
            Return Compiler.ModuleBuilderCecil.Import(Type)
        End If
    End Function
#End If
    Shared Sub ApplyTypeArguments(ByVal Members As Generic.List(Of MemberInfo), ByVal TypeArguments As TypeArgumentList)
        If TypeArguments Is Nothing OrElse TypeArguments.Count = 0 Then Return

        For i As Integer = Members.Count - 1 To 0 Step -1
            Members(i) = ApplyTypeArguments(Members(i), TypeArguments)
            If Members(i) Is Nothing Then Members.RemoveAt(i)
        Next

    End Sub

    Shared Function ApplyTypeArguments(ByVal Member As MemberInfo, ByVal TypeArguments As TypeArgumentList) As MemberInfo
        Dim result As MemberInfo
        Dim minfo As MethodInfo

        minfo = TryCast(Member, MethodInfo)
        If minfo IsNot Nothing Then
            Dim args() As Type
            args = minfo.GetGenericArguments()

            If args.Length = TypeArguments.Count Then
                result = TypeArguments.Compiler.TypeManager.MakeGenericMethod(TypeArguments.Parent, minfo, args, TypeArguments.AsTypeArray)
            Else
                result = Nothing
            End If
        Else
            result = Nothing
            Helper.NotImplemented()
        End If

        Return result
    End Function

    Shared Function ApplyTypeArguments(ByVal Parent As ParsedObject, ByVal OpenType As Type, ByVal TypeParameters As Type(), ByVal TypeArguments() As Type) As Type
        Dim result As Type = Nothing

        If OpenType Is Nothing Then Return Nothing

        Helper.Assert(TypeParameters IsNot Nothing AndAlso TypeArguments IsNot Nothing)
        Helper.Assert(TypeParameters.Length = TypeArguments.Length)

        If OpenType.IsGenericParameter Then
            For i As Integer = 0 To TypeParameters.Length - 1
                If NameResolution.CompareName(TypeParameters(i).Name, OpenType.Name) Then
                    result = TypeArguments(i)
                    Exit For
                End If
            Next
            Helper.Assert(result IsNot Nothing)
        ElseIf OpenType.IsGenericType Then
            Dim typeParams() As Type
            Dim typeArgs As New Generic.List(Of Type)

            typeParams = OpenType.GetGenericArguments()

            For i As Integer = 0 To typeParams.Length - 1
                For j As Integer = 0 To TypeParameters.Length - 1
                    If NameResolution.CompareName(typeParams(i).Name, TypeParameters(j).Name) Then
                        typeArgs.Add(TypeArguments(j))
                        Exit For
                    End If
                Next
                If typeArgs.Count - 1 < i Then typeArgs.Add(typeParams(i))
            Next

            Helper.Assert(typeArgs.Count = typeParams.Length AndAlso typeArgs.Count > 0)

            result = Parent.Compiler.TypeManager.MakeGenericType(Parent, OpenType, typ