// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.

{

//------------------------------------------------------------------------

// The Lexer. Some of the complication arises from the fact it is

// reused by the Visual Studio mode to do partial lexing reporting

// whitespace etc.

//-----------------------------------------------------------------------

open System

open System.Globalization

open System.Text

open Internal.Utilities.Library

open Internal.Utilities.Library.Extras

open FSharp.Compiler

open FSharp.Compiler.DiagnosticsLogger

open FSharp.Compiler.Features

open FSharp.Compiler.IO

open FSharp.Compiler.Syntax

open FSharp.Compiler.Text.Range

module Ranges =

/// Whether valid as signed int8 when a minus sign is prepended, compares true to 0x80

let isInt8BadMax x = 1 <<< 7 = x

/// Whether valid as signed int16 when a minus sign is prepended, compares true to 0x8000

let isInt16BadMax x = 1 <<< 15 = x

/// Whether valid as signed int32 when a minus sign is prepended, compares as string against "2147483648".

let isInt32BadMax = let max = string(1UL <<< 31) in fun s -> max = s

/// Whether valid as signed int64 when a minus sign is prepended, compares as string against "9223372036854775808".

let isInt64BadMax = let max = string(1UL <<< 63) in fun s -> max = s

/// Get string from lexbuf

let lexeme (lexbuf : UnicodeLexing.Lexbuf) = UnicodeLexing.Lexbuf.LexemeString lexbuf

/// Trim n chars from both sides of lexbuf, return string

let lexemeTrimBoth (lexbuf : UnicodeLexing.Lexbuf) (n:int) (m:int) =

let s = lexbuf.LexemeView

s.Slice(n, s.Length - (n+m)).ToString()

/// Trim n chars from the right of lexbuf, return string

let lexemeTrimRight lexbuf n = lexemeTrimBoth lexbuf 0 n

/// Trim n chars from the left of lexbuf, return string

let lexemeTrimLeft lexbuf n = lexemeTrimBoth lexbuf n 0

/// Throw a lexing error with a message

let fail args (lexbuf:UnicodeLexing.Lexbuf) msg dflt =

let m = lexbuf.LexemeRange

args.diagnosticsLogger.ErrorR(Error(msg,m))

dflt

//--------------------------

// Integer parsing

// Parsing integers is common in bootstrap runs (parsing

// the parser tables, no doubt). So this is an optimized

// version of the F# core library parsing code with the call to "Trim"

// removed, which appears in profiling runs as a small but significant cost.

let getSign32 (s:string) (p:byref<int>) l =

if (l >= p + 1 && s.[p] = '-')

then p <- p + 1; -1

else 1

let isOXB c =

let c = Char.ToLowerInvariant c

c = 'x' || c = 'o' || c = 'b'

let is0OXB (s:string) p l =

l >= p + 2 && s.[p] = '0' && isOXB s.[p+1]

let get0OXB (s:string) (p:byref<int>) l =

if is0OXB s p l

then let r = Char.ToLowerInvariant s.[p+1] in p <- p + 2; r

else 'd'

let parseBinaryUInt64 (s:string) =

Convert.ToUInt64(s, 2)

let parseOctalUInt64 (s:string) =

Convert.ToUInt64(s, 8)

let removeUnderscores (s:string) =

s.Replace("_", "")

let parseInt32 (s:string) =

let s = removeUnderscores s

let l = s.Length

let mutable p = 0

let sign = getSign32 s &p l

let specifier = get0OXB s &p l

match Char.ToLower(specifier,CultureInfo.InvariantCulture) with

| 'x' -> sign * (int32 (Convert.ToUInt32(UInt64.Parse(s.Substring(p), NumberStyles.AllowHexSpecifier,CultureInfo.InvariantCulture))))

| 'b' -> sign * (int32 (Convert.ToUInt32(parseBinaryUInt64 (s.Substring(p)))))

| 'o' -> sign * (int32 (Convert.ToUInt32(parseOctalUInt64 (s.Substring(p)))))

| _ -> Int32.Parse(s, NumberStyles.AllowLeadingSign, CultureInfo.InvariantCulture)

let lexemeTrimRightToInt32 args lexbuf n =

try parseInt32 (lexemeTrimRight lexbuf n)

with _ -> fail args lexbuf (FSComp.SR.lexOutsideIntegerRange()) 0

//--------------------------

// Checks

let checkExprOp (lexbuf:UnicodeLexing.Lexbuf) =

if lexbuf.LexemeContains ':' then

deprecatedWithError (FSComp.SR.lexCharNotAllowedInOperatorNames(":")) lexbuf.LexemeRange

if lexbuf.LexemeContains '$' then

deprecatedWithError (FSComp.SR.lexCharNotAllowedInOperatorNames("$")) lexbuf.LexemeRange

let unexpectedChar lexbuf =

LEX_FAILURE (FSComp.SR.lexUnexpectedChar(lexeme lexbuf))

let startString args (lexbuf: UnicodeLexing.Lexbuf) =

let buf = ByteBuffer.Create StringCapacity

let m = lexbuf.LexemeRange

let startp = lexbuf.StartPos

let fin =

LexerStringFinisher (fun buf kind context cont ->

// Adjust the start-of-token mark back to the true start of the token

lexbuf.StartPos <- startp

let isPart = context.HasFlag(LexerStringFinisherContext.InterpolatedPart)

let isVerbatim = context.HasFlag(LexerStringFinisherContext.Verbatim)

let isTripleQuote = context.HasFlag(LexerStringFinisherContext.TripleQuote)

if kind.IsByteString then

let synByteStringKind = if isVerbatim then SynByteStringKind.Verbatim else SynByteStringKind.Regular

if kind.IsInterpolated then

fail args lexbuf (FSComp.SR.lexByteStringMayNotBeInterpolated()) ()

BYTEARRAY (Lexhelp.stringBufferAsBytes buf, synByteStringKind, cont)

elif Lexhelp.stringBufferIsBytes buf then

BYTEARRAY (Lexhelp.stringBufferAsBytes buf, synByteStringKind, cont)

else

fail args lexbuf (FSComp.SR.lexByteArrayCannotEncode()) ()

BYTEARRAY (Lexhelp.stringBufferAsBytes buf, synByteStringKind, cont)

elif kind.IsInterpolated then

let s = Lexhelp.stringBufferAsString buf

if kind.IsInterpolatedFirst then

let synStringKind =

if isTripleQuote then

SynStringKind.TripleQuote

elif isVerbatim then

SynStringKind.Verbatim

else

SynStringKind.Regular

if isPart then

INTERP_STRING_BEGIN_PART (s, synStringKind, cont)

else

INTERP_STRING_BEGIN_END (s, synStringKind, cont)

else

if isPart then

INTERP_STRING_PART (s, cont)

else

INTERP_STRING_END (s, cont)

else

let s = Lexhelp.stringBufferAsString buf

let synStringKind =

if isVerbatim then

SynStringKind.Verbatim

elif isTripleQuote then

SynStringKind.TripleQuote

else

SynStringKind.Regular

STRING (s, synStringKind, cont))

buf,fin,m

// Utility functions for processing XML documentation

let trySaveXmlDoc (lexbuf: LexBuffer<char>) (buff: (range * StringBuilder) option) =

match buff with

| None -> ()

| Some (start, sb) ->

let xmlCommentLineRange = mkFileIndexRange start.FileIndex start.Start (posOfLexPosition lexbuf.StartPos)

LexbufLocalXmlDocStore.SaveXmlDocLine (lexbuf, sb.ToString(), xmlCommentLineRange)

let tryAppendXmlDoc (buff: (range * StringBuilder) option) (s:string) =

match buff with

| None -> ()

| Some (_, sb) -> ignore(sb.Append s)

// Utilities for parsing #if/#else/#endif

let shouldStartLine args lexbuf (m:range) err tok =

if (m.StartColumn <> 0) then fail args lexbuf err tok

else tok

let shouldStartFile args lexbuf (m:range) err tok =

if (m.StartColumn <> 0 || m.StartLine <> 1) then fail args lexbuf err tok

else tok

let evalIfDefExpression startPos reportLibraryOnlyFeatures langVersion strictIndentation args (lookup: string -> bool) (lexed: string) =

let lexbuf = LexBuffer<char>.FromChars (reportLibraryOnlyFeatures, langVersion, strictIndentation, lexed.ToCharArray ())

lexbuf.StartPos <- startPos

lexbuf.EndPos <- startPos

let tokenStream = FSharp.Compiler.PPLexer.tokenstream args

let expr = FSharp.Compiler.PPParser.start tokenStream lexbuf

(LexerIfdefEval lookup expr), expr

let evalFloat args lexbuf =

try

float32(removeUnderscores (lexemeTrimRight lexbuf 1))

with _ ->

fail args lexbuf (FSComp.SR.lexInvalidFloat()) 0.0f

}

