typenameresolutioninfo.vb

大名鼎鼎的mono是.NET平台的跨平台（支持linux

                Dim nsp As [Namespace]
                nsp = FromWhere.Compiler.TypeManager.Namespaces.FindNamespace(strNS, R)
                If nsp IsNot Nothing Then
                    m_FoundObjects.Add(nsp)
                    Return True
                End If

                Dim types As TypeDictionary
                types = FromWhere.Compiler.TypeManager.TypesByNamespace(strNS)
                If types IsNot Nothing AndAlso types.Count > 0 Then
                    Dim genericName As String
                    genericName = vbnc.Helper.CreateGenericTypename(R, TypeArgumentCount)

                    Dim typesByName As Generic.List(Of Type) = Nothing
                    Dim tmp As Boolean
                    tmp = FromWhere.Compiler.TypeManager.TypesByName.TryGetValue(genericName, typesByName)

                    For Each tp As Type In types.Values
                        If TypeOf tp Is TypeDescriptor Then
                            If NameResolution.CompareName(tp.Name, genericName) Then
                                m_FoundObjects.Add(tp)
                            End If
                        Else
                            If typesByName IsNot Nothing AndAlso typesByName.Contains(tp) Then
                                m_FoundObjects.Add(tp)
                            End If
                        End If
                    Next
                    'Return True
                End If

                '**	If N contains one or more standard modules, and R matches the name of a type in 
                '** exactly one standard module, then the qualified name refers to that type. If R 
                '** matches the name of types in more than one standard module, a compile-time error occurs.
                If m_FoundObjects.Count = 0 Then
                    modules = FromWhere.Compiler.TypeManager.GetModulesByNamespace(strNS).ToTypeList
                    'Return True
                End If

                'Throw New InternalException("(1) Could not resolve: " & R & ", strNS:" & strNS & ", stCombinedNs: " & ", Location: " & FromWhere.Location.AsString)

                'Return False
            ElseIf Qualifier.FoundIs(Of IType)() Then
                '** If R matches the name of a namespace or type in N, 
                '** then the qualified name refers to that namespace or type.
                Dim tp As IType = Qualifier.FoundAs(Of IType)()
                Dim types As Generic.List(Of IType) = tp.Members.GetSpecificMembers(Of IType)()
                For Each t As IType In types
                    If NameResolution.CompareName(t.Name, R) Then
                        m_FoundObjects.Add(t)
                    End If
                Next

                '**	If N contains one or more standard modules, and R matches the name of a type in 
                '** exactly one standard module, then the qualified name refers to that type. If R 
                '** matches the name of types in more than one standard module, a compile-time error occurs.
                If m_FoundObjects.Count = 0 Then
                    modules = TypeDescriptor.CreateList(tp.Members.GetSpecificMembers(Of ModuleDeclaration)())
                End If
            ElseIf Qualifier.FoundIs(Of Type)() Then
                '** If R matches the name of a namespace or type in N, 
                '** then the qualified name refers to that namespace or type.
                Dim tp As Type = Qualifier.FoundAs(Of Type)()
                Dim nestedtp As Type = tp.GetNestedType(R, BindingFlags.Instance Or BindingFlags.NonPublic Or BindingFlags.Public)

                If nestedtp IsNot Nothing Then m_FoundObjects.Add(nestedtp)

                '**	If N contains one or more standard modules, and R matches the name of a type in 
                '** exactly one standard module, then the qualified name refers to that type. If R 
                '** matches the name of types in more than one standard module, a compile-time error occurs.
                If m_FoundObjects.Count = 0 Then
                    Helper.NotImplemented()
                    modules = TypeDescriptor.CreateList(tp.GetNestedTypes())
                End If
            Else
                '**	If resolution of N fails, resolves to a type parameter, or does not resolve to a namespace 
                '** or type, a compile-time error occurs.  (..)
                If ShowError = False Then Return False
                Helper.AddError("(2) Could not resolve: " & R & ", Location: " & FromWhere.Location.AsString)
                Helper.NotImplemented()
            End If

            '**	If N contains one or more standard modules, and R matches the name of a type in 
            '** exactly one standard module, then the qualified name refers to that type. If R 
            '** matches the name of types in more than one standard module, a compile-time error occurs.

            If modules IsNot Nothing AndAlso modules.Count > 0 AndAlso CheckModules(modules, R, TypeArgumentCount) Then Return True

            If m_FoundObjects.Count = 0 Then
                If ShowError = False Then Return False

                FromWhere.Compiler.Report.ShowMessage(Messages.VBNC30456, FromWhere.Location, R, Qualifier.FoundObject.ToString)
                Return False
            ElseIf m_FoundObjects.Count > 1 Then
                If ShowError = False Then Return False
                Helper.AddError("Found " & m_FoundObjects.Count.ToString & " members in type or namespace '" & Qualifier.FoundObject.ToString & "'")
            Else
                Return True
            End If
        Else
            '**	If resolution of N fails, (...)
            If ShowError = False Then Return False
            Helper.AddError("Qualifying member '" & Qualifier.m_Qualifier.FoundObject.ToString & "' resolves to '" & Qualifier.FoundObjects.Count.ToString & " objects" & "(R = " & R & ")")
        End If

        Return False
    End Function

    Private Function CheckCurrentFunctionForTypeParameters(ByVal R As String, ByVal TypeArgumentCount As Integer) As Boolean
        Dim signature As SubSignature = Nothing
        Dim method As MethodBaseDeclaration = FromWhere.FindFirstParent(Of MethodBaseDeclaration)()

        If method IsNot Nothing Then
            signature = method.Signature
        Else
            Dim del As DelegateDeclaration = FromWhere.FindFirstParent(Of DelegateDeclaration)()
            If del IsNot Nothing Then
                signature = del.Signature
            End If
        End If

        If signature IsNot Nothing AndAlso signature.TypeParameters IsNot Nothing Then
            Dim item As TypeParameter = signature.TypeParameters.Parameters.Item(R)
            If item IsNot Nothing Then
                m_FoundObjects.Add(item)
                Return True
            End If
        End If

        Return False
    End Function

    Private Function CheckNestedTypesOrTypeParameters(ByVal R As String, ByVal TypeArgumentCount As Integer) As Boolean
        '---------------------------------------------------------------------------------------------------------
        '* For each nested type containing the name reference, starting from the innermost type and going to the
        '* outermost, if R matches the name of an accessible nested type or a type parameter in the current type, 
        '* then the unqualified name refers to that type or type parameter.
        '---------------------------------------------------------------------------------------------------------

        'SPEC OMISSION:
        'Spec does not say anything about type parameters declared in a method.
        If CheckCurrentFunctionForTypeParameters(R, TypeArgumentCount) Then Return True


        Dim tp As IType = FromWhere.FindFirstParent(Of IType)()
        Dim obj As BaseObject = FromWhere
        Do
            tp = obj.FindFirstParent(Of IType)()
            If tp Is Nothing Then Exit Do
            obj = DirectCast(tp, BaseObject)

            'First check if there are nested types with the corresponding name.
            'Get all the members in the type corresponding to the Name
            Dim members As Generic.List(Of INameable)
            members = tp.Members.Declarations.Index.Item(vbnc.Helper.CreateGenericTypename(R, TypeArgumentCount))
            If members IsNot Nothing Then
                Dim i As Integer = 0
                While i <= members.Count - 1
                    Dim member As INameable = members(i)
                    'Remove all members that aren't types.
                    If TypeOf member Is IType = False Then
                        members.RemoveAt(i)
                    Else
                        i += 1
                    End If
                End While
                If members.Count > 0 Then
                    m_FoundObjects.AddRange(members.ToArray)
                    Return True
                End If
            End If

            'Then check if there are type parameters with the corresponding name
            'in the type (only if the current type is a class or a structure)
            Dim tpConstructable As IConstructable = TryCast(tp, IConstructable)
            If tpConstructable IsNot Nothing AndAlso tpConstructable.TypeParameters IsNot Nothing Then
                Dim param As TypeParameter
                param = tpConstructable.TypeParameters.Parameters.Item(R)
                If param IsNot Nothing Then
                    m_FoundObjects.Add(param)
                    Return True
                End If
            End If
        Loop

        Return False
    End Function

    Private Function CheckOutermostNamespace(ByVal R As String, ByVal TypeArgumentCount As Integer) As Boolean
        '---------------------------------------------------------------------------------------------------------
        '* (...)
        '**	If R matches the name of an accessible type or nested namespace in the current namespace, then the
        '** unqualified name refers to that type or nested namespace.
        '*
        '**	If the namespace contains one or more accessible standard modules, and R matches the name of an 
        '** accessible nested type in exactly one standard module, then the unqualified name refers to that nested type
        '*
        '** If R matches the name of accessible nested types in more than one standard module, a compile-time 
        '** error occurs.
        '--------------------------------------------------------------------------------------------------------- 

        '**	If R matches the name of an accessible type or nested namespace in the current namespace, then the
        '** unqualified name refers to that type or nested namespace.
        Dim types As TypeDictionary = Nothing
        Dim modules As TypeList
        Dim foundType As Type

        Dim RName As String = Helper.CreateGenericTypename(R, TypeArgumentCount)
        foundType = FromWhere.Compiler.TypeManager.TypesByNamespace("").Item(RName)
        If foundType IsNot Nothing Then
            m_FoundObjects.Add(foundType)
        End If
        If TypeArgumentCount = 0 AndAlso FromWhere.Compiler.TypeManager.Namespaces.IsNamespace(R, True) Then
            m_FoundObjects.Add(FromWhere.Compiler.TypeManager.Namespaces.Item(R))
        End If

        If m_FoundObjects.Count > 0 Then Return True

        '**	If the namespace contains one or more accessible standard modules, and R matches the name of an 
        '** accessible nested type in exactly one standard module, then the unqualified name refers to that nested type

        If types Is Nothing Then Return False 'There are no types (nor modules) in the outermost namespace.

        modules = FromWhere.Compiler.TypeManager.GetModulesByNamespace("").ToTypeList

        If CheckModules(modules, R, TypeArgumentCount) Then Return True

        Return False
    End Function

    Private Function CheckModules(ByVal moduletypes As TypeList, ByVal R As String, ByVal TypeArgumentCount As Integer) As Boolean
        '**	(...), and R matches the name of an 
        '** accessible nested type in exactly one standard module, (...)
