scanner.vb

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

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

#Const SUPPORT_CSTYLE_COMMENTS = 1
#If DEBUG Then
#Const DOEOFCHECK = 0
#Const EXTENDEDDEBUG = 0
#End If
#Const EXTENDED = False

Public Class Scanner
    Implements ITokenReader

    ''' <summary>
    ''' The total number of lines scanned.
    ''' </summary>
    ''' <remarks></remarks>
    Private m_TotalLineCount As UInteger

    ''' <summary>
    ''' The total number of characters scanned.
    ''' </summary>
    ''' <remarks></remarks>
    Private m_TotalCharCount As Integer

    ''' <summary>
    ''' The current line.
    ''' </summary>
    ''' <remarks></remarks>
    Private m_CurrentLine As UInteger

    ''' <summary>
    ''' The current column.
    ''' </summary>
    ''' <remarks></remarks>
    Private m_CurrentColumn As Byte

    ''' <summary>
    ''' The current code file.
    ''' </summary>
    ''' <remarks></remarks>
    Private m_CodeFile As CodeFile
    Private m_CodeFileIndex As UShort

    Private m_PreviousChar As Char
    Private m_CurrentChar As Char
    Private m_PeekedChars As New Generic.Queue(Of Char)
    Private m_Reader As System.IO.StreamReader
    Private m_Builder As New System.Text.StringBuilder

    ''' <summary>
    ''' If any tokens has been found on this line.
    ''' Reset by IncLine, set by NewToken
    ''' </summary>
    ''' <remarks></remarks>
    Private m_TokensSeenOnLine As Integer

    Private m_Files As Generic.Queue(Of CodeFile)

    Private m_Compiler As Compiler

    Private m_Peeked As Token
    Private m_PeekedExact As Token
    Private m_Current As Token

    'Useful constants.
    Private Const nl0 As Char = Microsoft.VisualBasic.ChrW(0)
    Private Const nlA As Char = Microsoft.VisualBasic.ChrW(&HA)
    Private Const nlD As Char = Microsoft.VisualBasic.ChrW(&HD)
    Private Const nl2028 As Char = Microsoft.VisualBasic.ChrW(&H2028)
    Private Const nl2029 As Char = Microsoft.VisualBasic.ChrW(&H2029)
    Private Const nlTab As Char = Microsoft.VisualBasic.ChrW(9)

    Private Const COMMENTCHAR1 As Char = "'"c
    Private Const COMMENTCHAR2 As Char = Microsoft.VisualBasic.ChrW(&H2018)
    Private Const COMMENTCHAR3 As Char = Microsoft.VisualBasic.ChrW(&H2019)

    ReadOnly Property TotalLineCount() As UInteger
        Get
            Return m_TotalLineCount
        End Get
    End Property

    ReadOnly Property TotalCharCount() As Integer
        Get
            Return m_TotalCharCount
        End Get
    End Property

    ReadOnly Property Compiler() As Compiler
        Get
            Return m_Compiler
        End Get
    End Property

    Private Function IsNewLine() As Boolean
        Return IsNewLine(CurrentChar)
    End Function

    Private Function IsNewLine(ByVal chr As Char) As Boolean
        Return chr = nlA OrElse chr = nlD OrElse chr = nl2028 OrElse chr = nl2029 OrElse chr = nl0
    End Function

    Private Function IsUnderscoreCharacter(ByVal chr As Char) As Boolean
        'UnderscoreCharacter ::= < Unicode connection character (class Pc) >
        Return Char.GetUnicodeCategory(chr) = Globalization.UnicodeCategory.ConnectorPunctuation
    End Function

    Private Function IsIdentifierCharacter(ByVal chr As Char) As Boolean
        'IdentifierCharacter ::=
        '   UnderscoreCharacter |
        '   AlphaCharacter |
        '   NumericCharacter |
        '   CombiningCharacter |
        '   FormattingCharacter
        Return IsUnderscoreCharacter(chr) OrElse _
                IsAlphaCharacter(chr) OrElse _
                IsNumericCharacter(chr) OrElse _
                IsCombiningCharacter(chr) OrElse _
                IsFormattingCharacter(chr)
    End Function

    Private Function IsNumericCharacter(ByVal chr As Char) As Boolean
        'NumericCharacter ::= < Unicode decimal digit character (class Nd) >
        Return Char.GetUnicodeCategory(chr) = Globalization.UnicodeCategory.DecimalDigitNumber 'Nd
    End Function

    Private Function IsOperatorCharacter(ByVal chr As Char) As Boolean
        'Operator ::= & * +  -  /  \  ^ <  =  >
        Return chr = "&"c OrElse _
                chr = "*"c OrElse _
                chr = "+"c OrElse _
                chr = "-"c OrElse _
                chr = "/"c OrElse _
                chr = "\"c OrElse _
                chr = "^"c OrElse _
                chr = "<"c OrElse _
                chr = "="c OrElse _
                chr = ">"c
        chr = ":"c
    End Function

    Private Function IsSeparatorCharacter(ByVal chr As Char) As Boolean
        'Separator ::= (  )  {  }  !  #  ,  .  :
        Return chr = "("c OrElse _
                chr = ")"c OrElse _
                chr = "{"c OrElse _
                chr = "}"c OrElse _
                chr = "!"c OrElse _
                chr = "#"c OrElse _
                chr = ","c OrElse _
                chr = "."c OrElse _
                chr = ":"c
    End Function

    Private Function IsCombiningCharacter(ByVal chr As Char) As Boolean
        'CombiningCharacter ::= < Unicode combining character (classes Mn, Mc) >
        Select Case Char.GetUnicodeCategory(chr)
            Case Globalization.UnicodeCategory.NonSpacingMark 'Mn
                Return True
            Case Globalization.UnicodeCategory.SpacingCombiningMark 'Mc
                Return True
            Case Else
                Return False
        End Select
    End Function

    Private Function IsFormattingCharacter(ByVal chr As Char) As Boolean
        'FormattingCharacter ::= < Unicode formatting character (class Cf) >
        Return Char.GetUnicodeCategory(chr) = Globalization.UnicodeCategory.Format 'Cf
    End Function

    Private Function IsAlphaCharacter(ByVal chr As Char) As Boolean
        'AlphaCharacter ::= < Unicode alphabetic character (classes Lu, Ll, Lt, Lm, Lo, Nl) >
        Select Case Char.GetUnicodeCategory(chr) 'Alpha Character
            Case Globalization.UnicodeCategory.UppercaseLetter 'Lu
                Return True
            Case Globalization.UnicodeCategory.LowercaseLetter 'Ll
                Return True
            Case Globalization.UnicodeCategory.TitlecaseLetter  'Lt
                Return True
            Case Globalization.UnicodeCategory.ModifierLetter 'Lm
                Return True
            Case Globalization.UnicodeCategory.OtherLetter 'Lo
                Return True
            Case Globalization.UnicodeCategory.LetterNumber 'Nl
                Return True
            Case Else
                Return False
        End Select
    End Function

    Private Function IsLineContinuation() As Boolean
        If Not (CurrentChar() = " "c AndAlso PeekChar() = "_"c) Then Return False

        Dim i As Integer = 2
        Do Until IsNewLine(PeekChars(i))
            If IsWhiteSpace(PeekChars(i)) = False Then Return False
            i += 1
        Loop

        Return True
    End Function

    Private Function IsWhiteSpace(ByVal chr As Char) As Boolean
        Return chr = nlTab OrElse Char.GetUnicodeCategory(chr) = Globalization.UnicodeCategory.SpaceSeparator
    End Function

    Private Function IsWhiteSpace() As Boolean
        Return IsWhiteSpace(CurrentChar())
    End Function

    Private Function IsComment(ByVal chr As Char) As Boolean
        Return chr = COMMENTCHAR1 OrElse chr = COMMENTCHAR2 OrElse chr = COMMENTCHAR3
    End Function

    Private Function IsComment() As Boolean
        Return IsComment(CurrentChar)
    End Function

    ''' <summary>
    ''' Eat all characters until the newline character(s). Optionally eat the newline character(s) as well
    ''' </summary>
    ''' <param name="NewLineCharAlso"></param>
    ''' <remarks></remarks>
    Private Sub EatLine(ByVal NewLineCharAlso As Boolean)
        'LineTerminator ::=
        '  < Unicode carriage return character (0x000D) > |
        '  < Unicode line feed character (0x000A) > |
        '  < Unicode carriage return character > < Unicode line feed character > |
        '  < Unicode line separator character (0x2028) > |
        '  < Unicode paragraph separator character (0x2029) >

        Dim ch As Char
        Do
            ch = NextChar()
        Loop Until IsNewLine(ch)

        If NewLineCharAlso Then
            EatNewLine()
        End If
    End Sub

    Private Sub EatNewLine()
        Select Case CurrentChar()
            Case nlD
                NextChar()
                If CurrentChar() = nlA Then
                    NextChar()
                End If
                IncLine()
            Case nlA, nl2029, nl2028
                NextChar()
                IncLine()
            Case Else
                Throw New InternalException("Current character is not a new line.")
        End Select
    End Sub

    Private Sub EatComment()
        Select Case CurrentChar()
            Case COMMENTCHAR1, COMMENTCHAR2, COMMENTCHAR3 'Traditional VB comment
                EatLine(False) 'do not eat newline, it needs to be added as a token
                Return