let letter = '\Lu' | '\Ll' | '\Lt' | '\Lm' | '\Lo' | '\Nl'

let surrogateChar = '\Cs'

let digit = '\Nd'

let hex = ['0'-'9'] | ['A'-'F'] | ['a'-'f']

let truewhite = [' ']

let offwhite = ['\t']

let anywhite = truewhite | offwhite

let anychar = [^'\n''\r']

let anystring = anychar*

let op_char = '!'|'$'|'%'|'&'|'*'|'+'|'-'|'.'|'/'|'<'|'='|'>'|'?'|'@'|'^'|'|'|'~'|':'

let ignored_op_char = '.' | '$' | '?'

let separator = '_'

let xinteger =

( '0' ('x'| 'X') hex ((hex | separator)* hex)?

| '0' ('o'| 'O') (['0'-'7']) (((['0'-'7']) | separator)* (['0'-'7']))?

| '0' ('b'| 'B') (['0'-'1']) (((['0'-'1']) | separator)* (['0'-'1']))?)

let integer = digit ((digit | separator)* digit)?

let int8 = integer 'y'

let uint8 = (xinteger | integer) 'u' 'y'

let int16 = integer 's'

let uint16 = (xinteger | integer) 'u' 's'

let int = integer

let int32 = integer 'l'

let uint32 = (xinteger | integer) 'u'

let uint32l = (xinteger | integer) 'u' 'l'

let nativeint = (xinteger | integer) 'n'

let unativeint = (xinteger | integer) 'u' 'n'

let int64 = (xinteger | integer) 'L'

let uint64 = (xinteger | integer) ('u' | 'U') 'L'

let xint8 = xinteger 'y'

let xint16 = xinteger 's'

let xint = xinteger

let xint32 = xinteger 'l'

let floatp = digit ((digit | separator)* digit)? '.' (digit ((digit | separator)* digit)?)?