#If DEBUG Then
        For Each t As Type In moduletypes
            Helper.Assert(Helper.IsModule(FromWhere.Compiler, t))
        Next
#End If
        Dim allModuleTypes As New Generic.List(Of Type) 'Descriptor)

        For Each t As Type In moduletypes
            Dim tFound As Type
            tFound = t.GetNestedType(R)
            If tFound IsNot Nothing Then
                allModuleTypes.Add(tFound)
            End If
        Next

        If allModuleTypes.Count = 1 Then
            m_FoundObjects.Add(allModuleTypes.Item(0))
            Return True
        ElseIf allModuleTypes.Count > 1 Then
            '** If R matches the name of accessible nested types in more than one standard module, a compile-time 
            '** error occurs.
            Helper.AddError()
            Return False
        End If
    End Function

    ''' <summary>
    ''' 
    ''' </summary>
    ''' <param name="R"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function CheckNamespace(ByVal R As String, ByVal Types As TypeDictionary, ByVal TypeArgumentCount As Integer) As Boolean
        '---------------------------------------------------------------------------------------------------------
        '* (...)
        '**	If R matches the name of an accessible type or nested namespace in the current namespace, then the
        '** unqualified name refers to that type or nested namespace.
        '*
        '**	If the namespace contains one or more accessible standard modules, and R matches the name of an 
        '** accessible nested type in exactly one standard module, then the unqualified name refers to that nested type
        '*
        '** If R matches the name of accessible nested types in more than one standard module, a compile-time 
        '** error occurs.
        '---------------------------------------------------------------------------------------------------------

        '**	If R matches the name of an accessible type or nested namespace in the current namespace, then the
        '** unqualified name refers to that type or nested namespace.
        Dim RName As String = vbnc.Helper.CreateGenericTypename(R, TypeArgumentCount)

        Dim foundType As Type

        foundType = Types.Item(RName)
        If foundType IsNot Nothing Then
            m_FoundObjects.Add(foundType)
            Return True
        End If