scanner.vb

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

                                Case BuiltInDataTypes.UShort
                                    If IntegerValue > UShort.MaxValue Then bOutOfRange = True
                                Case Else
                                    Throw New InternalException("")
                            End Select
                            If bOutOfRange AndAlso typeCharacter <> LiteralTypeCharacters_Characters.None Then
                                Compiler.Report.ShowMessage(Messages.VBNC30439, typeCharacter.ToString)
                            End If
                            GetNumber = GetIntegralToken(ULong.Parse(strResult, Helper.USCulture), Base, typeCharacter)
                        Case Else
                            Compiler.Report.ShowMessage(Messages.VBNC90002, typeCharacter.ToString)
                            GetNumber = Token.CreateDoubleToken(GetCurrentLocation, 0, LiteralTypeCharacters_Characters.None)
                    End Select
                Catch ex As System.OverflowException
                    Compiler.Report.ShowMessage(Messages.VBNC30036)
                    GetNumber = Token.CreateDoubleToken(GetCurrentLocation, 0, LiteralTypeCharacters_Characters.None)
                Catch ex As Exception
                    Compiler.Report.ShowMessage(Messages.VBNC90005)
                    GetNumber = Token.CreateDoubleToken(GetCurrentLocation, 0, LiteralTypeCharacters_Characters.None)
                End Try
#If EXTENDED Then
            Case IntegerBase.Binary
                Try
                    IntegerValue = Helper.BinToInt(strResult)
                    IntegerValue = ConvertNonDecimalBits(IntegerValue, typeCharacter)
                Catch ex As Exception
                    Compiler.Report.ShowMessage(Messages.VBNC90006, "binary")
                End Try
                GetNumber = GetIntegralToken(IntegerValue, Base, typeCharacter)