let floate = digit ((digit | separator)* digit)? ('.' (digit ((digit | separator)* digit)?)? )? ('e'| 'E') ['+' '-']? digit ((digit | separator)* digit)?

let float = floatp | floate

let bignum = integer ('I' | 'N' | 'Z' | 'Q' | 'R' | 'G')

let ieee64 = float

let ieee32 = float ('f' | 'F')

let ieee32_dotless_no_exponent = integer ('f' | 'F')

let decimal = (float | integer) ('m' | 'M')

let xieee32 = xinteger 'l' 'f'

let xieee64 = xinteger 'L' 'F'

let escape_char = ('\\' ( '\\' | "\"" | '\'' | 'a' | 'f' | 'v' | 'n' | 't' | 'b' | 'r'))

let char = '\'' ( [^'\\''\n''\r''\t''\b'] | escape_char) '\''

let trigraph = '\\' digit digit digit

let hexGraphShort = '\\' 'x' hex hex

let unicodeGraphShort = '\\' 'u' hex hex hex hex

let unicodeGraphLong = '\\' 'U' hex hex hex hex hex hex hex hex

let newline = ('\n' | '\r' '\n')

let connecting_char = '\Pc'

let combining_char = '\Mn' | '\Mc'

let formatting_char = '\Cf'

let ident_start_char =

letter | '_'

let ident_char =

letter

| connecting_char

| combining_char

| formatting_char

| digit

| ['\'']

let ident = ident_start_char ident_char*

rule token (args: LexArgs) (skip: bool) = parse

| ident

{ Keywords.KeywordOrIdentifierToken args lexbuf (lexeme lexbuf) }

| "do!"

{ DO_BANG }

| "yield!"

{ YIELD_BANG(true) }

| "return!"

{ YIELD_BANG(false) }

| "match!"

{ MATCH_BANG }

| "and!"

{ AND_BANG(false) }

| "while!"

{ WHILE_BANG }

| ident '!'

{ let tok = Keywords.KeywordOrIdentifierToken args lexbuf (lexemeTrimRight lexbuf 1)

match tok with

| LET _ -> BINDER (lexemeTrimRight lexbuf 1)

| _ -> fail args lexbuf (FSComp.SR.lexIdentEndInMarkReserved("!")) (Keywords.KeywordOrIdentifierToken args lexbuf (lexeme lexbuf)) }

| ident ('#')

{ fail args lexbuf (FSComp.SR.lexIdentEndInMarkReserved("#")) (Keywords.KeywordOrIdentifierToken args lexbuf (lexeme lexbuf)) }

| int8

{ let n = lexemeTrimRightToInt32 args lexbuf 1

// Allow <max_int+1> to parse as min_int. Allowed only because we parse '-' as an operator.

if Ranges.isInt8BadMax n then INT8(SByte.MinValue, true (* 'true' = 'bad'*) )

else if n > int SByte.MaxValue || n < int SByte.MinValue then fail args lexbuf (FSComp.SR.lexOutsideEightBitSigned()) (INT8(0y, false))

else INT8(sbyte n, false) }

| xint8

{ let n = lexemeTrimRightToInt32 args lexbuf 1

if n > int Byte.MaxValue || n < 0 then fail args lexbuf (FSComp.SR.lexOutsideEightBitSignedHex()) (INT8(0y, false))

else INT8(sbyte(byte(n)), false) }

| uint8

{ let n = lexemeTrimRightToInt32 args lexbuf 2

if n > int Byte.MaxValue || n < 0 then fail args lexbuf (FSComp.SR.lexOutsideEightBitUnsigned()) (UINT8(0uy))

else UINT8(byte n) }

| int16

{ let n = lexemeTrimRightToInt32 args lexbuf 1

// Allow <max_int+1> to parse as min_int. Allowed only because we parse '-' as an operator.

if Ranges.isInt16BadMax n then INT16(Int16.MinValue, true (* 'true' = 'bad'*) )

else if n > int Int16.MaxValue || n < int Int16.MinValue then fail args lexbuf (FSComp.SR.lexOutsideSixteenBitSigned()) (INT16(0s, false))

else INT16(int16 n, false) }

| xint16

{ let n = lexemeTrimRightToInt32 args lexbuf 1

if n > int UInt16.MaxValue || n < 0 then fail args lexbuf (FSComp.SR.lexOutsideSixteenBitSigned()) (INT16(0s,false))

else INT16(int16(uint16(n)), false) }

| uint16

{ let n = lexemeTrimRightToInt32 args lexbuf 2

if n > int UInt16.MaxValue || n < 0 then fail args lexbuf (FSComp.SR.lexOutsideSixteenBitUnsigned()) (UINT16(0us))

else UINT16(uint16 n) }

| int '.' '.'

{ let s = removeUnderscores (lexemeTrimRight lexbuf 2)

// Allow <max_int+1> to parse as min_int. Allowed only because we parse '-' as an operator.

if Ranges.isInt32BadMax s then INT32_DOT_DOT(Int32.MinValue, true (* 'true' = 'bad'*) ) else

let n = try int32 s with _ -> fail args lexbuf (FSComp.SR.lexOutsideThirtyTwoBitSigned()) 0

INT32_DOT_DOT(n, false)

}

| xint

| int

