parser(statements).vb

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

            If IsOneLiner = False Then
                m_OneLiner = Not tm.AcceptEndOfStatement(False, False)
            Else
                m_OneLiner = True
            End If
        End If

        m_TrueCode = ParseCodeBlock(result, m_OneLiner)
        If m_TrueCode Is Nothing Then Helper.ErrorRecoveryNotImplemented()

        m_ElseIfs = New BaseObjects(Of ElseIfStatement)(result)
        While tm.CurrentToken = KS.ElseIf OrElse (m_OneLiner = False AndAlso tm.CurrentToken = KS.Else AndAlso tm.PeekToken = KS.If)
            Dim newElseIf As ElseIfStatement
            newElseIf = ParseElseIfStatement(result, m_OneLiner)
            m_ElseIfs.Add(newElseIf)
        End While

        If tm.Accept(KS.Else) Then
            If m_OneLiner = False Then
                If tm.AcceptEndOfStatement(False, True) = False Then Helper.ErrorRecoveryNotImplemented()
            End If
            m_FalseCode = ParseCodeBlock(result, m_OneLiner)
            If m_FalseCode Is Nothing Then Helper.ErrorRecoveryNotImplemented()
        Else
            m_FalseCode = Nothing
        End If

        If m_OneLiner = False Then tm.AcceptIfNotError(KS.End_If)

        result.Init(m_Condition, m_FalseCode, m_TrueCode, m_OneLiner, m_ElseIfs)

        Return result
    End Function

    ''' <summary>
    ''' ElseIfStatement  ::=
    '''	   "ElseIf" BooleanExpression  [  Then  ]  StatementTerminator
    '''	        [  Block  ]
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseElseIfStatement(ByVal Parent As ParsedObject, ByVal IsOneLiner As Boolean) As ElseIfStatement
        Dim result As New ElseIfStatement(Parent)

        Dim m_Condition As Expression
        Dim m_Code As CodeBlock

        If tm.Accept(KS.Else) Then
            'This is not in the spec, but MS is accepting it anyway.
            'See test Bugs/aspnet2.vb for a test case.
            tm.AcceptIfNotInternalError(KS.If)
        Else
            tm.AcceptIfNotInternalError(KS.ElseIf)
        End If
        m_Condition = ParseExpression(result)
        If m_Condition Is Nothing Then Helper.ErrorRecoveryNotImplemented()
        'ElseIf cannot be a oneliner...
        tm.Accept(KS.Then) '"Then" is not required.
        If tm.AcceptEndOfStatement(, True) = False Then Helper.ErrorRecoveryNotImplemented()

        If IsOneLiner Then
            Helper.AddError()
            'TODO: Add error, 
        End If

        m_Code = ParseCodeBlock(result, IsOneLiner)
        If m_Code Is Nothing Then Helper.ErrorRecoveryNotImplemented()

        result.Init(m_Code, m_Condition)

        Return result
    End Function

    ''' <summary>
    ''' SelectStatement  ::=
    '''	   "Select" [ "Case" ]  Expression  StatementTerminator
    '''	        [  CaseStatement+  ]
    '''	        [  CaseElseStatement  ]
    '''	   "End" "Select" StatementTerminator
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseSelectStatement(ByVal Parent As ParsedObject, ByVal IsOneLiner As Boolean) As SelectStatement
        Dim result As New SelectStatement(Parent)

        Dim m_Test As Expression
        Dim m_Cases As BaseObjects(Of CaseStatement)

        tm.AcceptIfNotInternalError(KS.Select)

        tm.Accept(KS.Case) '"Case" is not required

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

        If tm.AcceptEndOfStatement(IsOneLiner, True) = False Then Helper.ErrorRecoveryNotImplemented()

        m_Cases = New BaseObjects(Of CaseStatement)(result)
        While tm.CurrentToken = KS.Case
            Dim newCase As CaseStatement
            newCase = ParseCaseStatement(result, IsOneLiner)
            m_Cases.Add(newCase)
        End While

        If tm.Accept(KS.End_Select) = False Then Helper.ErrorRecoveryNotImplemented()

        result.Init(m_Test, m_Cases)

        Return result
    End Function

    ''' <summary>
    ''' CaseStatement  ::=
    '''	   "Case" CaseClauses  StatementTerminator
    '''	        [  Block  ]
    ''' CaseElseStatement  ::=
    '''	   "Case" "Else" StatementTerminator
    '''	   [  Block  ]
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseCaseStatement(ByVal Parent As ParsedObject, ByVal IsOneLiner As Boolean) As CaseStatement
        Dim result As New CaseStatement(Parent)

        Dim m_IsElse As Boolean
        Dim m_Clauses As CaseClauses
        Dim m_Block As CodeBlock

        tm.AcceptIfNotInternalError(KS.Case)
        If tm.Accept(KS.Else) Then
            m_IsElse = True
            m_Clauses = Nothing
        Else
            m_Clauses = New CaseClauses(result)
            If ParseList(Of CaseClause)(m_Clauses, New ParseDelegate_Parent(Of CaseClause)(AddressOf ParseCaseClause), result) = False Then
                Helper.ErrorRecoveryNotImplemented()
            End If
        End If
        If tm.AcceptEndOfStatement(IsOneLiner, True) = False Then Helper.NotImplemented()

        m_Block = ParseCodeBlock(result, IsOneLiner)
        If m_Block Is Nothing Then Helper.NotImplemented()

        result.Init(m_IsElse, m_Clauses, m_Block)

        Return result
    End Function

    Private Function ParseCallStatement(ByVal Parent As ParsedObject) As CallStatement
        Dim result As New CallStatement(Parent)

        Dim m_Target As Expression
        tm.AcceptIfNotInternalError(KS.Call)
        m_Target = ParseExpression(result)

        result.Init(m_Target)

        Return result
    End Function

    ''' <summary>
    ''' ForEachStatement  ::=
    '''	   "For" "Each" LoopControlVariable "In" Expression  StatementTerminator
    '''	         [  Block  ]
    '''	   "Next" [Expression  ]  StatementTerminator
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseForEachStatement(ByVal Parent As ParsedObject, ByVal IsOneLiner As Boolean) As ForEachStatement
        Dim result As New ForEachStatement(Parent)

        Dim m_LoopControlVariable As LoopControlVariable
        Dim m_InExpression As Expression
        Dim m_NextExpression As Expression
        Dim m_Code As CodeBlock

        tm.AcceptIfNotInternalError(KS.For)
        tm.AcceptIfNotInternalError(KS.Each)

        m_LoopControlVariable = ParseLoopControlVariable(result)
        If m_LoopControlVariable Is Nothing Then Helper.ErrorRecoveryNotImplemented()

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

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

        If tm.AcceptEndOfStatement(, True) = False Then Helper.ErrorRecoveryNotImplemented()

        m_Code = ParseCodeBlock(result, IsOneLiner)
        If m_Code Is Nothing Then Helper.ErrorRecoveryNotImplemented()

        If tm.AcceptIfNotError(KS.Next) = False Then Helper.ErrorRecoveryNotImplemented()
        If tm.CurrentToken.IsEndOfStatement = False Then
            m_NextExpression = ParseExpression(result)
            If m_NextExpression Is Nothing Then Helper.ErrorRecoveryNotImplemented()
        Else
            m_NextExpression = Nothing
        End If

        result.Init(m_LoopControlVariable, m_InExpression, m_NextExpression, m_Code)

        Return result
    End Function

    ''' <summary>
    ''' ForStatement  ::=
    '''	   "For" LoopControlVariable  "="  Expression  "To"  Expression  [  "Step"  Expression  ]  StatementTerminator
    '''	      [ Block  ]
    '''	   "Next" [  NextExpressionList  ]  StatementTerminator
    ''' LoopControlVariable  ::=
    '''	   Identifier  [  ArrayNameModifier  ] "As" TypeName  |
    '''	   Expression
    ''' NextExpressionList  ::=
    '''	   Expression  |
    '''	   NextExpressionList "," Expression
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseForStatement(ByVal Parent As ParsedObject, ByVal IsOneLiner As Boolean) As ForStatement
        Dim result As New ForStatement(Parent)

        Dim m_LoopControlVariable As LoopControlVariable
        Dim m_LoopStartExpression As Expression
        Dim m_LoopEndExpression As Expression
        Dim m_LoopStepExpression As Expression
        Dim m_NextExpressionList As ExpressionList
        Dim m_Code As CodeBlock

        tm.AcceptIfNotInternalError(KS.For)
        m_LoopControlVariable = ParseLoopControlVariable(result)
        If m_LoopControlVariable Is Nothing Then Helper.ErrorRecoveryNotImplemented()

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

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

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

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

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

        If tm.AcceptEndOfStatement(, True) = False Then Helper.ErrorRecoveryNotImplemented()

        m_Code = ParseCodeBlock(result, IsOneLiner)
        If m_Code Is Nothing Then Helper.ErrorRecoveryNotImplemented()

        If tm.AcceptIfNotError(KS.Next) = False Then Helper.ErrorRecoveryNotImplemented()
        If tm.CurrentToken.IsEndOfStatement = False Then
            m_NextExpressionList = New ExpressionList(result)
            If ParseList(Of Expression)(m_NextExpressionList, New ParseDelegate_Parent(Of Expression)(AddressOf ParseExpression), result) = False Then
                Helper.ErrorRecoveryNotImplemented()
            End If
        Else
            m_NextExpressionList = Nothing
        End If

        result.Init(m_LoopControlVariable, m_LoopStartExpression, m_LoopEndExpression, m_LoopStepExpression, m_NextExpressionList, m_Code)

        Return result
    End Function

    Private Function ParseCaseClause(ByVal Parent As ParsedObject) As CaseClause
        Dim result As New CaseClause(Parent)

        Dim m_Expression1 As Expression
        Dim m_Expression2 As Expression = Nothing
        Dim m_Comparison As KS

        If tm.Accept(KS.Is) Then
            If tm.CurrentToken.Equals(CaseClause.RelationalOperators) = False Then
                Compiler.Report.ShowMessage(Messages.VBNC30239)
                m_Comparison = KS.Equals
            Else
                m_Comparison = tm.CurrentToken.Symbol
                tm.NextToken()
            End If
            m_Expression1 = ParseExpression(result)
            If m_Expression1 Is Nothing Then Helper.ErrorRecoveryNotImplemented()
        ElseIf tm.CurrentToken.Equals(CaseClause.RelationalOperators) Then
            m_Comparison = tm.CurrentToken.Symbol
            tm.NextToken()
            m_Expression1 = ParseExpression(result)
            If m_Expression1 Is Nothing Then Helper.ErrorRecoveryNotImplemented()
        Else
            m_Expression1 = ParseExpression(result)
            If m_Expression1 Is Nothing Then Helper.ErrorRecoveryNotImplemented()
            If tm.Accept(KS.To) Then
                m_Expression2 = ParseExpression(result)
                If m_Expression2 Is Nothing Then Helper.ErrorRecoveryNotImplemented()
            End If
        End If

        result.Init(m_Expression1, m_Expression2, m_Comparison)

        Return result
    End Function

    ''' <summary>
    ''' AddHandlerStatement  ::= "AddHandler" Expression  ,  Expression  StatementTerminator
    ''' RemoveHandlerStatement  ::= "RemoveHandler" Expression "," Expression  StatementTerminator
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseAddOrRemoveHandlerStatement(ByVal Parent As ParsedObject) As AddOrRemoveHandlerStatement
        Dim result As New AddOrRemoveHandlerStatement(Parent)

        Dim m_Event As Expression
        Dim m_EventHandler As Expression
        Dim m_IsAddHandler As Boolean

        If tm.Accept(KS.AddHandler) Then
            m_IsAddHandler = True
        ElseIf tm.Accept(KS.RemoveHandler) Then
            m_IsAddHandler = False
        Else
            Throw New InternalException(result)
        End If

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

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

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

        result.Init(m_Event, m_EventHandler, m_IsAddHandler)

        Return result
    End Function

    Private Function ParseImportsStatements(ByVal Parent As ParsedObject) As Generic.List(Of ImportsStatement)
        Dim result As New Generic.List(Of ImportsStatement)
        While ImportsStatement.IsMe(tm)
            Dim newI As ImportsStatement
            newI = ParseImportsStatement(Parent)
            result.Add(newI)
        End While
        Return result
    End Function

    ''' <summary>
    ''' ImportsStatement  ::=  "Imports" ImportsClauses  StatementTerminator
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseImportsStatement(ByVal Parent As ParsedObject) As ImportsStatement
        Dim result As New ImportsStatement(Parent)

        Dim m_Clauses As ImportsClauses

        tm.AcceptIfNotInternalError(KS.Imports)

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

        If tm.AcceptEndOfStatement(, True) = False Then Helper.ErrorRecoveryNotImplemented()

        result.Init(m_Clauses)

        Return result
    End Function

    ''' <summary>
    ''' Parses a imports statement as specified on the commandline.
    ''' </summary>
    ''' <param name="str"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Shared Function ParseImportsStatement(ByVal Parent As ImportsStatement, ByVal str As String) As Boolean
        Dim result As Boolean = True

        Helper.Assert(Parent IsNot Nothing)
        Helper.Assert(Parent.Clauses IsNot Nothing)

        result = ParseImportsClauses(Parent.Clauses, str) AndAlso result

        Return result
    End Function
End Class