in src/Compilers/VisualBasic/Portable/Scanner/Scanner.vb [1668:2112]
Private Function ScanNumericLiteral(precedingTrivia As CoreInternalSyntax.SyntaxList(Of VisualBasicSyntaxNode)) As SyntaxToken
Debug.Assert(CanGet)
Dim Here As Integer = 0
Dim IntegerLiteralStart As Integer
Dim UnderscoreInWrongPlace As Boolean
Dim UnderscoreUsed As Boolean = False
Dim LeadingUnderscoreUsed = False
Dim Base As LiteralBase = LiteralBase.Decimal
Dim literalKind As NumericLiteralKind = NumericLiteralKind.Integral
Dim ch = Peek()
If ch = "&"c OrElse ch = FULLWIDTH_AMPERSAND Then
Here += 1
ch = If(CanGet(Here), Peek(Here), ChrW(0))
FullWidthRepeat:
Select Case ch
Case "H"c, "h"c
Here += 1
IntegerLiteralStart = Here
Base = LiteralBase.Hexadecimal
If CanGet(Here) AndAlso Peek(Here) = "_"c Then
LeadingUnderscoreUsed = True
End If
While CanGet(Here)
ch = Peek(Here)
If Not IsHexDigit(ch) AndAlso ch <> "_"c Then
Exit While
End If
If ch = "_"c Then
UnderscoreUsed = True
End If
Here += 1
End While
UnderscoreInWrongPlace = UnderscoreInWrongPlace Or (Peek(Here - 1) = "_"c)
Case "B"c, "b"c
Here += 1
IntegerLiteralStart = Here
Base = LiteralBase.Binary
If CanGet(Here) AndAlso Peek(Here) = "_"c Then
LeadingUnderscoreUsed = True
End If
While CanGet(Here)
ch = Peek(Here)
If Not IsBinaryDigit(ch) AndAlso ch <> "_"c Then
Exit While
End If
If ch = "_"c Then
UnderscoreUsed = True
End If
Here += 1
End While
UnderscoreInWrongPlace = UnderscoreInWrongPlace Or (Peek(Here - 1) = "_"c)
Case "O"c, "o"c
Here += 1
IntegerLiteralStart = Here
Base = LiteralBase.Octal
If CanGet(Here) AndAlso Peek(Here) = "_"c Then
LeadingUnderscoreUsed = True
End If
While CanGet(Here)
ch = Peek(Here)
If Not IsOctalDigit(ch) AndAlso ch <> "_"c Then
Exit While
End If
If ch = "_"c Then
UnderscoreUsed = True
End If
Here += 1
End While
UnderscoreInWrongPlace = UnderscoreInWrongPlace Or (Peek(Here - 1) = "_"c)
Case Else
If IsFullWidth(ch) Then
ch = MakeHalfWidth(ch)
GoTo FullWidthRepeat
End If
Throw ExceptionUtilities.UnexpectedValue(ch)
End Select
Else
IntegerLiteralStart = Here
UnderscoreInWrongPlace = (CanGet(Here) AndAlso Peek(Here) = "_"c)
While CanGet(Here)
ch = Peek(Here)
If Not IsDecimalDigit(ch) AndAlso ch <> "_"c Then
Exit While
End If
If ch = "_"c Then
UnderscoreUsed = True
End If
Here += 1
End While
If Here <> IntegerLiteralStart Then
UnderscoreInWrongPlace = UnderscoreInWrongPlace Or (Peek(Here - 1) = "_"c)
End If
End If
Dim IntegerLiteralEnd As Integer = Here
If Base = LiteralBase.Decimal AndAlso CanGet(Here) Then
ch = Peek(Here)
If (ch = "."c Or ch = FULLWIDTH_FULL_STOP) AndAlso
CanGet(Here + 1) AndAlso
IsDecimalDigit(Peek(Here + 1)) Then
Here += 2
While CanGet(Here)
ch = Peek(Here)
If Not IsDecimalDigit(ch) AndAlso ch <> "_"c Then
Exit While
End If
Here += 1
End While
UnderscoreInWrongPlace = UnderscoreInWrongPlace Or (Peek(Here - 1) = "_"c)
literalKind = NumericLiteralKind.Float
End If
If CanGet(Here) AndAlso BeginsExponent(Peek(Here)) Then
Here += 1
If CanGet(Here) Then
ch = Peek(Here)
If MatchOneOrAnotherOrFullwidth(ch, "+"c, "-"c) Then
Here += 1
End If
End If
If CanGet(Here) AndAlso IsDecimalDigit(Peek(Here)) Then
Here += 1
While CanGet(Here)
ch = Peek(Here)
If Not IsDecimalDigit(ch) AndAlso ch <> "_"c Then
Exit While
End If
Here += 1
End While
UnderscoreInWrongPlace = UnderscoreInWrongPlace Or (Peek(Here - 1) = "_"c)
Else
Return MakeBadToken(precedingTrivia, Here, ERRID.ERR_InvalidLiteralExponent)
End If
literalKind = NumericLiteralKind.Float
End If
End If
Dim literalWithoutTypeChar = Here
Dim TypeCharacter As TypeCharacter = TypeCharacter.None
If CanGet(Here) Then
ch = Peek(Here)
FullWidthRepeat2:
Select Case ch
Case "!"c
If Base = LiteralBase.Decimal Then
TypeCharacter = TypeCharacter.Single
literalKind = NumericLiteralKind.Float
Here += 1
End If
Case "F"c, "f"c
If Base = LiteralBase.Decimal Then
TypeCharacter = TypeCharacter.SingleLiteral
literalKind = NumericLiteralKind.Float
Here += 1
End If
Case "#"c
If Base = LiteralBase.Decimal Then
TypeCharacter = TypeCharacter.Double
literalKind = NumericLiteralKind.Float
Here += 1
End If
Case "R"c, "r"c
If Base = LiteralBase.Decimal Then
TypeCharacter = TypeCharacter.DoubleLiteral
literalKind = NumericLiteralKind.Float
Here += 1
End If
Case "S"c, "s"c
If literalKind <> NumericLiteralKind.Float Then
TypeCharacter = TypeCharacter.ShortLiteral
Here += 1
End If
Case "%"c
If literalKind <> NumericLiteralKind.Float Then
TypeCharacter = TypeCharacter.Integer
Here += 1
End If
Case "I"c, "i"c
If literalKind <> NumericLiteralKind.Float Then
TypeCharacter = TypeCharacter.IntegerLiteral
Here += 1
End If
Case "&"c
If literalKind <> NumericLiteralKind.Float Then
TypeCharacter = TypeCharacter.Long
Here += 1
End If
Case "L"c, "l"c
If literalKind <> NumericLiteralKind.Float Then
TypeCharacter = TypeCharacter.LongLiteral
Here += 1
End If
Case "@"c
If Base = LiteralBase.Decimal Then
TypeCharacter = TypeCharacter.Decimal
literalKind = NumericLiteralKind.Decimal
Here += 1
End If
Case "D"c, "d"c
If Base = LiteralBase.Decimal Then
TypeCharacter = TypeCharacter.DecimalLiteral
literalKind = NumericLiteralKind.Decimal
If CanGet(Here + 1) Then
ch = Peek(Here + 1)
If IsDecimalDigit(ch) OrElse MatchOneOrAnotherOrFullwidth(ch, "+"c, "-"c) Then
Return MakeBadToken(precedingTrivia, Here, ERRID.ERR_ObsoleteExponent)
End If
End If
Here += 1
End If
Case "U"c, "u"c
If literalKind <> NumericLiteralKind.Float AndAlso CanGet(Here + 1) Then
Dim NextChar As Char = Peek(Here + 1)
If MatchOneOrAnotherOrFullwidth(NextChar, "S"c, "s"c) Then
TypeCharacter = TypeCharacter.UShortLiteral
Here += 2
ElseIf MatchOneOrAnotherOrFullwidth(NextChar, "I"c, "i"c) Then
TypeCharacter = TypeCharacter.UIntegerLiteral
Here += 2
ElseIf MatchOneOrAnotherOrFullwidth(NextChar, "L"c, "l"c) Then
TypeCharacter = TypeCharacter.ULongLiteral
Here += 2
End If
End If
Case Else
If IsFullWidth(ch) Then
ch = MakeHalfWidth(ch)
GoTo FullWidthRepeat2
End If
End Select
End If
Dim IntegralValue As UInt64
Dim FloatingValue As Double
Dim DecimalValue As Decimal
Dim Overflows As Boolean = False
If literalKind = NumericLiteralKind.Integral Then
If IntegerLiteralStart = IntegerLiteralEnd Then
Return MakeBadToken(precedingTrivia, Here, ERRID.ERR_Syntax)
Else
IntegralValue = 0
If Base = LiteralBase.Decimal Then
For LiteralCharacter As Integer = IntegerLiteralStart To IntegerLiteralEnd - 1
Dim LiteralCharacterValue As Char = Peek(LiteralCharacter)
If LiteralCharacterValue = "_"c Then
Continue For
End If
Dim NextCharacterValue As UInteger = IntegralLiteralCharacterValue(LiteralCharacterValue)
If IntegralValue < 1844674407370955161UL OrElse
(IntegralValue = 1844674407370955161UL AndAlso NextCharacterValue <= 5UI) Then
IntegralValue = (IntegralValue * 10UL) + NextCharacterValue
Else
Overflows = True
Exit For
End If
Next
If TypeCharacter <> TypeCharacter.ULongLiteral AndAlso IntegralValue > Long.MaxValue Then
Overflows = True
End If
Else
Dim Shift As Integer = If(Base = LiteralBase.Hexadecimal, 4, If(Base = LiteralBase.Octal, 3, 1))
Dim OverflowMask As UInt64 = If(Base = LiteralBase.Hexadecimal, &HF000000000000000UL, If(Base = LiteralBase.Octal, &HE000000000000000UL, &H8000000000000000UL))
For LiteralCharacter As Integer = IntegerLiteralStart To IntegerLiteralEnd - 1
Dim LiteralCharacterValue As Char = Peek(LiteralCharacter)
If LiteralCharacterValue = "_"c Then
Continue For
End If
If (IntegralValue And OverflowMask) <> 0 Then
Overflows = True
End If
IntegralValue = (IntegralValue << Shift) + IntegralLiteralCharacterValue(LiteralCharacterValue)
Next
End If
If TypeCharacter = TypeCharacter.None Then
ElseIf TypeCharacter = TypeCharacter.Integer OrElse TypeCharacter = TypeCharacter.IntegerLiteral Then
If (Base = LiteralBase.Decimal AndAlso IntegralValue > &H7FFFFFFF) OrElse
IntegralValue > &HFFFFFFFFUI Then
Overflows = True
End If
ElseIf TypeCharacter = TypeCharacter.UIntegerLiteral Then
If IntegralValue > &HFFFFFFFFUI Then
Overflows = True
End If
ElseIf TypeCharacter = TypeCharacter.ShortLiteral Then
If (Base = LiteralBase.Decimal AndAlso IntegralValue > &H7FFF) OrElse
IntegralValue > &HFFFF Then
Overflows = True
End If
ElseIf TypeCharacter = TypeCharacter.UShortLiteral Then
If IntegralValue > &HFFFF Then
Overflows = True
End If
Else
Debug.Assert(TypeCharacter = TypeCharacter.Long OrElse
TypeCharacter = TypeCharacter.LongLiteral OrElse
TypeCharacter = TypeCharacter.ULongLiteral,
"Integral literal value computation is lost.")
End If
End If
Else
Dim scratch = GetScratch()
For i = 0 To literalWithoutTypeChar - 1
Dim curCh = Peek(i)
If curCh <> "_"c Then
scratch.Append(If(IsFullWidth(curCh), MakeHalfWidth(curCh), curCh))
End If
Next
Dim LiteralSpelling = GetScratchTextInterned(scratch)
If literalKind = NumericLiteralKind.Decimal Then
Overflows = Not GetDecimalValue(LiteralSpelling, DecimalValue)
Else
If TypeCharacter = TypeCharacter.Single OrElse TypeCharacter = TypeCharacter.SingleLiteral Then
Dim SingleValue As Single
If Not RealParser.TryParseFloat(LiteralSpelling, SingleValue) Then
Overflows = True
Else
FloatingValue = SingleValue
End If
Else
If Not RealParser.TryParseDouble(LiteralSpelling, FloatingValue) Then
Overflows = True
End If
End If
End If
End If
Dim result As SyntaxToken
Select Case literalKind
Case NumericLiteralKind.Integral
result = MakeIntegerLiteralToken(precedingTrivia, Base, TypeCharacter, If(Overflows Or UnderscoreInWrongPlace, 0UL, IntegralValue), Here)
Case NumericLiteralKind.Float
result = MakeFloatingLiteralToken(precedingTrivia, TypeCharacter, If(Overflows Or UnderscoreInWrongPlace, 0.0F, FloatingValue), Here)
Case NumericLiteralKind.Decimal
result = MakeDecimalLiteralToken(precedingTrivia, TypeCharacter, If(Overflows Or UnderscoreInWrongPlace, 0D, DecimalValue), Here)
Case Else
Throw ExceptionUtilities.UnexpectedValue(literalKind)
End Select
If Overflows Then
result = DirectCast(result.AddError(ErrorFactory.ErrorInfo(ERRID.ERR_Overflow)), SyntaxToken)
End If
If UnderscoreInWrongPlace Then
result = DirectCast(result.AddError(ErrorFactory.ErrorInfo(ERRID.ERR_Syntax)), SyntaxToken)
ElseIf LeadingUnderscoreUsed Then
result = CheckFeatureAvailability(result, Feature.LeadingDigitSeparator)
ElseIf UnderscoreUsed Then
result = CheckFeatureAvailability(result, Feature.DigitSeparators)
End If
If Base = LiteralBase.Binary Then
result = CheckFeatureAvailability(result, Feature.BinaryLiterals)
End If
Return result
End Function