{ let s = removeUnderscores (lexeme lexbuf)

// Allow <max_int+1> to parse as min_int. Allowed only because we parse '-' as an operator.

if Ranges.isInt32BadMax s then INT32(Int32.MinValue, true (* 'true' = 'bad'*) ) else

let n =

try int32 s with _ -> fail args lexbuf (FSComp.SR.lexOutsideThirtyTwoBitSigned()) 0

INT32(n, false)

}

| xint32

| int32

{ let s = removeUnderscores (lexemeTrimRight lexbuf 1)

// Allow <max_int+1> to parse as min_int. Allowed only because we parse '-' as an operator.

if Ranges.isInt32BadMax s then INT32(Int32.MinValue, true (* 'true' = 'bad'*) ) else

let n =

try int32 s with _ -> fail args lexbuf (FSComp.SR.lexOutsideThirtyTwoBitSigned()) 0

INT32(n, false)

}

| uint32

{

let s = removeUnderscores (lexemeTrimRight lexbuf 1)

let n =

try int64 s with _ -> fail args lexbuf (FSComp.SR.lexOutsideThirtyTwoBitUnsigned()) 0L

if n > int64 UInt32.MaxValue || n < 0L then fail args lexbuf (FSComp.SR.lexOutsideThirtyTwoBitUnsigned()) (UINT32(0u)) else

UINT32(uint32 (uint64 n)) }

| uint32l

{

let s = removeUnderscores (lexemeTrimRight lexbuf 2)

let n =

try int64 s with _ -> fail args lexbuf (FSComp.SR.lexOutsideThirtyTwoBitUnsigned()) 0L

if n > int64 UInt32.MaxValue || n < 0L then fail args lexbuf (FSComp.SR.lexOutsideThirtyTwoBitUnsigned()) (UINT32(0u)) else

UINT32(uint32 (uint64 n)) }

| int64

{ let s = removeUnderscores (lexemeTrimRight lexbuf 1)

// Allow <max_int+1> to parse as min_int. Stupid but allowed because we parse '-' as an operator.

if Ranges.isInt64BadMax s then INT64(Int64.MinValue, true (* 'true' = 'bad'*) ) else

let n =

try int64 s with _ -> fail args lexbuf (FSComp.SR.lexOutsideSixtyFourBitSigned()) 0L

INT64(n,false)

}

| uint64

{ let s = removeUnderscores (lexemeTrimRight lexbuf 2)

let n =

try uint64 s with _ -> fail args lexbuf (FSComp.SR.lexOutsideSixtyFourBitUnsigned()) 0UL

UINT64(n) }

| nativeint

{ let s = removeUnderscores (lexemeTrimRight lexbuf 1)

// Allow <max_nativeint+1> to parse as min_nativeint. Stupid but allowed because we parse '-' as an operator.

if Ranges.isInt64BadMax s then NATIVEINT(Int64.MinValue, true) else

let n =

try int64 s with _ -> fail args lexbuf (FSComp.SR.lexOutsideNativeSigned()) 0L

NATIVEINT(n,false)

}

| unativeint

{ try

UNATIVEINT(uint64 (removeUnderscores (lexemeTrimRight lexbuf 2)))

with _ -> fail args lexbuf (FSComp.SR.lexOutsideNativeUnsigned()) (UNATIVEINT(0UL)) }

| ieee32

{ IEEE32 (evalFloat args lexbuf) }

| ieee32_dotless_no_exponent

{ if lexbuf.SupportsFeature LanguageFeature.DotlessFloat32Literal then

IEEE32 (evalFloat args lexbuf)

else

fail args lexbuf (FSComp.SR.lexInvalidFloat()) (IEEE32 0.0f)

}

| ieee64

{ IEEE64 (try float(lexeme lexbuf) with _ -> fail args lexbuf (FSComp.SR.lexInvalidFloat()) 0.0) }

| decimal

{ try

let s = removeUnderscores (lexemeTrimRight lexbuf 1)

// This implements a range check for decimal literals

let d = System.Decimal.Parse(s,System.Globalization.NumberStyles.AllowExponent ||| System.Globalization.NumberStyles.Number,System.Globalization.CultureInfo.InvariantCulture)

DECIMAL d

with

e -> fail args lexbuf (FSComp.SR.lexOusideDecimal()) (DECIMAL (decimal 0))

}

| xieee32

{

let s = removeUnderscores (lexemeTrimRight lexbuf 2)

// Even though the intermediate step is an int64, display the "invalid float" message, since it will be less confusing to the user

let n64 = (try (int64 s) with _ -> fail args lexbuf (FSComp.SR.lexInvalidFloat()) 0L)

if n64 > 0xFFFFFFFFL || n64 < 0L then fail args lexbuf (FSComp.SR.lexOusideThirtyTwoBitFloat()) (IEEE32 0.0f) else

IEEE32 (System.BitConverter.ToSingle(System.BitConverter.GetBytes(int32 (uint32 (uint64 n64))),0)) }

| xieee64

{

let n64 = (try int64 (removeUnderscores (lexemeTrimRight lexbuf 2)) with _ -> fail args lexbuf (FSComp.SR.lexInvalidFloat()) 0L)

IEEE64 (System.BitConverter.Int64BitsToDouble(n64)) }

| bignum

{ let s = lexeme lexbuf

BIGNUM (removeUnderscores (lexemeTrimRight lexbuf 1), s.[s.Length-1..s.Length-1]) }

| (int | xint | float) ident_char+

{ fail args lexbuf (FSComp.SR.lexInvalidNumericLiteral()) (INT32(0,false)) }

| char

