typenameresolutioninfo.vb

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

' 
' 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
' 

Public Class TypeNameResolutionInfo
    Private m_FoundObjects As New Generic.List(Of Object)

    Private Name As ParsedObject
    Private FromWhere As BaseObject
    Private m_IsImportsResolution As Boolean
    Private m_Qualifier As TypeNameResolutionInfo
    Private m_TypeArgumentCount As Integer
    Private m_IsAttributeTypeName As Boolean


    Property IsAttributeTypeName() As Boolean
        Get
            Return m_IsAttributeTypeName
        End Get
        Set(ByVal value As Boolean)
            m_IsAttributeTypeName = value
        End Set
    End Property

    ''' <summary>
    ''' Returns true if the resolved object is the "Global" keyword.
    ''' </summary>
    ''' <value></value>
    ''' <remarks></remarks>
    ReadOnly Property IsGlobal() As Boolean
        Get
            Return m_FoundObjects.Count = 1 AndAlso ((TypeOf m_FoundObjects(0) Is Token AndAlso DirectCast(m_FoundObjects(0), Token).Equals(KS.Global)) OrElse (TypeOf m_FoundObjects(0) Is GlobalExpression))
        End Get
    End Property

    Public ReadOnly Property FoundOnlyOneObject() As Boolean
        Get
            Return m_FoundObjects.Count = 1
        End Get
    End Property

    Function FoundAsType() As Type 'Descriptor
        Dim found As Object = FoundObject
        If TypeOf found Is IType Then
            Return DirectCast(found, IType).TypeDescriptor
        ElseIf TypeOf found Is Type Then
            Return DirectCast(found, Type)
        ElseIf TypeOf found Is TypeDescriptor Then
            Return DirectCast(found, TypeDescriptor)
        ElseIf TypeOf found Is TypeParameter Then
            Return DirectCast(found, TypeParameter).TypeDescriptor
        Else
            Throw New InternalException("")
        End If
    End Function

    Function FoundIsType() As Boolean
        Dim found As Object = FoundObject
        Return TypeOf found Is IType OrElse TypeOf found Is Type OrElse TypeOf found Is TypeDescriptor
    End Function

    Function FoundIs(Of Type)() As Boolean
        If FoundOnlyOneObject Then
            Return TypeOf FoundObject Is Type
        Else
            Throw New InternalException("")
        End If
    End Function

    Function FoundAs(Of Type)() As Type
        Return CType(CObj(FoundObject), Type)
    End Function

    ReadOnly Property FoundObject() As Object
        Get
            If FoundOnlyOneObject = False Then
                Throw New InternalException("")
            Else
                Return m_FoundObjects(0)
            End If
        End Get
    End Property

    Public ReadOnly Property FoundObjects() As Generic.List(Of Object)
        Get
            Return m_FoundObjects
        End Get
    End Property

    Property IsImportsResolution() As Boolean
        Get
            Return m_IsImportsResolution
        End Get
        Set(ByVal value As Boolean)
            m_IsImportsResolution = value
        End Set
    End Property

    Property TypeArgumentCount() As Integer
        Get
            Return m_TypeArgumentCount
        End Get
        Set(ByVal value As Integer)
            m_TypeArgumentCount = value
        End Set
    End Property

    Sub New(ByVal Name As ConstructedTypeName, ByVal FromWhere As BaseObject, Optional ByVal TypeArgumentCount As Integer = 0)
        Me.Name = Name
        Me.FromWhere = FromWhere
        Me.TypeArgumentCount = TypeArgumentCount
    End Sub

    Sub New(ByVal Name As QualifiedIdentifier, ByVal FromWhere As BaseObject, Optional ByVal TypeArgumentCount As Integer = 0)
        Me.Name = Name
        Me.FromWhere = FromWhere
        Me.TypeArgumentCount = TypeArgumentCount
    End Sub

    Sub New(ByVal Name As Identifier, ByVal FromWhere As BaseObject, Optional ByVal TypeArgumentCount As Integer = 0)
        Me.Name = Name
        Me.FromWhere = FromWhere
        Me.TypeArgumentCount = TypeArgumentCount
    End Sub

    Sub New(ByVal Name As GlobalExpression, ByVal FromWhere As BaseObject, Optional ByVal TypeArgumentCount As Integer = 0)
        Me.Name = Name
        Me.FromWhere = FromWhere
        Me.TypeArgumentCount = TypeArgumentCount
    End Sub

    Function Resolve() As Boolean
        Dim result As Boolean = True
        Dim tmp As TypeNameResolutionInfo

        Dim glob As GlobalExpression = TryCast(Name, GlobalExpression)
        Dim id As Identifier = TryCast(Name, Identifier)
        Dim qi As QualifiedIdentifier = TryCast(Name, QualifiedIdentifier)
        Dim ctn As ConstructedTypeName = TryCast(Name, ConstructedTypeName)

        If ctn IsNot Nothing Then
            qi = ctn.QualifiedIdentifier
            Helper.Assert(TypeArgumentCount > 0)
        End If

        If qi IsNot Nothing Then
            If qi.IsFirstQualifiedIdentifier Then
                If Token.IsSomething(qi.Second) Then
                    tmp = New TypeNameResolutionInfo(qi.FirstAsQualifiedIdentifier, FromWhere, 0)
                Else
                    tmp = New TypeNameResolutionInfo(qi.FirstAsQualifiedIdentifier, FromWhere, Me.TypeArgumentCount)
                    tmp.IsAttributeTypeName = Me.IsAttributeTypeName
                End If
                'Helper.Assert(qi.Second IsNot Nothing) 'A qualified identifier can perfectly be only an identifier
            ElseIf qi.IsFirstGlobal Then
                Helper.Assert(TypeArgumentCount = 0)
                tmp = New TypeNameResolutionInfo(qi.FirstAsGlobal, FromWhere)
                'Helper.Assert(qi.Second IsNot Nothing)
            ElseIf qi.IsFirstIdentifier Then
                If Token.IsSomething(qi.Second) = False Then
                    tmp = New TypeNameResolutionInfo(qi.FirstAsIdentifier, FromWhere, Me.TypeArgumentCount)
                    tmp.IsAttributeTypeName = Me.IsAttributeTypeName
                Else
                    tmp = New TypeNameResolutionInfo(qi.FirstAsIdentifier, FromWhere, 0)
                End If
            Else
                Throw New InternalException(FromWhere)
            End If

            tmp.IsImportsResolution = Me.IsImportsResolution
            result = tmp.Resolve AndAlso result
            If result = False Then Return result

            If Token.IsSomething(qi.Second) = False Then
                Me.m_FoundObjects = tmp.m_FoundObjects
            Else
                If Me.IsAttributeTypeName Then
                    result = ResolveQualifiedName(tmp, qi.Second.IdentiferOrKeywordIdentifier & "Attribute", qi.Second.IdentiferOrKeywordIdentifier, Me.TypeArgumentCount) AndAlso result
                Else
                    result = ResolveQualifiedName(tmp, qi.Second.IdentiferOrKeywordIdentifier, Nothing, Me.TypeArgumentCount) AndAlso result
                End If
            End If
        ElseIf glob IsNot Nothing Then
            m_FoundObjects.Add(glob)
            result = True
        ElseIf id IsNot Nothing Then
            If Me.IsImportsResolution Then
                result = Me.CheckOutermostNamespace(id.Name, Me.TypeArgumentCount) AndAlso result
            Else
                Dim names() As String
                If Me.IsAttributeTypeName Then
                    names = New String() {id.Name & "Attribute", id.Name}
                Else
                    names = New String() {id.Name}
                End If
                result = ResolveUnqualifiedName(names, Me.TypeArgumentCount) AndAlso result
            End If
        ElseIf ctn IsNot Nothing Then
            Helper.NotImplemented()
        Else
            Helper.NotImplemented()
        End If

        Return result
    End Function

    Private Function ResolveQualifiedName(ByVal Qualifier As TypeNameResolutionInfo, ByVal R1 As String, ByVal R2 As String, ByVal TypeArgumentCount As Integer) As Boolean
        Dim result As Boolean = True

        result = ResolveQualifiedNameInternal(Qualifier, R1, R2 Is Nothing, TypeArgumentCount) AndAlso result

        If result = False AndAlso R2 IsNot Nothing Then
            result = ResolveQualifiedNameInternal(Qualifier, R2, True, TypeArgumentCount) 'AndAlso result
        End If

        Return result
    End Function

    Private Function ResolveQualifiedNameInternal(ByVal Qualifier As TypeNameResolutionInfo, ByVal R As String, ByVal ShowError As Boolean, ByVal TypeArgumentCount As Integer) As Boolean
        '---------------------------------------------------------------------------------------------------------
        '*************************************** Qualified Name Resolution '**************************************
        '---------------------------------------------------------------------------------------------------------
        '* Given a qualified namespace or type name of the form N.R, where R is the rightmost identifier in the 
        '* qualified name, the following steps describe how to determine to which namespace or type the qualified 
        '* Name(refers)
        '**	Resolve N, which may be either a qualified or unqualified name.
        '**	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 R matches the name of a namespace or type in N, then the qualified name 
        '** refers to that namespace or type.
        '**	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.
        '**	Otherwise, a compile-time error occurs. 
        ' * Note   An implication of this resolution process is that type members do not shadow namespaces or types 
        ' * when resolving namespace or type names.
        '---------------------------------------------------------------------------------------------------------

        Me.m_Qualifier = Qualifier

        If Qualifier.FoundOnlyOneObject Then
            Dim modules As TypeList = Nothing
            If Qualifier.IsGlobal Then
                'Helper.NotImplemented()
                If CheckOutermostNamespace(R, TypeArgumentCount) Then Return True
            ElseIf Qualifier.FoundIs(Of [Namespace])() OrElse Qualifier.FoundIs(Of ImportsClause)() Then
                'Helper.NotImplemented()
                '** If R matches the name of a namespace or type in N, 
                '** then the qualified name refers to that namespace or type.
                Dim strNS As String

                If Qualifier.FoundIs(Of [Namespace])() Then
                    Dim ns As [Namespace]
                    ns = Qualifier.FoundAs(Of [Namespace])()
                    strNS = ns.FullName
                ElseIf Qualifier.FoundIs(Of ImportsClause)() Then
                    Dim ic As ImportsClause
                    ic = Qualifier.FoundAs(Of ImportsClause)()
                    If ic.IsAliasClause Then
                        Dim ac As ImportsAliasClause = ic.AsAliasClause
                        If ac.NamespaceClause.IsNamespaceImport Then
                            Dim ns As [Namespace]
                            ns = ac.NamespaceClause.NamespaceImported
                            strNS = ns.FullName
                        ElseIf ac.NamespaceClause.IsTypeImport Then
                            strNS = ac.NamespaceClause.TypeImported.FullName
                        Else
                            Throw New InternalException(FromWhere)
                        End If
                    Else
                        Throw New InternalException(FromWhere)
                    End If
                Else
                    Throw New InternalException(FromWhere)
                End If