parser(statements).vb

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

        Dim m_Condition As Expression
        Dim m_Code As CodeBlock

        tm.AcceptIfNotInternalError(KS.While)
        m_Condition = ParseExpression(result)
        If m_Condition Is Nothing Then Helper.ErrorRecoveryNotImplemented()

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

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

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

        result.Init(m_Condition, m_Code)

        Return result
    End Function

    ''' <summary>
    ''' WithStatement  ::=
    '''	   "With" Expression  StatementTerminator
    '''	        [  Block  ]
    '''	   "End" "With" StatementTerminator
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseWithStatement(ByVal Parent As ParsedObject, ByVal IsOneLiner As Boolean) As WithStatement
        Dim result As New WithStatement(Parent)

        Dim m_WithExpression As Expression
        Dim m_Code As CodeBlock

        tm.AcceptIfNotInternalError(KS.With)

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

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

        If m_Code Is Nothing Then Helper.ErrorRecoveryNotImplemented()

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

        result.Init(m_Code, m_WithExpression)

        Return result
    End Function

    ''' <summary>
    ''' Homebrew:
    ''' UsingDeclarator ::= 
    '''  Identifier  [  As  [  New  ]  NonArrayTypeName  [  (  ArgumentList  )  ]  ]  |
    '''  Identifier  [  As  NonArrayTypeName  ]  [  =  VariableInitializer  ]
    '''
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseUsingDeclarator(ByVal Parent As ParsedObject) As UsingDeclarator
        Dim result As New UsingDeclarator(Parent)

        Dim m_Identifier As Token = Nothing
        Dim m_IsNew As Boolean
        Dim m_IsVariableDeclaration As Boolean
        Dim m_TypeName As NonArrayTypeName
        Dim m_VariableInitializer As VariableInitializer = Nothing
        Dim m_ArgumentList As ArgumentList = Nothing
        Dim m_VariableDeclaration As VariableDeclaration

        If tm.AcceptIdentifier(m_Identifier) = False Then Helper.ErrorRecoveryNotImplemented()

        If tm.Accept(KS.As) Then
            m_IsVariableDeclaration = True
            m_IsNew = tm.Accept(KS.[New])

            m_TypeName = ParseNonArrayTypeName(result)

            If m_IsNew = False Then
                If tm.Accept(KS.Equals) Then
                    m_VariableInitializer = ParseVariableInitializer(result)
                End If
            Else
                If tm.Accept(KS.LParenthesis) Then
                    If tm.Accept(KS.RParenthesis) = False Then
                        m_ArgumentList = ParseArgumentList(result)
                        If tm.AcceptIfNotError(KS.RParenthesis) = False Then Helper.ErrorRecoveryNotImplemented()
                    End If
                End If
                If m_ArgumentList Is Nothing Then m_ArgumentList = New ArgumentList(result)
            End If

            m_VariableDeclaration = New VariableDeclaration(result, Nothing, m_Identifier, m_IsNew, m_TypeName, m_VariableInitializer, m_ArgumentList)
        Else
            m_VariableDeclaration = Nothing
            m_VariableInitializer = Nothing
            m_ArgumentList = Nothing
            m_TypeName = Nothing
        End If


        result.Init(m_Identifier, m_IsNew, m_TypeName, m_ArgumentList, m_VariableInitializer, m_IsVariableDeclaration, m_VariableDeclaration)

        Return result
    End Function

    ''' <summary>
    ''' UsingStatement  ::=
    '''	"Using" UsingResources  StatementTerminator
    '''		[  Block  ]
    '''	"End" "Using" StatementTerminator
    ''' 
    ''' UsingResources  ::=  VariableDeclarators  |  Expression
    ''' 
    ''' LAMESPEC!?
    ''' I'm using this:
    ''' UsingResources ::= UsingDeclarators | Expression
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseUsingStatement(ByVal Parent As ParsedObject, ByVal IsOneLiner As Boolean) As UsingStatement
        Dim result As New UsingStatement(Parent)

        Dim m_UsingResources As ParsedObject
        Dim m_Code As CodeBlock

        tm.AcceptIfNotInternalError(KS.Using)

        Dim newDecls As UsingDeclarators = Nothing
        If tm.CurrentToken.IsIdentifier AndAlso tm.PeekToken.Equals(KS.Equals, KS.As) Then
            'This is a variable declaration
            newDecls = New UsingDeclarators(result)
            If ParseList(Of UsingDeclarator)(newDecls, New ParseDelegate_Parent(Of UsingDeclarator)(AddressOf ParseUsingDeclarator), result) = False Then
                Helper.ErrorRecoveryNotImplemented()
            End If
            m_UsingResources = newDecls
        Else
            'This is an expression
            Dim exp As Expression = Nothing
            exp = ParseExpression(result)
            If exp Is Nothing Then Helper.ErrorRecoveryNotImplemented()
            m_UsingResources = exp
        End If

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

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

        If newDecls IsNot Nothing Then
            For Each decl As UsingDeclarator In newDecls
                If decl.IsVariableDeclaration Then
                    m_Code.Variables.Add(decl.VariableDeclaration)
                End If
            Next
        End If

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

        result.Init(m_UsingResources, m_Code)

        Return result
    End Function

    ''' <summary>
    '''SyncLockStatement  ::=
    '''	"SyncLock" Expression  StatementTerminator
    '''	   [  Block  ]
    '''	"End" "SyncLock" StatementTerminator
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseSyncLockStatement(ByVal Parent As ParsedObject, ByVal IsOneLiner As Boolean) As SyncLockStatement
        Dim result As New SyncLockStatement(Parent)

        Dim m_Lock As Expression
        Dim m_Code As CodeBlock

        tm.AcceptIfNotInternalError(KS.SyncLock)

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

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

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

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

        result.Init(m_Lock, m_Code)

        Return result
    End Function

    Private Function ParseDoStatementCondition(ByVal Parent As ParsedObject, ByRef IsWhile As Boolean) As Expression
        Dim result As Expression = Nothing

        If tm.Accept(KS.While) Then
            IsWhile = True
            result = ParseExpression(Parent)
        ElseIf tm.Accept(KS.Until) Then
            IsWhile = False
            result = ParseExpression(Parent)
        Else
            Throw New InternalException(result)
        End If
        If result Is Nothing Then Helper.ErrorRecoveryNotImplemented()

        Return result
    End Function

    ''' <summary>
    ''' DoLoopStatement  ::=  DoTopLoopStatement  |  DoBottomLoopStatement
    ''' DoTopLoopStatement  ::=
    '''	   "Do" [  WhileOrUntil  BooleanExpression  ]  StatementTerminator
    '''	       [  Block  ]
    '''	   "Loop" StatementTerminator
    ''' DoBottomLoopStatement  ::=
    '''	   "Do" StatementTerminator
    '''	       [  Block  ]
    '''	   "Loop" WhileOrUntil  BooleanExpression  StatementTerminator
    '''WhileOrUntil  ::= "While" | "Until"
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseDoStatement(ByVal Parent As ParsedObject, ByVal IsOneLiner As Boolean) As DoStatement
        Dim result As New DoStatement(Parent)

        Dim m_PreCondition As Expression
        Dim m_PostCondition As Expression
        Dim m_IsWhile As Boolean
        Dim m_Code As CodeBlock

        tm.AcceptIfNotInternalError(KS.Do)
        If tm.CurrentToken.Equals(KS.While, KS.Until) Then
            m_PreCondition = ParseDoStatementCondition(result, m_IsWhile)
            If m_PreCondition Is Nothing Then Helper.NotImplemented()
        Else
            m_PreCondition = Nothing
        End If

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

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

        If tm.AcceptIfNotError(KS.Loop) = False Then Helper.ErrorRecoveryNotImplemented()
        If tm.CurrentToken.Equals(KS.While, KS.Until) Then
            m_PostCondition = ParseDoStatementCondition(result, m_IsWhile)
            If m_PostCondition Is Nothing Then Helper.NotImplemented()
        Else
            m_PostCondition = Nothing
        End If

        result.Init(m_PreCondition, m_PostCondition, m_IsWhile, m_Code)

        If m_PreCondition IsNot Nothing AndAlso m_PostCondition IsNot Nothing Then
            'helper.AddError "error BC30238: 'Loop' cannot have a condition if matching 'Do' has one."
            Compiler.Report.ShowMessage(Messages.VBNC30238)
            result.HasErrors = True
        End If

        Return result
    End Function

    ''' <summary>
    '''TryStatement  ::=
    '''	"Try" StatementTerminator
    '''	   [  Block  ]
    '''	[  CatchStatement+  ]
    '''	[  FinallyStatement  ]
    '''	"End" "Try" StatementTerminator
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseTryStatement(ByVal Parent As ParsedObject, ByVal IsOneLiner As Boolean) As TryStatement
        Dim result As New TryStatement(Parent)

        Dim m_TryCode As CodeBlock
        Dim m_FinallyBlock As CodeBlock
        Dim m_Catches As BaseObjects(Of CatchStatement)

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

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

        m_Catches = New BaseObjects(Of CatchStatement)(result)
        While tm.CurrentToken = KS.Catch
            Dim newCatch As CatchStatement
            newCatch = ParseCatchStatement(result, IsOneLiner)
            m_Catches.Add(newCatch)
        End While

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

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

        result.Init(m_Catches, m_TryCode, m_FinallyBlock)

        Return result
    End Function

    ''' <summary>
    ''' CatchStatement  ::=
    '''	   "Catch" [  Identifier "As" NonArrayTypeName  ]  [ "When" BooleanExpression  ]  StatementTerminator
    '''	      [  Block  ]
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseCatchStatement(ByVal Parent As ParsedObject, ByVal IsOneLiner As Boolean) As CatchStatement
        Dim result As New CatchStatement(Parent)

        Dim m_Code As CodeBlock
        Dim m_Variable As Token = Nothing
        Dim m_When As Expression = Nothing
        Dim m_TypeName As NonArrayTypeName = Nothing

        tm.AcceptIfNotInternalError(KS.Catch)

        If tm.AcceptEndOfStatement(IsOneLiner) = False Then
            If tm.AcceptIdentifier(m_Variable) Then
                If tm.AcceptIfNotError(KS.As) = False Then Helper.ErrorRecoveryNotImplemented()
                m_TypeName = ParseNonArrayTypeName(result)
                If m_TypeName Is Nothing Then Helper.ErrorRecoveryNotImplemented()
            End If
            If tm.Accept(KS.When) Then
                m_When = ParseExpression(result)
                If m_When Is Nothing Then Helper.ErrorRecoveryNotImplemented()
            End If
            If tm.AcceptEndOfStatement(IsOneLiner, True) = False Then Helper.ErrorRecoveryNotImplemented()
        End If

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

        result.Init(m_Variable, m_TypeName, m_When, m_Code)

        Return result
    End Function
    ''' <summary>
    ''' IfStatement  ::=  BlockIfStatement  |  LineIfThenStatement
    ''' BlockIfStatement  ::=
    '''	   "If" BooleanExpression  [ "Then" ]  StatementTerminator
    '''	        [  Block  ]
    '''	   [  ElseIfStatement+  ]
    '''	   [  ElseStatement  ]
    '''	   "End" "If" StatementTerminator
    ''' ElseIfStatement  ::=
    '''	   "ElseIf" BooleanExpression  [ "Then" ]  StatementTerminator
    '''	        [  Block  ]
    ''' ElseStatement  ::=
    '''	   "Else" StatementTerminator
    '''	        [  Block  ]
    ''' LineIfThenStatement  ::=
    '''	   "If" BooleanExpression "Then" Statements  [ "Else" Statements  ]  StatementTerminator
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseIfStatement(ByVal Parent As ParsedObject, ByVal IsOneLiner As Boolean) As IfStatement
        Dim result As New IfStatement(Parent)

        Dim m_Condition As Expression
        Dim m_TrueCode As CodeBlock
        Dim m_FalseCode As CodeBlock
        Dim m_OneLiner As Boolean
        Dim m_ElseIfs As BaseObjects(Of ElseIfStatement)

        tm.AcceptIfNotInternalError(KS.If)
        m_Condition = ParseExpression(result)
        If m_Condition Is Nothing Then Helper.ErrorRecoveryNotImplemented()

        If tm.Accept(KS.Then) = False Then
            m_OneLiner = False 'Cannot be a oneliner if Then is not found.
            If IsOneLiner Then
                Helper.AddError("report error BC30081, 'if' must end with a matching 'end if'")
                tm.GotoNewline(False)
            Else
                tm.AcceptEndOfStatement(False, True)
            End If
        Else