{ let s = lexeme lexbuf

CHAR (if s.[1] = '\\' then escape s.[2] else s.[1]) }

| char 'B'

{ let s = lexeme lexbuf

let x = int32 (if s.[1] = '\\' then escape s.[2] else s.[1])

if x < 0 || x > 127 then

fail args lexbuf (FSComp.SR.lexInvalidByteLiteral()) (UINT8(byte 0))

else

UINT8 (byte(x)) }

| '\'' trigraph '\''

{ let s = lexeme lexbuf

let c = trigraph s.[2] s.[3] s.[4]

let x = int32 c

if x < 0 || x > 255 then

fail args lexbuf (FSComp.SR.lexInvalidCharLiteral()) (CHAR c)

else

CHAR c }

| '\'' trigraph '\'' 'B'

{ let s = lexeme lexbuf

let x = int32 (trigraph s.[2] s.[3] s.[4])

if x < 0 || x > 255 then

fail args lexbuf (FSComp.SR.lexInvalidByteLiteral()) (UINT8(byte 0))

else

UINT8 (byte(x)) }

| '\'' unicodeGraphShort '\'' 'B'

{ let x = int32 (unicodeGraphShort (lexemeTrimBoth lexbuf 3 2))

if x < 0 || x > 127 then

fail args lexbuf (FSComp.SR.lexInvalidByteLiteral()) (UINT8(byte 0))

else

UINT8 (byte(x)) }

| '\'' hexGraphShort '\'' { CHAR (char (int32 (hexGraphShort (lexemeTrimBoth lexbuf 3 1)))) }

| '\'' unicodeGraphShort '\'' { CHAR (char (int32 (unicodeGraphShort (lexemeTrimBoth lexbuf 3 1)))) }

| '\'' unicodeGraphLong '\''

{ match unicodeGraphLong (lexemeTrimBoth lexbuf 3 1) with

| SingleChar(c) -> CHAR (char c)

| _ -> fail args lexbuf (FSComp.SR.lexThisUnicodeOnlyInStringLiterals()) (CHAR (char 0)) }

| "(*IF-FSHARP"

{ if lexbuf.SupportsFeature LanguageFeature.MLCompatRevisions then

mlCompatWarning (FSComp.SR.lexIndentOffForML()) lexbuf.LexemeRange

if not skip then COMMENT (LexCont.Token (args.ifdefStack, args.stringNest))

else token args skip lexbuf }

| "(*F#"

{ if not skip then COMMENT (LexCont.Token (args.ifdefStack, args.stringNest))

else token args skip lexbuf }

| "ENDIF-FSHARP*)"

{ if not skip then COMMENT (LexCont.Token (args.ifdefStack, args.stringNest))

else token args skip lexbuf }

| "F#*)"

{ if not skip then COMMENT (LexCont.Token (args.ifdefStack, args.stringNest))

else token args skip lexbuf }

| "(*)"

{ LPAREN_STAR_RPAREN }

| "(*"

{ let m = lexbuf.LexemeRange

if not skip then COMMENT (LexCont.Comment(args.ifdefStack, args.stringNest, 1, m))

else comment (1,m,args) skip lexbuf }

| "(*IF-CAML*)" | "(*IF-OCAML*)"

{ let m = lexbuf.LexemeRange

if not skip then COMMENT (LexCont.MLOnly(args.ifdefStack, args.stringNest, m))

else mlOnly m args skip lexbuf }

| '"'

{ let buf, fin, m = startString args lexbuf

// Single quote in triple quote ok, others disallowed

match args.stringNest with

| (_, LexerStringStyle.ExtendedInterpolated, _, _) :: _

| (_, LexerStringStyle.TripleQuote, _, _) :: _ -> ()

| _ :: _ -> errorR(Error(FSComp.SR.lexSingleQuoteInSingleQuote(), m))

| [] -> ()

if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.SingleQuote, LexerStringKind.String, args.interpolationDelimiterLength, m))

else singleQuoteString (buf, fin, m, LexerStringKind.String, args) skip lexbuf }

| '$' '"' '"' '"'

{ let buf, fin, m = startString args lexbuf

// Single quote in triple quote ok, others disallowed

match args.stringNest with

| _ :: _ -> errorR(Error(FSComp.SR.lexTripleQuoteInTripleQuote(), m))

| [] -> ()

args.interpolationDelimiterLength <- 1

if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.TripleQuote, LexerStringKind.InterpolatedStringFirst, 1, m))

else tripleQuoteString (buf, fin, m, LexerStringKind.InterpolatedStringFirst, args) skip lexbuf }

| ('$'+) '"' '"' '"'

{ let buf, fin, m = startString args lexbuf

if lexbuf.SupportsFeature LanguageFeature.ExtendedStringInterpolation then

// Single quote in triple quote ok, others disallowed

match args.stringNest with

| _ :: _ -> errorR(Error(FSComp.SR.lexTripleQuoteInTripleQuote(), m))

| [] -> ()

args.interpolationDelimiterLength <- lexeme lexbuf |> Seq.takeWhile (fun c -> c = '$') |> Seq.length

if not skip then

STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.ExtendedInterpolated, LexerStringKind.InterpolatedStringFirst, args.interpolationDelimiterLength, m))

else

extendedInterpolatedString (buf, fin, m, LexerStringKind.InterpolatedStringFirst, args) skip lexbuf

else

let result =

if not skip then

STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.TripleQuote, LexerStringKind.InterpolatedStringFirst, args.interpolationDelimiterLength, m))

else

tripleQuoteString (buf, fin, m, LexerStringKind.InterpolatedStringFirst, args) skip lexbuf

fail args lexbuf (FSComp.SR.lexExtendedStringInterpolationNotSupported()) result

}

| '$' '"'

{ let buf,fin,m = startString args lexbuf

// Single quote in triple quote ok, others disallowed

match args.stringNest with

| (_, style, _, _) :: _ when style = LexerStringStyle.ExtendedInterpolated || style = LexerStringStyle.TripleQuote -> ()

| _ :: _ -> errorR(Error(FSComp.SR.lexSingleQuoteInSingleQuote(), m))

| _ -> ()

if not skip then

STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.SingleQuote, LexerStringKind.InterpolatedStringFirst, args.interpolationDelimiterLength, m))

else

singleQuoteString (buf, fin, m, LexerStringKind.InterpolatedStringFirst, args) skip lexbuf }

| '"' '"' '"'

{ let buf, fin, m = startString args lexbuf

args.interpolationDelimiterLength <- 0

// Single quote in triple quote ok, others disallowed

match args.stringNest with

| _ :: _ -> errorR(Error(FSComp.SR.lexTripleQuoteInTripleQuote(), m))

| _ -> ()

if not skip then

STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.TripleQuote, LexerStringKind.String, args.interpolationDelimiterLength, m))

else

tripleQuoteString (buf, fin, m, LexerStringKind.String, args) skip lexbuf }

| '@' '"'

{ let buf, fin, m = startString args lexbuf

// Single quote in triple quote ok, others disallowed

match args.stringNest with

| (_, LexerStringStyle.ExtendedInterpolated, _, _) :: _

| (_, LexerStringStyle.TripleQuote, _, _) :: _ -> ()

| _ :: _ -> errorR(Error(FSComp.SR.lexSingleQuoteInSingleQuote(), m))

| _ -> ()

if not skip then

STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.Verbatim, LexerStringKind.String, args.interpolationDelimiterLength, m))

else

verbatimString (buf, fin, m, LexerStringKind.String, args) skip lexbuf }

| ("$@" | "@$") '"'

{ let buf, fin, m = startString args lexbuf

// Single quote in triple quote ok, others disallowed

match args.stringNest with

| (_, style, _, _) :: _ when style = LexerStringStyle.ExtendedInterpolated || style = LexerStringStyle.TripleQuote -> ()

| _ :: _ -> errorR(Error(FSComp.SR.lexSingleQuoteInSingleQuote(), m))

| _ -> ()

if not skip then

STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.Verbatim, LexerStringKind.InterpolatedStringFirst, args.interpolationDelimiterLength, m))

else

verbatimString (buf, fin, m, LexerStringKind.InterpolatedStringFirst, args) skip lexbuf }

| truewhite+

{ if skip then token args skip lexbuf

else WHITESPACE (LexCont.Token(args.ifdefStack, args.stringNest)) }

| offwhite+

{ if args.indentationSyntaxStatus.Status then errorR(Error(FSComp.SR.lexTabsNotAllowed(), lexbuf.LexemeRange))

if not skip then WHITESPACE (LexCont.Token(args.ifdefStack, args.stringNest))

else token args skip lexbuf }

| "////" op_char*

{ // 4+ slash are 1-line comments, online 3 slash are XmlDoc

let m = lexbuf.LexemeRange

LexbufLocalXmlDocStore.AddGrabPointDelayed(lexbuf)

if not skip then LINE_COMMENT (LexCont.SingleLineComment(args.ifdefStack, args.stringNest, 1, m))

else singleLineComment (None,1,m,m,args) skip lexbuf }

| "///" op_char*

{ // Match exactly 3 slash, 4+ slash caught by preceding rule

let m = lexbuf.LexemeRange

let doc = lexemeTrimLeft lexbuf 3

let sb = (new StringBuilder(100)).Append(doc)

if not skip then LINE_COMMENT (LexCont.SingleLineComment(args.ifdefStack, args.stringNest, 1, m))

else singleLineComment (Some (m, sb),1,m,m,args) skip lexbuf }

| "//" op_char*

{ // Need to read all operator symbols too, otherwise it might be parsed by a rule below

let m = lexbuf.LexemeRange

LexbufLocalXmlDocStore.AddGrabPointDelayed(lexbuf)

if not skip then LINE_COMMENT (LexCont.SingleLineComment(args.ifdefStack, args.stringNest, 1, m))

else singleLineComment (None,1,m,m,args) skip lexbuf }

| newline

{ newline lexbuf

if not skip then WHITESPACE (LexCont.Token(args.ifdefStack, args.stringNest))

else token args skip lexbuf }

| '`' '`' ([^'`' '\n' '\r' '\t'] | '`' [^'`''\n' '\r' '\t'])+ '`' '`'

{ Keywords.IdentifierToken args lexbuf (lexemeTrimBoth lexbuf 2 2) }

| '`' '`' (([^'`' '\n' '\r' '\t'] | ('`' [^'`' '\n' '\r' '\t']))+)'`'

{ errorR(Error(FSComp.SR.lexInvalidIdentifier(), lexbuf.LexemeRange))

Keywords.IdentifierToken args lexbuf (lexemeTrimBoth lexbuf 2 1) }