#End If
            Case IntegerBase.Hex
                Try
                    'Console.WriteLine("Hex: " & strResult)
                    IntegerValue = Helper.HexToInt(strResult)
                Catch ex As Exception
                    Compiler.Report.ShowMessage(Messages.VBNC90006, Me.GetCurrentLocation, "hexadecimal")
                End Try
                GetNumber = GetIntegralToken(IntegerValue, Base, typeCharacter)
            Case IntegerBase.Octal
                Try
                    IntegerValue = Helper.OctToInt(strResult)
                Catch ex As Exception
                    Compiler.Report.ShowMessage(Messages.VBNC90006, "octal")
                End Try
                GetNumber = GetIntegralToken(IntegerValue, Base, typeCharacter)
            Case Else
                Throw New InternalException(GetCurrentLocation.ToString(Compiler))
        End Select
    End Function

    Private Function GetIntegralToken(ByVal Value As ULong, ByVal Base As IntegerBase, ByVal TypeCharacter As LiteralTypeCharacters_Characters) As Token
        Dim case_type As BuiltInDataTypes
        'TODO: Check bounds of value 
        If TypeCharacter = LiteralTypeCharacters_Characters.None Then
            If Value > Integer.MaxValue Then
                case_type = BuiltInDataTypes.Long
            Else
                case_type = BuiltInDataTypes.Integer
            End If
        Else
            case_type = LiteralTypeCharacters.GetBuiltInType(TypeCharacter)
        End If

        Select Case case_type
            Case BuiltInDataTypes.Integer
                Return Token.CreateInt32Token(GetCurrentLocation, ExtractInt(Value, Base), Base, TypeCharacter)
            Case BuiltInDataTypes.UInteger
                Return Token.CreateUInt32Token(GetCurrentLocation, ExtractUInt(Value, Base), Base, TypeCharacter)
            Case BuiltInDataTypes.Long
                Return Token.CreateInt64Token(GetCurrentLocation, ExtractLong(Value, Base), Base, TypeCharacter)
            Case BuiltInDataTypes.ULong
                Return Token.CreateUInt64Token(GetCurrentLocation, ExtractULong(Value, Base), Base, TypeCharacter)
            Case BuiltInDataTypes.Short
                Return Token.CreateInt16Token(GetCurrentLocation, ExtractShort(Value, Base), Base, TypeCharacter)
            Case BuiltInDataTypes.UShort
                Return Token.CreateUInt16Token(GetCurrentLocation, ExtractUShort(Value, Base), Base, TypeCharacter)
            Case Else
                Throw New InternalException("")
        End Select
    End Function

    Private Function ExtractInt(ByVal Value As ULong, ByVal Base As IntegerBase) As Integer
        Select Case Base
            Case IntegerBase.Decimal
                Return CInt(Value)
            Case IntegerBase.Hex, IntegerBase.Octal
                If Value > Integer.MaxValue Then
                    Return CInt(Integer.MinValue + (CUInt(Value) - Integer.MaxValue - 1))
                Else
                    Return CInt(Value)
                End If
            Case Else
                Throw New InternalException("Unknown base: " & Base.ToString())
        End Select
    End Function

    Private Function ExtractUInt(ByVal Value As ULong, ByVal Base As IntegerBase) As UInteger
        Select Case Base
            Case IntegerBase.Decimal
                Return CUInt(Value)
            Case IntegerBase.Hex, IntegerBase.Octal
                Return CUInt(Value)
            Case Else
                Throw New InternalException("Unknown base: " & Base.ToString())
        End Select
    End Function

    Private Function ExtractShort(ByVal Value As ULong, ByVal Base As IntegerBase) As Short
        Select Case Base
            Case IntegerBase.Decimal
                Return CShort(Value)
            Case IntegerBase.Hex, IntegerBase.Octal
                If Value > Short.MaxValue Then
                    Return CShort(Short.MinValue + (CUShort(Value) - Short.MaxValue - 1))
                Else
                    Return CShort(Value)
                End If
            Case Else
                Throw New InternalException("Unknown base: " & Base.ToString())
        End Select
    End Function

    Private Function ExtractUShort(ByVal Value As ULong, ByVal Base As IntegerBase) As UShort
        Select Case Base
            Case IntegerBase.Decimal
                Return CUShort(Value)
            Case IntegerBase.Hex, IntegerBase.Octal
                Return CUShort(Value)
            Case Else
                Throw New InternalException("Unknown base: " & Base.ToString())
        End Select
    End Function

    Private Function ExtractLong(ByVal Value As ULong, ByVal Base As IntegerBase) As Long
        Select Case Base
            Case IntegerBase.Decimal
                Return CLng(Value)
            Case IntegerBase.Hex, IntegerBase.Octal
                If Value > Long.MaxValue Then
                    Return CLng(Long.MinValue + (Value - Long.MaxValue - 1))
                Else
                    Return CLng(Value)
                End If
            Case Else
                Throw New InternalException("Unknown base: " & Base.ToString())
        End Select
    End Function

    Private Function ExtractULong(ByVal Value As ULong, ByVal Base As IntegerBase) As ULong
        Select Case Base
            Case IntegerBase.Decimal
                Return CULng(Value)
            Case IntegerBase.Hex, IntegerBase.Octal
                Return CULng(Value)
            Case Else
                Throw New InternalException("Unknown base: " & Base.ToString())
        End Select
    End Function

    Function GetCurrentLocation() As Span
        Return New Span(m_CodeFileIndex, m_CurrentLine, m_CurrentColumn)
    End Function

    Private ReadOnly Property CurrentChar() As Char
        Get
            Return m_CurrentChar
        End Get
    End Property

    Private Function NextChar() As Char
        If m_CurrentColumn < 255 Then m_CurrentColumn += CByte(1)
        m_TotalCharCount += 1

        m_PreviousChar = m_CurrentChar
        If m_PeekedChars.Count > 0 Then
            m_CurrentChar = m_PeekedChars.Dequeue
        Else
            If m_Reader.EndOfStream Then
                m_CurrentChar = nl0
            Else
                m_CurrentChar = Convert.ToChar(m_Reader.Read())
            End If
        End If

        Return m_CurrentChar
    End Function

    Private ReadOnly Property PreviousChar() As Char
        Get
            Return m_PreviousChar
        End Get
    End Property

    Private Function PeekChar() As Char
        If m_PeekedChars.Count = 0 Then
            If m_Reader.EndOfStream Then Return nl0
            m_PeekedChars.Enqueue(Convert.ToChar(m_Reader.Read))
        End If
        Return m_PeekedChars.Peek()
    End Function

    Private Function PeekChars(ByVal Chars As Integer) As Char
        Do Until m_PeekedChars.Count >= Chars
            If m_Reader.EndOfStream Then Return nlA
            m_PeekedChars.Enqueue(Convert.ToChar(m_Reader.Read))
        Loop
        Return m_PeekedChars.ToArray()(Chars - 1)
    End Function

    ''' <summary>
    ''' Returns true if the current character is the last character in the scanner.
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function IsLastChar() As Boolean
        Return m_Reader.EndOfStream
    End Function

    ''' <summary>
    ''' Next line!
    ''' </summary>
    ''' <remarks></remarks>
    Private Sub IncLine()
        m_CurrentLine += 1UI
        m_CurrentColumn = 1
        m_TokensSeenOnLine = 0
    End Sub

    ''' <summary>
    ''' Creates a new symbol token of the specified symbol.
    ''' </summary>
    ''' <param name="Symbol"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function NewToken(ByVal Symbol As KS) As Token
        Return Token.CreateSymbolToken(GetCurrentLocation, Symbol)
    End Function

    Private Function GetNextToken() As Token
        Dim Result As Token = Nothing
        Do
            Select Case CurrentChar()
                Case """"c 'String Literal
                    Result = GetString()
                Case COMMENTCHAR1, COMMENTCHAR2, COMMENTCHAR3 'VB Comment
                    EatComment()
                Case nlD, nlA, nl2028, nl2029 'New line
                    EatNewLine()
                    Result = Token.CreateEndOfLineToken(GetCurrentLocation)
                Case nl0 'End of file
                    Result = Token.CreateEndOfFileToken(GetCurrentLocation)
                Case ":"c ':
                    NextChar()
                    Result = NewToken(KS.Colon)
                Case ","c ',
                    NextChar()
                    Result = NewToken(KS.Comma)
                Case "."c
                    If PeekChar() >= "0"c AndAlso PeekChar() <= "9"c Then
                        Result = GetNumber()
                    Else
                        NextChar()
                        Result = NewToken(KS.Dot)
                    End If
                Case "0"c To "9"c
                    Result = GetNumber()
                Case "("c
                    NextChar()
                    Result = NewToken(KS.LParenthesis)
                Case ")"c
                    NextChar()
                    Result = NewToken(KS.RParenthesis)
                Case "["c
                    Result = GetEscapedIdentifier()
                Case "{"c
                    NextChar()
                    Result = NewToken(KS.LBrace)
                Case "}"c
                    NextChar()
                    Result = NewToken(KS.RBrace)
                Case ">"c
                    NextChar()
                    EatWhiteSpace()
                    'If CurrentChar() = "<"c Then
                    '    NextChar()
                    '    Result = NewToken(KS.NotEqual)
                    'Else
                    If CurrentChar() = "="c Then
                        NextChar()
                        Result = NewToken(KS.GE)
                    ElseIf CurrentChar() = ">"c Then
                        NextChar()
                        EatWhiteSpace()
                        If CurrentChar() = "="c Then
                            NextChar()
                            Result = NewToken(KS.ShiftRightAssign)
                        Else
                            Result = NewToken(KS.ShiftRight)
                        End If
                    Else
                        Result = NewToken(KS.GT)
                    End If
                Case "<"c
                    NextChar()
                    EatWhiteSpace()
                    If (CurrentChar() = ">"c) Then
                        NextChar()
                        Result = NewToken(KS.NotEqual)
                    ElseIf CurrentChar() = "="c Then
                        NextChar()
                        Result = NewToken(KS.LE)
                    ElseIf CurrentChar() = "<"c Then
                        NextChar()
                        EatWhiteSpace()
                        If CurrentChar() = "="c Then
                            NextChar()
                            Result = NewToken(KS.ShiftLeftAssign)
                        Else
                            Result = NewToken(KS.ShiftLeft)
                        End If
                    Else
                        Result = NewToken(KS.LT)
                    End If
                Case "="c
                    NextChar()
                    Result = NewToken(KS.Equals)
                Case "!"c