scanner.vb

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

                    NextChar()
                    Result = NewToken(KS.Exclamation)
                Case "&"c
                    Select Case PeekChar()
#If EXTENDED Then
                        Case "b"c, "B"c, "h"c, "H"c, "o"c, "O"c, "d"c, "D"c
#Else
                        Case "h"c, "H"c, "o"c, "O"c, "d"c, "D"c
#End If
                            Result = GetNumber()
                        Case Else 'Not a number, but operator
                            NextChar()
                            EatWhiteSpace()
                            If CurrentChar() = "="c Then
                                Result = NewToken(KS.ConcatAssign)
                                NextChar()
                            Else
                                Result = NewToken(KS.Concat)
                            End If
                    End Select
                Case "*"c
                    NextChar()
                    EatWhiteSpace()
                    If (CurrentChar() = "="c) Then
                        NextChar()
                        Result = NewToken(KS.MultAssign)
                    Else
                        Result = NewToken(KS.Mult)
                    End If
                Case "+"c
                    NextChar()
                    EatWhiteSpace()
                    If (CurrentChar() = "="c) Then
                        NextChar()
                        Result = NewToken(KS.AddAssign)
                    Else
                        Result = NewToken(KS.Add)
                    End If
                Case "-"c
                    NextChar()
                    EatWhiteSpace()
                    If (CurrentChar() = "="c) Then
                        NextChar()
                        Result = NewToken(KS.MinusAssign)
                    Else
                        Result = NewToken(KS.Minus)
                    End If
                Case "^"c
                    NextChar()
                    EatWhiteSpace()
                    If (CurrentChar() = "="c) Then
                        NextChar()
                        Result = NewToken(KS.PowerAssign)
                    Else
                        Result = NewToken(KS.Power)
                    End If
                Case "\"c
                    NextChar()
                    EatWhiteSpace()
                    If (CurrentChar() = "="c) Then
                        NextChar()
                        Result = NewToken(KS.IntDivAssign)
                    Else
                        Result = NewToken(KS.IntDivision)
                    End If
                Case "#"c
                    'Type characters are already scanned when they appear after a literal. 
                    'If scanning gets here, it is not a type character.
                    If m_TokensSeenOnLine = 0 Then
                        Result = NewToken(KS.Numeral)
                        NextChar()
                    Else
                        Result = GetDate()
                    End If
                Case "/"c
#If SUPPORT_CSTYLE_COMMENTS Then
                    If (PeekChar() = "/"c OrElse PeekChar() = "*"c) Then 'Comment
                        EatComment()
                    Else 'Division
#End If
                        NextChar()
                        EatWhiteSpace()
                        If (CurrentChar() = "="c) Then
                            NextChar()
                            Result = NewToken(KS.RealDivAssign)
                        Else
                            Result = NewToken(KS.RealDivision)
                        End If
#If SUPPORT_CSTYLE_COMMENTS Then
                    End If