| '`' '`' (([^'`' '\n' '\r' '\t'] | ('`'[^'`' '\n' '\r' '\t']))+)

{ errorR(Error(FSComp.SR.lexInvalidIdentifier(), lexbuf.LexemeRange))

Keywords.IdentifierToken args lexbuf (lexemeTrimLeft lexbuf 2) }

| "````" | "```" | "``" | "`"

{ errorR(Error(FSComp.SR.lexInvalidIdentifier(), lexbuf.LexemeRange))

Keywords.IdentifierToken args lexbuf "" }

| ('#' anywhite* | "#line" anywhite+ ) digit+ anywhite* ('@'? "\"" [^'\n''\r''"']+ '"')? anywhite* newline

{ let pos = lexbuf.EndPos

if skip then

let s = lexeme lexbuf

let rec parseLeadingDirective n =

match s.[n] with

| c when c >= 'a' && c <= 'z' -> parseLeadingDirective (n+1)

| _ -> parseLeadingWhitespace n // goto the next state

and parseLeadingWhitespace n =

match s.[n] with

| ' ' | '\t' -> parseLeadingWhitespace (n+1)

| _ -> parseLineNumber n n // goto the next state

and parseLineNumber start n =

match s.[n] with

| c when c >= '0' && c <= '9' -> parseLineNumber start (n+1)

| _ ->

let text = String.sub s start (n-start)

let lineNumber =

try

int32 text

with err ->

errorR(Error(FSComp.SR.lexInvalidLineNumber(text), lexbuf.LexemeRange))

0

lineNumber, parseWhitespaceBeforeFile n // goto the next state

and parseWhitespaceBeforeFile n =

match s.[n] with

| ' ' | '\t' | '@' -> parseWhitespaceBeforeFile (n+1)

| '"' -> Some (parseFile (n+1) (n+1))

| _ -> None

and parseFile start n =

match s.[n] with

| '"' -> String.sub s start (n-start)

| _ -> parseFile start (n+1)

// Call the parser

let line, file = parseLeadingDirective 1

// Construct the new position

if args.applyLineDirectives then

lexbuf.EndPos <- pos.ApplyLineDirective((match file with Some f -> FileIndex.fileIndexOfFile f | None -> pos.FileIndex), line)

else

// add a newline when we don't apply a directive since we consumed a newline getting here

newline lexbuf

token args skip lexbuf

else

// add a newline when we don't apply a directive since we consumed a newline getting here

newline lexbuf

HASH_LINE (LexCont.Token (args.ifdefStack, args.stringNest))

}

| "<@" { checkExprOp lexbuf; LQUOTE ("<@ @>", false) }

| "<@@" { checkExprOp lexbuf; LQUOTE ("<@@ @@>", true) }

| "@>" { checkExprOp lexbuf; RQUOTE ("<@ @>", false) }

| "@@>" { checkExprOp lexbuf; RQUOTE ("<@@ @@>", true) }

| '#' { HASH }

| '&' { AMP }

| "&&" { AMP_AMP }

| "||" { BAR_BAR }

| '\'' { QUOTE }

| '(' { LPAREN }

| ')' { RPAREN }

| '*' { STAR }

| ',' { COMMA }

| "->" { RARROW }

| "?" { QMARK }

| "??" { QMARK_QMARK }

| ".." { DOT_DOT }

| "..^" { DOT_DOT_HAT }

| "." { DOT }

| ":" { COLON }

| "::" { COLON_COLON }

| ":>" { COLON_GREATER }

| "@>." { RQUOTE_DOT ("<@ @>",false) }

| "@@>." { RQUOTE_DOT ("<@@ @@>",true) }

| ">|]" { GREATER_BAR_RBRACK }

| ":?>" { COLON_QMARK_GREATER }

| ":?" { COLON_QMARK }

| ":=" { COLON_EQUALS }

| ";;" { SEMICOLON_SEMICOLON }

| ";" { SEMICOLON }

| "<-" { LARROW }

| "=" { EQUALS }

| "[" { LBRACK }

| "[|" { LBRACK_BAR }

| "{|" { LBRACE_BAR }

| "<" { LESS false }

| ">" { GREATER false }

| "[<" { LBRACK_LESS }

| "]" { RBRACK }

| "|]" { BAR_RBRACK }

| "|}" { BAR_RBRACE }

| ">]" { GREATER_RBRACK }

| "{"

{

match args.stringNest with

| [] -> ()

| (counter, style, d, m) :: rest ->

// Note, we do not update the 'm', any incomplete-interpolation error

// will be reported w.r.t. the first '{'

args.stringNest <- (counter + 1, style, d, m) :: rest

// To continue token-by-token lexing may involve picking up the new args.stringNes

let cont = LexCont.Token(args.ifdefStack, args.stringNest)

LBRACE cont

}

| "|" { BAR }

| "}"

{

// We encounter a '}' in the expression token stream. First check if we're in an interpolated string expression

// and continue the string if necessary

match args.stringNest with

| (1, LexerStringStyle.ExtendedInterpolated, delimLength, r) :: rest when delimLength > 1 ->

args.stringNest <- (1, LexerStringStyle.ExtendedInterpolated, delimLength - 1, r) :: rest

token args skip lexbuf

| (1, style, _, _) :: rest ->

args.stringNest <- rest

let buf, fin, m = startString args lexbuf

if not skip then

STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, style, LexerStringKind.InterpolatedStringPart, args.interpolationDelimiterLength, m))

else

match style with

