parser(expressions).vb

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

        ace = ParseArrayCreationExpression(result)
        Me.m_ShowErrors = bShowingErrors

        If ace IsNot Nothing Then
            tm.IgnoreRestoredPoint()
            result.Init(ace)
        Else
            tm.RestoreToPoint(iCurrent)
            Dim doce As DelegateOrObjectCreationExpression
            doce = ParseDelegateOrObjectCreationExpression(result)
            If doce Is Nothing Then Helper.ErrorRecoveryNotImplemented()
            result.Init(doce)
        End If

        Return result
    End Function

    ''' <summary>
    ''' DelegateCreationExpression ::= "New" NonArrayTypeName "(" Expression ")"
    ''' ObjectCreationExpression   ::= "New" NonArrayTypeName [ "(" [ ArgumentList ] ")" ]
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseDelegateOrObjectCreationExpression(ByVal Parent As ParsedObject) As DelegateOrObjectCreationExpression
        Dim result As New DelegateOrObjectCreationExpression(Parent)

        Dim m_NonArrayTypeName As NonArrayTypeName = Nothing
        Dim m_ArgumentList As ArgumentList = Nothing

        tm.AcceptIfNotInternalError(KS.[New])
        m_NonArrayTypeName = ParseNonArrayTypeName(result)

        If tm.Accept(KS.LParenthesis) Then
            If tm.CurrentToken <> KS.RParenthesis Then
                m_ArgumentList = ParseArgumentList(result)
                If m_ArgumentList Is Nothing Then Helper.ErrorRecoveryNotImplemented()
            End If

            If tm.AcceptIfNotError(KS.RParenthesis) = False Then Helper.ErrorRecoveryNotImplemented()
        End If
        If m_ArgumentList Is Nothing Then m_ArgumentList = New ArgumentList(result)

        result.Init(m_NonArrayTypeName, m_ArgumentList)

        Return result
    End Function

    ''' <summary>
    ''' ArgumentList  ::=	PositionalArgumentList  ,  NamedArgumentList  |
    '''                     PositionalArgumentList  |
    '''	                    NamedArgumentList
    ''' 
    ''' PositionalArgumentList  ::=  Expression  |  PositionalArgumentList  ","  [  Expression  ]
    ''' 
    ''' NamedArgumentList  ::=  IdentifierOrKeyword  ":="  Expression  |  NamedArgumentList  ,  IdentifierOrKeyword  :=  Expression
    '''
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseArgumentList(ByVal Parent As ParsedObject) As ArgumentList
        Dim result As New ArgumentList(Parent)

        Dim m_Arguments As New Generic.List(Of Argument)

        'First parse positional arguments
        Do
            'Check for named argument.
            If NamedArgument.CanBeMe(tm) Then Exit Do

            Dim exp As Expression
            exp = Nothing

            If tm.CurrentToken.Equals(KS.Comma) = False Then
                exp = ParseExpression(result)
            End If

            Dim newPA As PositionalArgument
            newPA = New PositionalArgument(result, m_Arguments.Count, exp)
            m_Arguments.Add(newPA)
        Loop While tm.Accept(KS.Comma)

        'Then parse named arguments
        If NamedArgument.CanBeMe(tm) Then
            Do
                Dim newArgument As NamedArgument
                newArgument = ParseNamedArgument(result)
                m_Arguments.Add(newArgument)
            Loop While tm.Accept(KS.Comma)
        End If

        result.Init(m_Arguments)

        Return result
    End Function

    Private Function ParseNamedArgument(ByVal Parent As ParsedObject) As NamedArgument
        Dim result As New NamedArgument(Parent)
        Dim Name As String
        Dim Expression As Expression = Nothing

        If tm.CurrentToken.IsIdentifier Then
            Name = tm.CurrentToken.Identifier
        ElseIf tm.CurrentToken.IsKeyword Then
            Name = tm.CurrentToken.Identifier
        Else
            Throw New InternalException(result)
        End If
        tm.NextToken()
        tm.AcceptIfNotInternalError(KS.Colon)
        tm.AcceptIfNotInternalError(KS.Equals)

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


        result.Init(Name, Expression)

        Return result
    End Function

    Private Function ParseMyClassExpression(ByVal Parent As ParsedObject) As MyClassExpression
        Dim result As MyClassExpression

        tm.AcceptIfNotInternalError(KS.MyClass)
        result = New MyClassExpression(Parent)

        Return result
    End Function

    Private Function ParseMyBaseExpression(ByVal Parent As ParsedObject) As MyBaseExpression
        Dim result As MyBaseExpression

        tm.AcceptIfNotInternalError(KS.MyBase)
        result = New MyBaseExpression(Parent)

        Return result
    End Function

    Private Function ParseMeExpression(ByVal Parent As ParsedObject) As MeExpression
        Dim result As MeExpression

        tm.AcceptIfNotInternalError(KS.Me)
        result = New MeExpression(Parent)

        Return result
    End Function
    ''' <summary>
    ''' A single identifier followed by an optional type argument list.
    ''' 
    ''' SimpleNameExpression ::= Identifier [ "(" "Of" TypeArgumentList ")" ]
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseSimpleNameExpression(ByVal Parent As ParsedObject) As SimpleNameExpression
        Dim result As New SimpleNameExpression(Parent)

        Dim m_Identifier As Token = Nothing
        Dim m_TypeArgumentList As TypeArgumentList

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

        If tm.CurrentToken = KS.LParenthesis AndAlso tm.PeekToken = KS.Of Then
            m_TypeArgumentList = ParseTypeArgumentList(result)
            If m_TypeArgumentList Is Nothing Then Helper.ErrorRecoveryNotImplemented()
            'If tm.AcceptIfNotError(KS.RParenthesis) = False Then Helper.ErrorRecoveryNotImplemented()
        Else
            m_TypeArgumentList = Nothing
        End If

        result.Init(m_Identifier, m_TypeArgumentList)

        Return result
    End Function

    Private Function ParseCodeBlock(ByVal Parent As ParsedObject, ByVal IsOneLiner As Boolean) As CodeBlock
        Dim result As New CodeBlock(Parent)
        Dim breakloop As Boolean

        Do
            If IsOneLiner = False AndAlso LabelDeclarationStatement.CanBeMe(tm) Then
                Dim newLabel As LabelDeclarationStatement
                newLabel = ParseLabelDeclarationStatement(result)
                If newLabel Is Nothing Then Helper.ErrorRecoveryNotImplemented()
                result.AddStatement(newLabel)
                result.AddLabel(newLabel)
            ElseIf MidAssignStatement.IsMe(tm) Then
                Dim newMidAssign As MidAssignStatement
                newMidAssign = ParseMidAssignmentStatement(result, IsOneLiner)
                If newMidAssign Is Nothing Then Helper.ErrorRecoveryNotImplemented()
                result.AddStatement(newMidAssign)
            ElseIf tm.CurrentToken.IsIdentifier OrElse _
              tm.CurrentToken.Equals(KS.Dot, KS.Me, KS.MyClass, KS.MyBase) OrElse _
              tm.CurrentToken.Equals(Enums.BuiltInTypeTypeNames) OrElse _
              tm.CurrentToken.Equals(KS.Global) OrElse _
              tm.CurrentToken.Equals(KS.DirectCast, KS.TryCast, KS.CType) OrElse _
              tm.CurrentToken.Equals(KS.GetType) Then
                'Must appear after the label check.
                'Must appear before the symbol check.
                'Must appear before the keywords check
                Dim lside, rside As Expression

                lside = ParseExpression(New ExpressionParseInfo(result, True, False))
                If lside Is Nothing Then Helper.ErrorRecoveryNotImplemented()
                If tm.CurrentToken.IsSymbol Then
                    Select Case tm.CurrentToken.Symbol
                        Case KS.Equals
                            tm.NextToken()
                            Dim newStmt As New AssignmentStatement(result)
                            rside = ParseExpression(New ExpressionParseInfo(newStmt, False, False))
                            If rside Is Nothing Then Helper.ErrorRecoveryNotImplemented()
                            newStmt.Init(lside, rside)
                            result.AddStatement(newStmt)
                        Case KS.AddAssign
                            tm.NextToken()
                            Dim newStmt As New AddAssignStatement(result)
                            rside = ParseExpression(New ExpressionParseInfo(newStmt, False, False))
                            If rside Is Nothing Then Helper.ErrorRecoveryNotImplemented()
                            newStmt.Init(lside, rside)
                            result.AddStatement(newStmt)
                        Case KS.ConcatAssign
                            tm.NextToken()
                            Dim newStmt As New ConcatAssignStatement(result)
                            rside = ParseExpression(New ExpressionParseInfo(newStmt, False, False))
                            If rside Is Nothing Then Helper.ErrorRecoveryNotImplemented()
                            newStmt.Init(lside, rside)
                            result.AddStatement(newStmt)
                        Case KS.RealDivAssign
                            tm.NextToken()
                            Dim newStmt As New DivisionAssignStatement(result)
                            rside = ParseExpression(New ExpressionParseInfo(newStmt, False, False))
                            If rside Is Nothing Then Helper.ErrorRecoveryNotImplemented()
                            newStmt.Init(lside, rside)
                            result.AddStatement(newStmt)
                        Case KS.IntDivAssign
                            tm.NextToken()
                            Dim newStmt As New IntDivisionAssignStatement(result)
                            rside = ParseExpression(New ExpressionParseInfo(newStmt, False, False))
                            If rside Is Nothing Then Helper.ErrorRecoveryNotImplemented()
                            newStmt.Init(lside, rside)
                            result.AddStatement(newStmt)
                        Case KS.MultAssign
                            tm.NextToken()
                            Dim newStmt As New MultiplicationAssignStatement(result)
                            rside = ParseExpression(New ExpressionParseInfo(newStmt, False, False))
                            If rside Is Nothing Then Helper.ErrorRecoveryNotImplemented()
                            newStmt.Init(lside, rside)
                            result.AddStatement(newStmt)
                        Case KS.PowerAssign
                            tm.NextToken()
                            Dim newStmt As New PowerAssignStatement(result)
                            rside = ParseExpression(New ExpressionParseInfo(newStmt, False, False))
                            If rside Is Nothing Then Helper.ErrorRecoveryNotImplemented()
                            newStmt.Init(lside, rside)
                            result.AddStatement(newStmt)
                        Case KS.ShiftRightAssign
                            tm.NextToken()
                            Dim newStmt As New RShiftAssignStatement(result)
                            rside = ParseExpression(New ExpressionParseInfo(newStmt, False, False))
                            If rside Is Nothing Then Helper.ErrorRecoveryNotImplemented()
                            newStmt.Init(lside, rside)
                            result.AddStatement(newStmt)
                        Case KS.ShiftLeftAssign
                            tm.NextToken()
                            Dim newStmt As New LShiftAssignStatement(result)
                            rside = ParseExpression(New ExpressionParseInfo(newStmt, False, False))
                            If rside Is Nothing Then Helper.ErrorRecoveryNotImplemented()
                            newStmt.Init(lside, rside)
                            result.AddStatement(newStmt)
                        Case KS.MinusAssign
                            tm.NextToken()
                            Dim newStmt As New SubtractionAssignStatement(result)
                            rside = ParseExpression(New ExpressionParseInfo(newStmt, False, False))
                            If rside Is Nothing Then Helper.ErrorRecoveryNotImplemented()
                            newStmt.Init(lside, rside)
                            result.AddStatement(newStmt)
                        Case Else
                            Dim newStmt As New CallStatement(result)
                            newStmt.Init(lside)
                            result.AddStatement(newStmt)
                    End Select
                Else
                    Dim newStmt As New CallStatement(result)
                    newStmt.Init(lside)
                    result.AddStatement(newStmt)
                End If
            ElseIf tm.CurrentToken.IsKeyword Then
                Select Case tm.CurrentToken.Keyword
                    Case KS.Dim, KS.Static, KS.Const
                        Dim newVariables As Generic.List(Of VariableDeclaration)
                        newVariables = ParseLocalDeclarationStatement(result)
                        If newVariables Is Nothing Then Helper.ErrorRecoveryNotImplemented()
                        result.AddVariables(newVariables)
                    Case KS.SyncLock
                        Dim newLock As SyncLockStatement
                        newLock = ParseSyncLockStatement(result, IsOneLiner)
                        If newLock Is Nothing Then Helper.ErrorRecoveryNotImplemented()
                        result.AddStatement(newLock)
                    Case KS.Try
                        Dim newTry As TryStatement
                        newTry = ParseTryStatement(result, IsOneLiner)
                        If newTry Is Nothing Then Helper.ErrorRecoveryNotImplemented()
                        result.AddStatement(newTry)
                    Case KS.Throw
                        Dim newThrow As ThrowStatement
                        newThrow = ParseThrowStatement(result)
                        If newThrow Is Nothing Then Helper.ErrorRecoveryNotImplemented()
                        result.AddStatement(newThrow)
                    Case KS.With
                        Dim newWith As WithStatement
                        newWith = ParseWithStatement(result, IsOneLiner)
                        If newWith Is Nothing Then Helper.ErrorRecoveryNotImplemented()
                        result.AddStatement(newWith)
                    Case KS.Select
                        Dim newSelect As SelectStatement
                        newSelect = ParseSelectStatement(result, IsOneLiner)
                        If newSelect Is Nothing Then Helper.ErrorRecoveryNotImplemented()
                        result.AddStatement(newSelect)
                    Case KS.If
                        Dim newIf As IfStatement
                        newIf = ParseIfStatement(result, IsOneLiner)
                        If newIf Is Nothing Then Helper.ErrorRecoveryNotImplemented()
                        result.AddStatement(newIf)
                    Case KS.Do