#If SUPPORT_CSTYLE_COMMENTS Then
            Case "/"c 'C-style comment
                NextChar()
                Select Case CurrentChar()
                    Case "/"c 'Single line comment
                        EatLine(False) 'do not eat newline, it needs to be added as a token
                        Return
                    Case "*"c 'Nestable, multiline comment.
                        Dim iNesting As Integer = 1
                        NextChar()
                        Do
                            Select Case CurrentChar()
                                Case "*"c
                                    If PeekChar() = "/"c Then
                                        'End of comment found (if iNesting is 0)
                                        NextChar()
                                        NextChar()
                                        iNesting -= 1
                                    Else
                                        NextChar()
                                    End If
                                Case "/"c
                                    If PeekChar() = "*"c Then
                                        'a nested comment was found
                                        NextChar()
                                        iNesting += 1
                                    ElseIf PeekChar() = "/"c Then
                                        EatLine(True)
                                    Else
                                        NextChar()
                                    End If
                                Case nl0
                                    Compiler.Report.ShowMessage(Messages.VBNC90022)
                                    Return
                                Case Else
                                    If IsNewLine() Then
                                        EatNewLine() 'To update the line variable
                                    Else
                                        NextChar()
                                    End If
                            End Select
                        Loop While (iNesting <> 0)
                    Case Else
                        'Function should never be called if not a comment
                        Throw New InternalException("EatComment called with no comment.")
                End Select
#End If