#End If
                Case " "c 'Space
                    NextChar()
                    If (CurrentChar() = "_"c) Then '
                        Dim i As Integer = 1
                        Do While IsWhiteSpace(PeekChars(i))
                            i += 1
                        Loop
                        If IsNewLine(PeekChars(i)) Then
                            NextChar()
                            EatWhiteSpace()
                            EatNewLine()
                        End If
                    End If
                Case nlTab ' Tab character
                    NextChar()
                Case Else
                    If IsWhiteSpace() Then
                        NextChar()
                    ElseIf CanStartIdentifier() Then
                        Result = GetIdentifier()
                        If Result.IsKeyword AndAlso Result.Equals(KS.[REM]) Then
                            EatLine(False)
                            Result = Nothing
                        End If
                    Else
                        Compiler.Report.ShowMessage(Messages.VBNC30037)
                        NextChar()
                    End If
            End Select
        Loop While Token.IsSomething(Result) = False

        If Result.IsEndOfLine = False Then
            m_TokensSeenOnLine += 1
        Else
            m_TokensSeenOnLine = 0
        End If

        Return Result
    End Function

    Function SetMultiKeywords(ByVal current As Token) As Token
        Dim peeked As Token

        If current.Equals(KS.ConditionalEnd) Then
            peeked = Me.PeekExactToken()

            If peeked.Equals(KS.If) Then
                peeked = Me.NextExactToken
                Return Token.CreateKeywordToken(New Span(current.Location, peeked.Location), KS.ConditionalEndIf)
            End If

            If Not peeked.IsIdentifier Then Return current

            If peeked.Equals("Region") Then
                peeked = Me.NextExactToken
                Return Token.CreateKeywordToken(New Span(current.Location, peeked.Location), KS.ConditionalEndRegion)
            ElseIf peeked.Equals("ExternalSource") Then
                peeked = Me.NextExactToken
                Return Token.CreateKeywordToken(New Span(current.Location, peeked.Location), KS.ConditionalEndExternalSource)
            Else
                Return current
            End If
        End If

        If current.Equals(KS.End) Then
            peeked = Me.PeekExactToken()
            If Not peeked.IsKeyword Then Return current

            Dim attrib As KSEnumStringAttribute
            attrib = Enums.GetKSStringAttribute(peeked.Keyword)
            If Not attrib.IsMultiKeyword Then Return current

            peeked = Me.NextExactToken
            Return Token.CreateKeywordToken(New Span(current.Location, peeked.Location), attrib.MultiKeyword)
        End If

        If current.Equals(KS.Numeral) AndAlso m_TokensSeenOnLine = 1 Then
            peeked = Me.PeekExactToken
            If peeked.IsKeyword Then
                Select Case peeked.Keyword
                    Case KS.If
                        peeked = Me.NextExactToken
                        Return Token.CreateKeywordToken(New Span(current.Location, peeked.Location), KS.ConditionalIf)
                    Case KS.Else
                        peeked = Me.NextExactToken
                        Return Token.CreateKeywordToken(New Span(current.Location, peeked.Location), KS.ConditionalElse)
                    Case KS.ElseIf
                        peeked = Me.NextExactToken
                        Return Token.CreateKeywordToken(New Span(current.Location, peeked.Location), KS.ConditionalElseIf)
                    Case KS.Const
                        peeked = Me.NextExactToken
                        Return SetMultiKeywords(Token.CreateKeywordToken(New Span(current.Location, peeked.Location), KS.ConditionalConst))
                    Case KS.End
                        peeked = Me.NextExactToken
                        Return SetMultiKeywords(Token.CreateKeywordToken(New Span(current.Location, peeked.Location), KS.ConditionalEnd))
                    Case KS.End_If
                        peeked = Me.NextExactToken
                        Return Token.CreateKeywordToken(New Span(current.Location, peeked.Location), KS.ConditionalEndIf)
                    Case Else
                        Return current
                End Select
            ElseIf peeked.IsIdentifier Then
                If peeked.Equals("Region") Then
                    peeked = Me.NextExactToken
                    Return Token.CreateKeywordToken(New Span(current.Location, peeked.Location), KS.ConditionalRegion)
                ElseIf peeked.Equals("ExternalSource") Then
                    peeked = Me.NextExactToken
                    Return Token.CreateKeywordToken(New Span(current.Location, peeked.Location), KS.ConditionalExternalSource)
                Else
                    Return current
                End If
            End If
        End If

        If current.IsIdentifier AndAlso current.Equals("Custom") Then
            If Not Me.PeekExactToken.Equals(KS.Event) Then Return current
            peeked = Me.Next()
            Return Token.CreateKeywordToken(New Span(current.Location, peeked.Location), KS.CustomEvent)
        End If

        Return current
    End Function

    Public Sub New(ByVal Compiler As Compiler)
        m_Compiler = Compiler
        m_Files = New Generic.Queue(Of CodeFile)(m_Compiler.CommandLine.Files)
        NextFile()
    End Sub

    Public Sub New(ByVal Compiler As Compiler, ByVal Code As String)
        m_Compiler = Compiler
        m_Files = New Generic.Queue(Of CodeFile)()
        Dim cf As New CodeFile("<Internal>", "", Compiler, Code)
        m_Files.Enqueue(cf)
        Compiler.CommandLine.Files.Add(cf)
        NextFile()
    End Sub

    Private Sub NextFile()
        m_TotalLineCount += m_CurrentLine
        'm_TotalCharCount += m_Code.Length

        m_CurrentLine = 1
        m_CurrentColumn = 1
        m_TokensSeenOnLine = 0
        m_CurrentChar = Nothing
        m_PreviousChar = Nothing
        m_PeekedChars.Clear()

        If m_Files.Count > 0 Then
            m_CodeFile = m_Files.Dequeue()
            m_CodeFileIndex = CUShort(Compiler.CommandLine.Files.IndexOf(m_CodeFile))
            m_Reader = m_CodeFile.CodeStream
            NextChar()
        Else
            m_CodeFile = Nothing
            'm_Code = Nothing
            m_Reader = Nothing
        End If
    End Sub

    Private Function NextExactToken() As Token
        Dim result As Token

        If Token.IsSomething(m_PeekedExact) Then
            result = m_PeekedExact
            m_PeekedExact = Nothing
            Return result
        End If

        Return GetNextToken()
    End Function

    Private Function PeekExactToken() As Token
        If Token.IsSomething(m_PeekedExact) = False Then
            m_PeekedExact = NextExactToken()
        End If

        Return m_PeekedExact
    End Function

    Public Function [Next]() As Token Implements ITokenReader.Next
        Dim result As Token

        If Token.IsSomething(m_Peeked) Then
            m_Current = m_Peeked
            m_Peeked = Nothing
            Return m_Current
        End If

        If m_CodeFile Is Nothing Then
            result = Token.CreateEndOfCodeToken
            m_Current = result
            Return result
        End If

        result = NextExactToken()

        'Console.WriteLine("Scanned token: " & result.FriendlyString())

        result = SetMultiKeywords(result)

        If result.IsEndOfLineOnly Then
            Do While PeekExactToken().IsEndOfLineOnly
                result = Me.NextExactToken() 'Eat all posterior newlines
            Loop
        End If

        If result.IsEndOfFile() Then
            If Token.IsSomething(m_Current) AndAlso Not m_Current.IsEndOfLineOnly Then
                m_Peeked = result
                result = Token.CreateEndOfLineToken(m_Peeked.Location)
            End If
            NextFile()
        End If

        m_Current = result

        'Console.WriteLine("Returning token: " & result.FriendlyString)

        Return result
    End Function

    Public Function Peek() As Token Implements ITokenReader.Peek
        If Token.IsSomething(m_Peeked) Then Return m_Peeked
        m_Peeked = [Next]()
        Return m_Peeked
    End Function

    Public Function Current() As Token Implements ITokenReader.Current
        Return m_Current
    End Function
End Class