| LexerStringStyle.Verbatim -> verbatimString (buf, fin, m, LexerStringKind.InterpolatedStringPart, args) skip lexbuf

| LexerStringStyle.SingleQuote -> singleQuoteString (buf, fin, m, LexerStringKind.InterpolatedStringPart, args) skip lexbuf

| LexerStringStyle.TripleQuote -> tripleQuoteString (buf, fin, m, LexerStringKind.InterpolatedStringPart, args) skip lexbuf

| LexerStringStyle.ExtendedInterpolated -> extendedInterpolatedString (buf, fin, m, LexerStringKind.InterpolatedStringPart, args) skip lexbuf

| (counter, style, d, m) :: rest ->

// Note, we do not update the 'm', any incomplete-interpolation error

// will be reported w.r.t. the first '{'

args.stringNest <- (counter - 1, style, d, m) :: rest

let cont = LexCont.Token(args.ifdefStack, args.stringNest)

RBRACE cont

| _ ->

let cont = LexCont.Token(args.ifdefStack, args.stringNest)

RBRACE cont

}

| "$" { DOLLAR }

| "%" { PERCENT_OP("%") }

| "%%" { PERCENT_OP("%%") }

| "-" { MINUS }

| "~" { RESERVED }

| ignored_op_char* '*' '*' op_char* { checkExprOp lexbuf; INFIX_STAR_STAR_OP(lexeme lexbuf) }

| ignored_op_char* ('*' | '/'|'%') op_char* { checkExprOp lexbuf; INFIX_STAR_DIV_MOD_OP(lexeme lexbuf) }

| ignored_op_char* ('+'|'-') op_char* { checkExprOp lexbuf; PLUS_MINUS_OP(lexeme lexbuf) }

| ignored_op_char* ('@'|'^') op_char* { checkExprOp lexbuf; INFIX_AT_HAT_OP(lexeme lexbuf) }

| ignored_op_char* ('=' | "!=" | '<' | '>' | '$') op_char* { checkExprOp lexbuf; INFIX_COMPARE_OP(lexeme lexbuf) }

| ignored_op_char* ('&') op_char* { checkExprOp lexbuf; INFIX_AMP_OP(lexeme lexbuf) }

| ignored_op_char* '|' op_char* { checkExprOp lexbuf; INFIX_BAR_OP(lexeme lexbuf) }

| ignored_op_char* ('!' | '~' ) op_char* { checkExprOp lexbuf; PREFIX_OP(lexeme lexbuf) }

| ".[]" | ".[]<-" | ".[,]<-" | ".[,,]<-" | ".[,,,]<-" | ".[,,,]" | ".[,,]" | ".[,]" | ".[..]" | ".[..,..]" | ".[..,..,..]" | ".[..,..,..,..]"

| ".()" | ".()<-" { FUNKY_OPERATOR_NAME(lexeme lexbuf) }

| "#!" op_char*

{ // Treat shebangs like regular comments, but they are only allowed at the start of a file

let m = lexbuf.LexemeRange

let tok = LINE_COMMENT (LexCont.SingleLineComment(args.ifdefStack, args.stringNest, 1, m))

let tok = shouldStartFile args lexbuf m (0,FSComp.SR.lexHashBangMustBeFirstInFile()) tok

if not skip then tok else singleLineComment (None,1,m,m,args) skip lexbuf }

| "#light" anywhite*

| ("#indent" | "#light") anywhite+ "\"on\""

{ if args.indentationSyntaxStatus.ExplicitlySet && args.indentationSyntaxStatus.WarnOnMultipleTokens then

let s = lexeme lexbuf

warning(Error((0, sprintf "%s should only be set once in an F# source file." s), lexbuf.LexemeRange))

// TODO: where should this go? (abelb)

//warning(Error((0,"#light should only occur as the first non-comment text in an F# source file."), lexbuf.LexemeRange))

args.indentationSyntaxStatus.Status <- true

if not skip then HASH_LIGHT (LexCont.Token(args.ifdefStack, args.stringNest))

else token args skip lexbuf }

| ("#indent" | "#light") anywhite+ "\"off\""

{ args.indentationSyntaxStatus.Status <- false

if lexbuf.SupportsFeature LanguageFeature.MLCompatRevisions then

mlCompatError (FSComp.SR.mlCompatLightOffNoLongerSupported()) lexbuf.LexemeRange

else

mlCompatWarning (FSComp.SR.lexIndentOffForML()) lexbuf.LexemeRange

if not skip then HASH_LIGHT (LexCont.Token (args.ifdefStack, args.stringNest))

else token args skip lexbuf }

| anywhite* "#if" anywhite+ anystring

{ let m = lexbuf.LexemeRange

let lookup id = List.contains id args.conditionalDefines

let lexed = lexeme lexbuf

let isTrue, expr = evalIfDefExpression lexbuf.StartPos lexbuf.ReportLibraryOnlyFeatures lexbuf.LanguageVersion lexbuf.StrictIndentation args lookup lexed

args.ifdefStack <- (IfDefIf,m) :: args.ifdefStack

LexbufIfdefStore.SaveIfHash(lexbuf, lexed, expr, m)

// Get the token; make sure it starts at zero position & return

let cont, f =

if isTrue then

let cont = LexCont.EndLine(args.ifdefStack, args.stringNest, LexerEndlineContinuation.Token)

let f = endline LexerEndlineContinuation.Token args skip

cont, f