parser(statements).vb

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

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

Partial Public Class Parser

    ''' <summary>
    ''' LabelDeclarationStatement  ::=  LabelName  ":"
    ''' LabelName  ::=  Identifier  |  IntLiteral
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseLabelDeclarationStatement(ByVal Parent As ParsedObject) As LabelDeclarationStatement
        Dim m_Label As Token

        If tm.CurrentToken.IsIdentifier OrElse tm.CurrentToken.IsIntegerLiteral Then
            m_Label = tm.CurrentToken
            tm.NextToken()
        Else
            Throw New InternalException(Parent)
        End If

        If tm.CurrentToken.Equals(KS.Colon) = False Then
            Throw New InternalException(parent)
        End If

        If tm.PeekToken.IsEndOfLineOnly Then
            tm.NextToken()
        End If

        Return New LabelDeclarationStatement(Parent, m_Label)
    End Function

    ''' <summary>
    ''' ThrowStatement  ::= "Throw" [  Expression  ]  StatementTerminator
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseThrowStatement(ByVal Parent As ParsedObject) As ThrowStatement
        Dim result As New ThrowStatement(Parent)

        Dim m_Exception As Expression

        tm.AcceptIfNotInternalError(KS.Throw)

        If tm.CurrentToken.IsEndOfStatement = False Then
            m_Exception = ParseExpression(result)
            If m_Exception Is Nothing Then Helper.ErrorRecoveryNotImplemented()
        Else
            m_Exception = Nothing
        End If

        result.Init(m_Exception)

        Return result
    End Function

    Private Function ParseStopStatement(ByVal Parent As ParsedObject) As StopStatement
        tm.AcceptIfNotInternalError(KS.Stop)

        Return New StopStatement(Parent)
    End Function

    Private Function ParseResumeStatement(ByVal Parent As ParsedObject) As ResumeStatement
        Dim m_IsResumeNext As Boolean

        tm.AcceptIfNotInternalError(KS.Resume)
        m_IsResumeNext = tm.Accept(KS.Next)

        Return New ResumeStatement(Parent, m_IsResumeNext)
    End Function

    ''' <summary>
    ''' RedimStatement  ::= "ReDim" [ "Preserve" ]  RedimClauses  StatementTerminator
    ''' RedimClauses  ::=
    '''	   RedimClause  |
    '''	   RedimClauses  ","  RedimClause
    ''' RedimClause  ::=  Expression  ArraySizeInitializationModifier
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseReDimStatement(ByVal Parent As ParsedObject) As ReDimStatement
        Dim result As New ReDimStatement(Parent)

        Dim m_IsPreserve As Boolean
        Dim m_Clauses As RedimClauses

        tm.AcceptIfNotInternalError(KS.ReDim)
        If tm.CurrentToken.Equals("Preserve") Then
            m_IsPreserve = True
            tm.NextToken()
        End If

        m_Clauses = ParseRedimClauses(result)
        If m_Clauses Is Nothing Then Helper.ErrorRecoveryNotImplemented()

        result.Init(m_IsPreserve, m_Clauses)

        Return result
    End Function

    ''' <summary>
    ''' OnErrorStatement  ::=  "On" "Error" ErrorClause  StatementTerminator
    ''' ErrorClause  ::=
    '''	   "GoTo"  "-"  "1" |
    '''	   "GoTo"  "0"  |
    '''	   GotoStatement  |
    '''	   "Resume" "Next"
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseOnErrorStatement(ByVal Parent As ParsedObject) As OnErrorStatement
        Dim m_IsResumeNext As Boolean
        Dim m_Label As Token = Nothing
        Dim m_IsGotoMinusOne As Boolean
        Dim m_IsGotoZero As Boolean

        tm.AcceptIfNotInternalError(KS.On)
        If tm.Accept(KS.Error) = False Then Helper.ErrorRecoveryNotImplemented()
        If tm.Accept(KS.Resume) Then
            If tm.Accept(KS.Next) = False Then Helper.ErrorRecoveryNotImplemented()
            m_IsResumeNext = True
        Else
            If tm.Accept(KS.GoTo) = False Then Helper.ErrorRecoveryNotImplemented()
            If tm.CurrentToken.IsIntegerLiteral Then
                If tm.CurrentToken.IntegralLiteral = 0 Then
                    m_IsGotoZero = True
                Else
                    m_Label = tm.CurrentToken
                End If
                tm.NextToken()
            ElseIf tm.CurrentToken = KS.Minus AndAlso tm.PeekToken.IsIntegerLiteral Then
                If tm.PeekToken.IntegralLiteral = 1 Then
                    m_IsGotoMinusOne = True
                    tm.NextToken(2)
                Else
                    Helper.ErrorRecoveryNotImplemented()
                    Compiler.Report.ShowMessage(Messages.VBNC90011, "-1")
                End If
            ElseIf tm.CurrentToken.IsIdentifier Then
                m_Label = tm.CurrentToken
                tm.NextToken()
            Else
                Helper.ErrorRecoveryNotImplemented()
                Compiler.Report.ShowMessage(Messages.VBNC30203)
                Return Nothing
            End If
        End If

        Return New OnErrorStatement(Parent, m_IsResumeNext, m_Label, m_IsGotoMinusOne, m_IsGotoZero)
    End Function


    ''' <summary>
    ''' GotoStatement  ::=  "GoTo" LabelName  StatementTerminator
    ''' LabelName ::= Identifier | IntLiteral
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseGotoStatement(ByVal Parent As ParsedObject) As GotoStatement
        Dim m_GotoWhere As Token

        tm.AcceptIfNotInternalError(KS.GoTo)
        If tm.CurrentToken.IsIdentifier OrElse tm.CurrentToken.IsIntegerLiteral Then
            m_GotoWhere = tm.CurrentToken
            tm.NextToken()
        Else
            Return Nothing
        End If

        Return New GotoStatement(Parent, m_GotoWhere)
    End Function

    ''' <summary>
    ''' ExitStatement  ::=  "Exit" ExitKind  StatementTerminator
    ''' ExitKind  ::=  "Do" | "For" | "While" | "Select" | "Sub" | "Function" | "Property" | "Try"
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseExitStatement(ByVal Parent As ParsedObject) As ExitStatement
        Dim m_ExitWhat As KS

        tm.AcceptIfNotInternalError(KS.Exit)
        If tm.CurrentToken.Equals(KS.Sub, KS.Function, KS.Property, KS.Do, KS.For, KS.Try, KS.While, KS.Select) Then
            m_ExitWhat = tm.CurrentToken.Keyword
            tm.NextToken()
        Else
            Compiler.Report.ShowMessage(Messages.VBNC30240)
            Return Nothing
        End If

        Return New ExitStatement(Parent, m_ExitWhat)
    End Function

    ''' <summary>
    ''' EndStatement  ::= "End" StatementTerminator
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseEndStatement(ByVal Parent As ParsedObject) As EndStatement
        tm.AcceptIfNotInternalError(KS.End)
        Return New EndStatement(Parent)
    End Function

    ''' <summary>
    '''ContinueStatement  ::=  "Continue" ContinueKind  StatementTerminator
    '''ContinueKind  ::=  "Do" | "For" | "While"
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseContinueStatement(ByVal Parent As ParsedObject, ByVal IsOneLiner As Boolean) As ContinueStatement
        Dim result As New ContinueStatement(Parent)

        Dim m_ContinueWhat As KS

        tm.AcceptIfNotInternalError(KS.Continue)
        If tm.CurrentToken.Equals(KS.Do, KS.For, KS.While) Then
            m_ContinueWhat = tm.CurrentToken.Keyword
            tm.NextToken()
        Else
            Compiler.Report.ShowMessage(Messages.VBNC30781)
            Return Nothing
        End If

        result.Init(m_ContinueWhat)

        Return result
    End Function

    ''' <summary>
    ''' EraseStatement  ::= "Erase" EraseExpressions  StatementTerminator
    ''' EraseExpressions  ::=
    '''	  Expression  |
    '''	  EraseExpressions  ,  Expression
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseEraseStatement(ByVal Parent As ParsedObject) As EraseStatement
        Dim result As New EraseStatement(Parent)

        Dim m_Targets As ExpressionList

        tm.AcceptIfNotInternalError(KS.Erase)

        m_Targets = ParseExpressionList(Parent)
        If m_Targets Is Nothing Then Helper.ErrorRecoveryNotImplemented()

        result.Init(m_Targets)

        Return result
    End Function

    Private Function ParseReturnStatement(ByVal Parent As ParsedObject) As ReturnStatement
        Dim result As New ReturnStatement(Parent)

        Dim m_Expression As Expression

        tm.AcceptIfNotInternalError(KS.Return)
        If Not tm.CurrentToken.IsEndOfStatement Then
            m_Expression = ParseExpression(result)
            If m_Expression Is Nothing Then Helper.ErrorRecoveryNotImplemented()
        Else
            m_Expression = Nothing
        End If

        result.Init(m_Expression)

        Return result
    End Function

    Private Function ParseRedimClauses(ByVal Parent As ReDimStatement) As RedimClauses
        Dim result As New RedimClauses(Parent)
        If ParseList(Of RedimClause)(result, New ParseDelegate_Parent(Of RedimClause)(AddressOf ParseRedimClause), Parent) = False Then
            Helper.ErrorRecoveryNotImplemented()
        End If
        Return result
    End Function

    ''' <summary>
    ''' RedimClause  ::=  Expression  ArraySizeInitializationModifier
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseRedimClause(ByVal Parent As ParsedObject) As RedimClause
        Dim result As New RedimClause(Parent)

        Dim m_Expression As Expression
        Dim m_ArgumentList As ArgumentList

        Dim tmpExpression As Expression = Nothing
        tmpExpression = ParseExpression(result)
        If tmpExpression Is Nothing Then Helper.ErrorRecoveryNotImplemented()

        Dim invExpression As InvocationOrIndexExpression = TryCast(tmpExpression, InvocationOrIndexExpression)
        If invExpression IsNot Nothing Then
            m_Expression = invExpression.Expression
            m_ArgumentList = invExpression.ArgumentList
        Else
            Helper.NotImplemented()
            Return Nothing
        End If

        result.Init(m_Expression, m_ArgumentList)

        Return result
    End Function

    ''' <summary>
    ''' ErrorStatement  ::=  "Error" Expression  StatementTerminator
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseErrorStatement(ByVal Parent As ParsedObject) As ErrorStatement
        Dim result As New ErrorStatement(Parent)

        Dim m_ErrNumber As Expression

        tm.AcceptIfNotInternalError(KS.Error)

        m_ErrNumber = ParseExpression(result)
        If m_ErrNumber Is Nothing Then Helper.ErrorRecoveryNotImplemented()

        result.Init(m_ErrNumber)

        Return result
    End Function

    ''' <summary>
    ''' MidAssignmentStatement  ::=
    '''	   "Mid" [ "$" ]  "("  Expression "," Expression  [ "," Expression  ] ")"  =  Expression  
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseMidAssignmentStatement(ByVal Parent As ParsedObject, ByVal IsOneLiner As Boolean) As MidAssignStatement
        Dim result As New MidAssignStatement(Parent)

        Dim m_Target As Expression
        Dim m_Start As Expression
        Dim m_Length As Expression
        Dim m_Source As Expression

        tm.AcceptIfNotInternalError("Mid")

        If tm.AcceptIfNotError(KS.LParenthesis) = False Then Helper.ErrorRecoveryNotImplemented()

        m_Target = ParseExpression(result)
        If m_Target Is Nothing Then Helper.ErrorRecoveryNotImplemented()

        If tm.AcceptIfNotError(KS.Comma) = False Then Helper.ErrorRecoveryNotImplemented()

        m_Start = ParseExpression(result)
        If m_Start Is Nothing Then Helper.ErrorRecoveryNotImplemented()

        If tm.Accept(KS.Comma) Then
            m_Length = ParseExpression(result)
            If m_Length Is Nothing Then Helper.ErrorRecoveryNotImplemented()
        Else
            m_Length = Nothing
        End If

        If tm.AcceptIfNotError(KS.RParenthesis) = False Then Helper.ErrorRecoveryNotImplemented()
        If tm.Accept(KS.Equals) = False Then Helper.ErrorRecoveryNotImplemented()

        m_Source = ParseExpression(result)
        If m_Source Is Nothing Then Helper.ErrorRecoveryNotImplemented()

        result.Init(m_Target, m_Start, m_Length, m_Source)

        Return result
    End Function
    ''' <summary>
    ''' WhileStatement  ::=
    '''	   "While" BooleanExpression  StatementTerminator
    '''	         [  Block  ]
    '''	   "End" "While" StatementTerminator
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseWhileStatement(ByVal Parent As ParsedObject, ByVal IsOneLiner As Boolean) As WhileStatement
        Dim result As New WhileStatement(Parent)