scanner.vb

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

            Case Else
                REM is taken care of some other place.
                'Function should never be called if not a comment
                Throw New InternalException("EatComment called with no comment.")
        End Select
    End Sub

    Private Sub EatWhiteSpace()
        While IsWhiteSpace()
            If IsLineContinuation() Then
                EatLine(True)
            Else
                NextChar()
            End If
        End While
    End Sub

    Private Function GetDate() As Token
        Helper.Assert(CurrentChar() = "#"c, "GetDate called without a date!")

        EatWhiteSpace()

        Dim Count As Integer
        'Date value
        Dim bCont As Boolean = True
        m_Builder.Length = 0
        Do
            Count += 1
            Dim ch As Char = NextChar()
            If (IsNewLine()) Then
                Compiler.Report.ShowMessage(Messages.VBNC90000)
                bCont = False
            Else
                Select Case ch
                    Case nl0
                        Compiler.Report.ShowMessage(Messages.VBNC90001)
                        bCont = False
                    Case "#"c
                        NextChar() 'The ending #
                        bCont = False
                End Select
            End If
            If bCont Then m_Builder.Append(ch)
        Loop While bCont

        Return Token.CreateDateToken(GetCurrentLocation, CDate(m_Builder.ToString))
    End Function

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

    Private Function CanStartIdentifier(ByVal chr As Char) As Boolean
        Return IsAlphaCharacter(chr) OrElse IsUnderscoreCharacter(chr)
    End Function

    Private Function GetEscapedIdentifier() As Token
        'EscapedIdentifier  ::=  [  IdentifierName  ] 
        Helper.Assert(CurrentChar() = "["c)
        NextChar()
        Dim id As Token
        id = GetIdentifier(True)
        If CurrentChar() = "]"c = False Then
            Helper.AddError()
        Else
            NextChar()
        End If
        Return id
    End Function

    Private Function GetIdentifier(Optional ByVal Escaped As Boolean = False) As Token
        Dim bValid As Boolean = False
        Dim ch As Char

        'Identifier  ::=
        '	NonEscapedIdentifier  [  TypeCharacter  ]  |
        '	Keyword  TypeCharacter  |
        '	EscapedIdentifier
        '
        'NonEscapedIdentifier  ::=  < IdentifierName but not Keyword >
        'EscapedIdentifier  ::=  [  IdentifierName  ] 
        '
        'IdentifierName ::= IdentifierStart [ IdentifierCharacter+ ]

        'IdentifierStart ::=
        '   AlphaCharacter |
        '   UnderscoreCharacter IdentifierCharacter 

        'IdentifierCharacter ::=
        '   UnderscoreCharacter |
        '   AlphaCharacter |
        '   NumericCharacter |
        '   CombiningCharacter |
        '   FormattingCharacter
        m_Builder.Length = 0

        ch = CurrentChar()
        m_Builder.Append(ch)
        If IsAlphaCharacter(ch) Then
            bValid = True
        ElseIf IsUnderscoreCharacter(ch) Then
            ch = NextChar()
            m_Builder.Append(ch)
            bValid = IsIdentifierCharacter(ch)
        End If

        If Not bValid Then
            Compiler.Report.ShowMessage(Messages.VBNC30203, Me.GetCurrentLocation(), CStr(ch))
            Return Nothing
        Else
            Do While IsIdentifierCharacter(NextChar)
                m_Builder.Append(CurrentChar)
            Loop
        End If

        Dim strIdent As String = m_Builder.ToString()

        'The type character ! presents a special problem in that it can be used both as a type character and 
        'as a separator in the language. To remove ambiguity, a ! character is a type character as long as 
        'the character that follows it cannot start an identifier. If it can, then the ! character is a separator, 
        'not a type character.
        Dim typecharacter As TypeCharacters.Characters
        Dim canstartidentifier As Boolean = Me.IsLastChar = False AndAlso (IsAlphaCharacter(PeekChar) OrElse IsUnderscoreCharacter(PeekChar))
        If TypeCharacters.IsTypeCharacter(CurrentChar, typecharacter) AndAlso (canstartidentifier = False OrElse typecharacter <> TypeCharacters.Characters.SingleTypeCharacter) Then
            NextChar()
            Return Token.CreateIdentifierToken(GetCurrentLocation, strIdent, typecharacter, Escaped)
        Else
            Dim keyword As KS
            If Escaped = False AndAlso Token.IsKeyword(strIdent, keyword) Then
                Return Token.CreateKeywordToken(GetCurrentLocation, keyword)
            Else
                Return Token.CreateIdentifierToken(GetCurrentLocation, strIdent, typecharacter, Escaped)
            End If
        End If
    End Function

    Private Function GetString() As Token
        Dim bEndOfString As Boolean = False
        m_Builder.Length = 0
        Do
            Select Case NextChar()
                Case """"c '
                    'If " followed by a ", output one "
                    If NextChar() = """" Then
                        m_Builder.Append("""")
                    Else
                        bEndOfString = True
                    End If
                Case nlA, nlD, nl2028, nl2029
                    'vbc accepts this...
                    Compiler.Report.ShowMessage(Messages.VBNC90003)
                    bEndOfString = True
                Case nl0
                    ' End of file
                    Compiler.Report.ShowMessage(Messages.VBNC90004)
                    'PreviousChar() 'Step back
                    bEndOfString = True
                Case Else
                    m_Builder.Append(CurrentChar())
            End Select
        Loop While bEndOfString = False
        If CurrentChar() = "C"c OrElse CurrentChar() = "c"c Then
            'Is a char type character
            NextChar()
            If m_Builder.Length <> 1 Then
                Compiler.Report.ShowMessage(Messages.VBNC30004)
                Return Token.CreateStringLiteral(GetCurrentLocation, m_Builder.ToString)
            Else
                Return Token.CreateCharToken(GetCurrentLocation, m_Builder.Chars(0))
            End If
        Else
            Return Token.CreateStringLiteral(GetCurrentLocation, m_Builder.ToString)
        End If
    End Function

    Private Function GetNumber() As Token
        Dim Base As IntegerBase
        Dim bReal As Boolean
        Dim bE As Boolean
        Static Builder As New Text.StringBuilder
        Builder.Length = 0

        'First find the type of the number
        Select Case CurrentChar()
            Case "."c, "0"c To "9"c 'Decimal
                Base = IntegerBase.Decimal
            Case "&"c
                Select Case NextChar()
#If EXTENDED Then
                    Case "b"c, "B"c 'Binary
                        Base = IntegerBase.Binary
#End If
                    Case "d"c, "D"c 'Decimal
                        Base = IntegerBase.Decimal
                    Case "h"c, "H"c 'Hex
                        Base = IntegerBase.Hex
                    Case "o"c, "O"c 'Octal
                        Base = IntegerBase.Octal
                    Case Else
                        Throw New InternalException(GetCurrentLocation.ToString(Compiler)) 'Should never get here, this function should only be called with the correct specifiers.
                End Select
                NextChar()
            Case Else
                Throw New InternalException("Invalid character: " & CurrentChar.ToString & ", Location: " & GetCurrentLocation.ToString(Compiler))
        End Select

        Dim ch As Char = CurrentChar()
        ' Then start the parsing
        Select Case Base
            Case IntegerBase.Decimal
                While Me.IsNumericCharacter(ch)
                    Builder.Append(ch)
                    ch = NextChar()
                End While
                If ch = "."c Then
                    If Me.IsNumericCharacter(Me.PeekChar) Then
                        Builder.Append(ch)
                        bReal = True
                        ch = NextChar()
                        While Me.IsNumericCharacter(ch)
                            Builder.Append(ch)
                            ch = NextChar()
                        End While
                    End If
                End If
                If ch = "E"c OrElse ch = "e"c Then
                    bE = True
                    bReal = True
                    Builder.Append(ch)
                    ch = NextChar()
                    If ch = "+"c OrElse ch = "-"c Then
                        Builder.Append(ch)
                        ch = NextChar()
                    End If
                    While Me.IsNumericCharacter(ch)
                        Builder.Append(ch)
                        ch = NextChar()
                    End While
                End If
#If EXTENDED Then
            Case IntegerBase.Binary
                While ((ch >= "0"c) AndAlso (ch <= "1"c))
                    Builder.Append(ch)
                    ch = NextChar()
                End While
#End If
            Case IntegerBase.Hex
                While (((ch >= "0"c) AndAlso (ch <= "9"c)) OrElse _
                  ((ch >= "a"c) AndAlso (ch <= "f"c)) OrElse _
                  ((ch >= "A"c) AndAlso (ch <= "F"c)))
                    Builder.Append(ch)
                    ch = NextChar()
                End While
            Case IntegerBase.Octal
                While ((ch >= "0"c) AndAlso (ch <= "7"c))
                    Builder.Append(ch)
                    ch = NextChar()
                End While
            Case Else
                Throw New InternalException(GetCurrentLocation.ToString(Compiler))
        End Select

        'Find the type character, if any
        Dim strType As String = ""
        Dim typeOfNumber As BuiltInDataTypes
        Dim typeCharacter As LiteralTypeCharacters_Characters = LiteralTypeCharacters_Characters.None

        Dim test As String
        test = CurrentChar()
        If test = "U" OrElse test = "u" Then test &= PeekChar()
        typeCharacter = LiteralTypeCharacters.GetTypeCharacter(test)
        If typeCharacter <> LiteralTypeCharacters_Characters.None Then
            NextChar()
            If test.Length = 2 Then NextChar()
            typeOfNumber = LiteralTypeCharacters.GetBuiltInType(typeCharacter)
        End If

        If typeCharacter <> LiteralTypeCharacters_Characters.None AndAlso LiteralTypeCharacters.IsIntegral(typeCharacter) = False AndAlso Base <> IntegerBase.Decimal Then
            Compiler.Report.ShowMessage(Messages.VBNC90002, Me.GetCurrentLocation(), KS.Decimal.ToString)
        End If

        ' Found the string of the number
        Dim strResult As String = Builder.ToString
        Dim IntegerValue As ULong

        Select Case Base
            Case IntegerBase.Decimal
                Try
                    Dim tp As BuiltInDataTypes
                    If typeCharacter = LiteralTypeCharacters_Characters.None Then
                        If bReal Then
                            tp = BuiltInDataTypes.Double
                        Else
                            tp = BuiltInDataTypes.Integer
                        End If
                    Else
                        tp = LiteralTypeCharacters.GetBuiltInType(typeCharacter)
                    End If
                    Select Case tp
                        Case BuiltInDataTypes.Decimal
                            GetNumber = Token.CreateDecimalToken(GetCurrentLocation, Decimal.Parse(strResult, Helper.USCulture), typeCharacter)
                        Case BuiltInDataTypes.Double
                            GetNumber = Token.CreateDoubleToken(GetCurrentLocation, Double.Parse(strResult, Helper.USCulture), typeCharacter)
                        Case BuiltInDataTypes.Single
                            GetNumber = Token.CreateSingleToken(GetCurrentLocation, Single.Parse(strResult, Helper.USCulture), typeCharacter)
                        Case BuiltInDataTypes.Integer, BuiltInDataTypes.Long, BuiltInDataTypes.Short, BuiltInDataTypes.UInteger, BuiltInDataTypes.ULong, BuiltInDataTypes.UShort
                            If bReal Then
                                Compiler.Report.ShowMessage(Messages.VBNC90002, typeCharacter.ToString)
                                IntegerValue = 0
                            Else
                                'Try to parse the result
                                IntegerValue = ULong.Parse(strResult, Helper.USCulture)
                            End If
                            'Check if value is out of range for data type.
                            Dim bOutOfRange As Boolean
                            'TODO: Make error code number.
                            Select Case tp
                                Case BuiltInDataTypes.Integer
                                    If IntegerValue > Integer.MaxValue Then bOutOfRange = True
                                Case BuiltInDataTypes.Long
                                    If IntegerValue > Long.MaxValue Then bOutOfRange = True
                                Case BuiltInDataTypes.Short
                                    If IntegerValue > Short.MaxValue Then bOutOfRange = True
                                Case BuiltInDataTypes.UInteger
                                    If IntegerValue > UInteger.MaxValue Then bOutOfRange = True
                                Case BuiltInDataTypes.ULong 'Not necessary
                                    '    If IntegerValue > Integer.MaxValue Then bOutOfRange = True