parser.vb

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

        If qi Is Nothing Then Helper.ErrorRecoveryNotImplemented()

        If result IsNot Nothing AndAlso tm.CurrentToken = KS.LParenthesis AndAlso tm.PeekToken = KS.Of Then
            Dim ctn As ConstructedTypeName = Nothing
            tm.RestoreToPoint(iCurrent)
            ctn = ParseConstructedTypeName(result)
            If ctn Is Nothing Then Helper.ErrorRecoveryNotImplemented()
            result.Init(ctn)
        Else
            tm.IgnoreRestoredPoint()
            result.Init(qi)
        End If

        Return result
    End Function

    Private Function ParseAssemblyDeclaration(ByVal RootNamespace As String) As AssemblyDeclaration
        Dim result As New AssemblyDeclaration(m_Compiler)
        Dim iLastToken As Token

        Dim AssemblyAttributes As New Attributes(result)
        Dim AssemblyTypes As New MemberDeclarations(result)

        tm.NextToken() 'Goto the first token

        Do Until tm.CurrentToken.IsEndOfCode
#If EXTENDEDDEBUG Then
            Dim iFileCount, iTotalFiles As Integer
            iFileCount += 1
            iTotalFiles = Me.Compiler.CommandLine.Files.Count
            Me.Compiler.Report.WriteLine(Report.ReportLevels.Debug, "Parsing file " & tm.CurrentToken.Location.File.FileName & " (" & iFileCount & " of " & iTotalFiles & " files)")
#End If
            iLastToken = tm.CurrentToken
            While tm.AcceptNewLine

            End While
            '[  OptionStatement+  ]
            '[  ImportsStatement+  ]

            If Me.ParseFileHeader(tm.CurrentToken.Location.File(Compiler), result) = False Then
                Helper.ErrorRecoveryNotImplemented()
            End If
            ''	[  AttributesStatement+  ]
            'If vbnc.Attributes.IsMe(tm) Then
            '    If Me.ParseAttributes(result, AssemblyAttributes) = False Then
            '        Helper.ErrorRecoveryNotImplemented()
            '    End If
            'End If

            '	[  NamespaceMemberDeclaration+  ]
            ParseAssemblyMembers(result, RootNamespace, AssemblyTypes)

            While tm.AcceptNewLine

            End While
            tm.AcceptEndOfFile()
            If Token.IsSomething(iLastToken) = Token.IsSomething(tm.CurrentToken) AndAlso iLastToken.Location.Equals(tm.CurrentToken.Location) Then
                Throw New InternalException("Recursive problems, could not get past token: " & tm.CurrentToken.ToString() & " with location: " & tm.CurrentToken.Location.ToString(Compiler))
            End If
        Loop

        result.Init(AssemblyTypes, AssemblyAttributes)

        Return result
    End Function

    ''' <summary>
    '''  Attributes ::=	AttributeBlock  |	Attributes  AttributeBlock
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseAttributes(ByVal Parent As ParsedObject, ByVal Attributes As Attributes) As Boolean
        Dim result As Boolean = True

        Helper.Assert(Attributes IsNot Nothing)

        While AttributeBlock.IsMe(tm)
            If ParseAttributeBlock(Parent, Attributes) = False Then
                Helper.ErrorRecoveryNotImplemented()
            End If
        End While

        Return result
    End Function
    ''' <summary>
    '''  Parses attributes (if any). Always returns something.
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseAttributes(ByVal Parent As ParsedObject) As Attributes
        Dim result As New Attributes(Parent)

        If Attributes.IsMe(tm) Then
            While AttributeBlock.IsMe(tm)
                If ParseAttributeBlock(Parent, result) = False Then
                    Helper.ErrorRecoveryNotImplemented()
                End If
            End While
        End If

        Return result
    End Function
    ''' <summary>
    ''' AttributeBlock  ::=  "&lt;"  AttributeList  "&gt;"
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseAttributeBlock(ByVal Parent As ParsedObject, ByVal Attributes As Attributes) As Boolean
        Dim result As Boolean = True

        Helper.Assert(Attributes IsNot Nothing)

        tm.AcceptIfNotInternalError(KS.LT)

        If ParseAttributeList(Parent, Attributes) = False Then
            Helper.ErrorRecoveryNotImplemented()
        End If

        result = tm.AcceptIfNotError(KS.GT) AndAlso result

        Return result
    End Function

    ''' <summary>
    ''' AttributeList  ::=	Attribute  | AttributeList  ,  Attribute
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseAttributeList(ByVal Parent As ParsedObject, ByVal Attributes As Attributes) As Boolean
        Dim result As Boolean = True

        Helper.Assert(Attributes IsNot Nothing)

        Do
            Dim Attribute As Attribute
            Attribute = ParseAttribute(Parent)
            If Attribute Is Nothing Then Helper.ErrorRecoveryNotImplemented()
            Attributes.Add(Attribute)
        Loop While tm.Accept(KS.Comma)

        Return result
    End Function

    ''' <summary>
    ''' Attribute          ::= [  AttributeModifier  ":"  ]  SimpleTypeName  [  "("  [  AttributeArguments  ]  ")"  ]
    ''' AttributeModifier  ::=  "Assembly" | "Module"
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseAttribute(ByVal Parent As ParsedObject) As Attribute
        Dim result As New Attribute(Parent)

        Dim m_IsAssembly As Boolean
        Dim m_IsModule As Boolean
        Dim m_SimpleTypeName As SimpleTypeName = Nothing
        Dim m_AttributeArguments As AttributeArguments = Nothing

        If tm.Accept("Assembly") Then
            m_IsAssembly = True
            If tm.AcceptIfNotError(KS.Colon) = False Then Helper.ErrorRecoveryNotImplemented()
        ElseIf tm.Accept(KS.Module) Then
            m_IsModule = True
            If tm.AcceptIfNotError(KS.Colon) = False Then Helper.ErrorRecoveryNotImplemented()
        End If

        m_SimpleTypeName = ParseSimpleTypeName(result)
        If m_SimpleTypeName Is Nothing Then Helper.ErrorRecoveryNotImplemented()

        If tm.Accept(KS.LParenthesis) Then
            If tm.CurrentToken <> KS.RParenthesis Then
                m_AttributeArguments = ParseAttributeArguments(result)
                If m_AttributeArguments Is Nothing Then Helper.ErrorRecoveryNotImplemented()
            End If
            If tm.AcceptIfNotError(KS.RParenthesis) = False Then Helper.ErrorRecoveryNotImplemented()
        End If

        result.Init(m_IsAssembly, m_IsModule, m_SimpleTypeName, m_AttributeArguments)

        Return result
    End Function

    ''' <summary>
    ''' AttributeArguments  ::=	
    '''     AttributePositionalArgumentList  |
    ''' 	AttributePositionalArgumentList  ,  VariablePropertyInitializerList  |
    '''	    VariablePropertyInitializerList
    '''
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseAttributeArguments(ByVal Parent As ParsedObject) As AttributeArguments
        Dim result As New AttributeArguments(Parent)

        Dim m_AttributePositionalArgumentList As New AttributePositionalArgumentList(result)
        Dim m_VariablePropertyInitializerList As New VariablePropertyInitializerList(result)

        If AttributePositionalArgumentList.CanBeMe(tm) Then
            Do
                Dim newObject As AttributeArgumentExpression
                newObject = ParseAttributeArgumentExpression(Parent)
                If newObject Is Nothing Then
                    Helper.ErrorRecoveryNotImplemented()
                End If
                m_AttributePositionalArgumentList.Add(newObject)

                If tm.CurrentToken = KS.Comma Then
                    Dim current As RestorablePoint = tm.GetRestorablePoint
                    tm.NextToken()
                    If AttributePositionalArgumentList.CanBeMe(tm) = False Then
                        tm.RestoreToPoint(current)
                        Exit Do
                    Else
                        tm.RestoreToPoint(current)
                    End If
                End If
            Loop While tm.Accept(KS.Comma)
        End If

        If m_AttributePositionalArgumentList.Count = 0 OrElse tm.Accept(KS.Comma) Then
            If ParseList(Of VariablePropertyInitializer)(m_VariablePropertyInitializerList, New ParseDelegate_Parent(Of VariablePropertyInitializer)(AddressOf ParseVariablePropertyInitializer), result) = False Then
                Helper.ErrorRecoveryNotImplemented()
            End If
        End If

        result.Init(m_AttributePositionalArgumentList, m_VariablePropertyInitializerList)

        Return result
    End Function

    ''' <summary>
    ''' Parses lists of type List ::= Item | List "," Item
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseList(Of T)(ByVal List As BaseList(Of T), ByVal ParseMethod As ParseDelegate_Parent(Of T), ByVal Parent As ParsedObject) As Boolean
        Helper.Assert(List IsNot Nothing, "List was nothing, tm.CurrentToken=" & tm.CurrentToken.Location.ToString(Compiler))
        Do
            Dim newObject As T
            newObject = ParseMethod(Parent)
            If newObject Is Nothing Then
                Return False
            End If
            List.Add(newObject)
        Loop While tm.Accept(KS.Comma)
        Return True
    End Function

    Private Delegate Function ParseDelegate_Parent(Of T)(ByVal Parent As ParsedObject) As T

    ''' <summary>
    ''' VariablePropertyInitializer  :: IdentifierOrKeyword  ":="  AttributeArgumentExpression
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseVariablePropertyInitializer(ByVal Parent As ParsedObject) As VariablePropertyInitializer
        Dim result As New VariablePropertyInitializer(Parent)

        Dim m_IdentifierOrKeyword As IdentifierOrKeyword
        Dim m_AttributeArgumentExpression As AttributeArgumentExpression

        m_IdentifierOrKeyword = ParseIdentifierOrKeyword(result)
        If m_IdentifierOrKeyword Is Nothing Then Helper.ErrorRecoveryNotImplemented()

        tm.AcceptIfNotInternalError(KS.Colon)
        tm.AcceptIfNotInternalError(KS.Equals)

        m_AttributeArgumentExpression = ParseAttributeArgumentExpression(result)
        If m_AttributeArgumentExpression Is Nothing Then Helper.ErrorRecoveryNotImplemented()

        result.Init(m_IdentifierOrKeyword, m_AttributeArgumentExpression)

        Return result
    End Function

    Private Function ParseIdentifierOrKeyword(ByVal Parent As ParsedObject) As IdentifierOrKeyword
        Dim result As IdentifierOrKeyword

        If tm.CurrentToken.IsIdentifierOrKeyword Then
            result = New IdentifierOrKeyword(Parent, tm.CurrentToken)
            tm.NextToken()
        Else
            Helper.AddError()
            result = Nothing
        End If

        Return result
    End Function

    ''' <summary>
    ''' AttributeArgumentExpression  ::=
    '''   ConstantExpression  |
    '''   GetTypeExpression  |
    '''   ArrayCreationExpression
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseAttributeArgumentExpression(ByVal Parent As ParsedObject) As AttributeArgumentExpression
        Dim result As New AttributeArgumentExpression(Parent)

        Dim m_Expression As Expression

        If tm.CurrentToken = KS.GetType Then
            m_Expression = ParseGetTypeExpression(result)
        ElseIf tm.CurrentToken = KS.[New] Then
            m_Expression = ParseArrayCreationExpression(result)
        Else
            m_Expression = ParseExpression(result)
        End If

        result.Init(m_Expression)

        Return result
    End Function



    ''' <summary>
    ''' Type | QualifiedIdentifier ( Of [TypeArityList] )
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseGetTypeTypeName(ByVal Parent As GetTypeExpression) As GetTypeTypeName
        'TypeName |
        'QualifiedIdentifier (Of [TypeArityList])
        'TypeArityList ::=
        ' , |
        ' TypeParameterList ,
        Dim result As New GetTypeTypeName(Parent)

        'First try to parse as typename, if no 
        'success try as qualifiedidentifier.
        Dim m_TypeName As TypeName
        Dim iCurPos As RestorablePoint = tm.GetRestorablePoint

        m_TypeName = ParseTypeName(result)
        If m_TypeName Is Nothing Then
            tm.RestoreToPoint(iCurPos)

            Dim qn As QualifiedIdentifier

            qn = ParseQualifiedIdentifier(result)
            If qn Is Nothing Then Helper.ErrorRecoveryNotImplemented()

            tm.AcceptIfNotInternalError(KS.LParenthesis)
            tm.AcceptIfNotError(KS.Of)

            Dim typeArity As Integer = 1
            Do While tm.Accept(KS.Comma)
                typearity += 1
            Loop

            tm.AcceptIfNotError(KS.RParenthesis)

            result.Init(qn, typeArity)
        Else
            tm.IgnoreRestoredPoint()
            result.Init(m_TypeName)
        End If

        Return result
    End Function

    ''' <summary>
    ''' ArrayCreationExpression    ::= "New" NonArrayTypeName ArraySizeInitializationModifier ArrayElementInitializer
    ''' 
    ''' LAMESPEC? I think the following should be used:
    ''' ArrayCreationExpression    ::= "New" NonArrayTypeName ArrayNameModifier ArrayElementInitializer
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseArrayCreationExpression(ByVal Parent As ParsedObject) As ArrayCreationExpression
        Dim result As New ArrayCreationExpression(Parent)

        Dim m_ArrayElementInitializer As ArrayElementInitializer
        Dim m_NonArrayTypeName As NonArrayTypeName
        Dim m_ArrayNameModifier As ArrayNameModifier

        tm.AcceptIfNotInternalError(KS.[New])

        m_NonArrayTypeName = ParseNonArrayTypeName(result)

        If tm.CurrentToken <> KS.LParenthesis Then
            If ShowErrors Then tm.AcceptIfNotError(KS.LParenthesis)
            Return Nothing
        End If
        If ArrayNameModifier.CanBeMe(tm) = False Then