diff --git a/src/fsharp/CheckFormatStrings.fs b/src/fsharp/CheckFormatStrings.fs
index 4b09c88665e..8ef9d1a68c8 100644
--- a/src/fsharp/CheckFormatStrings.fs
+++ b/src/fsharp/CheckFormatStrings.fs
@@ -2,9 +2,11 @@
module internal FSharp.Compiler.CheckFormatStrings
+open System.Text
open FSharp.Compiler
open FSharp.Compiler.AbstractIL.Internal.Library
open FSharp.Compiler.ConstraintSolver
+open FSharp.Compiler.Lib
open FSharp.Compiler.NameResolution
open FSharp.Compiler.Range
open FSharp.Compiler.SyntaxTree
@@ -47,31 +49,153 @@ let newInfo () =
addZeros = false
precision = false}
-let parseFormatStringInternal (m:range) (g: TcGlobals) (context: FormatStringCheckContext option) fmt bty cty =
- // Offset is used to adjust ranges depending on whether input string is regular, verbatim or triple-quote.
- // We construct a new 'fmt' string since the current 'fmt' string doesn't distinguish between "\n" and escaped "\\n".
- let (offset, fmt) =
+let parseFormatStringInternal (m: range) (fragRanges: range list) (g: TcGlobals) isInterpolated isFormattableString (context: FormatStringCheckContext option) fmt printerArgTy printerResidueTy =
+
+ // As background: the F# compiler tokenizes strings on the assumption that the only thing you need from
+ // them is the actual corresponding text, e.g. of a string literal. This means many different textual input strings
+ // in the input file correspond to the 'fmt' string we have here.
+ //
+ // The problem with this is that when we go to colorize the format specifiers in string, we need to do
+ // that with respect to the original string source text in order to lay down accurate colorizations.
+ //
+ // One approach would be to change the F# lexer to also crack every string in a more structured way, recording
+ // both the original source text and the actual string literal. However this would be invasive and possibly
+ // too expensive since the vast majority of strings don't need this treatment.
+ //
+ // So instead, for format strings alone - and only when processing in the IDE - we crack the "original"
+ // source of the string by going back and getting the format string from the input source file by using the
+ // relevant ranges
+ //
+ // For interpolated strings this may involve many fragments, e.g.
+ // $"abc %d{"
+ // "} def %s{"
+ // "} xyz"
+ // In this case we are given the range of each fragment. One annoying thing is that we must lop off the
+ // quotations, $, {, } symbols off the end of each string fragment. This information should probably
+ // be given to us by the lexer.
+ //
+ // Note this also means that when compiling (command-line or background IncrementalBuilder in the IDE
+ // there are no accurate intra-string ranges available for exact error message locations within the string.
+ // The 'm' range passed as an input is however accurate and covers the whole string.
+ ///
+ let fmt, fragments =
+
+ //printfn "--------------------"
+ //printfn "context.IsSome = %b" context.IsSome
+ //printfn "fmt = <<<%s>>>" fmt
+ //printfn "isInterpolated = %b" isInterpolated
+ //printfn "fragRanges = %A" fragRanges
+
match context with
- | Some context ->
+ | Some context when fragRanges.Length > 0 ->
let sourceText = context.SourceText
+ //printfn "sourceText.IsSome = %b" sourceText.IsSome
let lineStartPositions = context.LineStartPositions
+ //printfn "lineStartPositions.Length = %d" lineStartPositions.Length
let length = sourceText.Length
- if m.EndLine < lineStartPositions.Length then
- let startIndex = lineStartPositions.[m.StartLine-1] + m.StartColumn
- let endIndex = lineStartPositions.[m.EndLine-1] + m.EndColumn - 1
- if startIndex < length-3 && sourceText.SubTextEquals("\"\"\"", startIndex) then
- (3, sourceText.GetSubTextString(startIndex + 3, endIndex - startIndex))
- elif startIndex < length-2 && sourceText.SubTextEquals("@\"", startIndex) then
- (2, sourceText.GetSubTextString(startIndex + 2, endIndex + 1 - startIndex))
- else (1, sourceText.GetSubTextString(startIndex + 1, endIndex - startIndex))
- else (1, fmt)
- | None -> (1, fmt)
-
- let len = String.length fmt
+ let numFrags = fragRanges.Length
+ let fmts =
+ [ for i, fragRange in List.indexed fragRanges do
+ let m = fragRange
+ //printfn "m.EndLine = %d" m.EndLine
+ if m.StartLine - 1 < lineStartPositions.Length && m.EndLine - 1 < lineStartPositions.Length then
+ let startIndex = lineStartPositions.[m.StartLine-1] + m.StartColumn
+ let endIndex = lineStartPositions.[m.EndLine-1] + m.EndColumn
+ // Note, some extra """ text may be included at end of these snippets, meaning CheckFormatString in the IDE
+ // may be using a slightly false format string to colorize the %d markers. This doesn't matter as there
+ // won't be relevant %d in these sections
+ //
+ // However we make an effort to remove these to keep the calls to GetSubStringText valid. So
+ // we work out how much extra text there is at the end of the last line of the fragment,
+ // which may or may not be quote markers. If there's no flex, we don't trim the quote marks
+ let endNextLineIndex = if m.EndLine < lineStartPositions.Length then lineStartPositions.[m.EndLine] else endIndex
+ let endIndexFlex = endNextLineIndex - endIndex
+ let mLength = endIndex - startIndex
+
+ //let startIndex2 = if m.StartLine < lineStartPositions.Length then lineStartPositions.[m.StartLine] else startIndex
+ //let sourceLineFromOffset = sourceText.GetSubTextString(startIndex, (startIndex2 - startIndex))
+ //printfn "i = %d, mLength = %d, endIndexFlex = %d, sourceLineFromOffset = <<<%s>>>" i mLength endIndexFlex sourceLineFromOffset
+
+ if isInterpolated && i=0 && startIndex < length-4 && sourceText.SubTextEquals("$\"\"\"", startIndex) then
+ // Take of the ending triple quote or '{'
+ let fragLength = mLength - 4 - min endIndexFlex (if i = numFrags-1 then 3 else 1)
+ (4, sourceText.GetSubTextString(startIndex + 4, fragLength), m)
+ elif not isInterpolated && i=0 && startIndex < length-3 && sourceText.SubTextEquals("\"\"\"", startIndex) then
+ // Take of the ending triple quote or '{'
+ let fragLength = mLength - 2 - min endIndexFlex (if i = numFrags-1 then 3 else 1)
+ (3, sourceText.GetSubTextString(startIndex + 3, fragLength), m)
+ elif isInterpolated && i=0 && startIndex < length-3 && sourceText.SubTextEquals("$@\"", startIndex) then
+ // Take of the ending quote or '{', always length 1
+ let fragLength = mLength - 3 - min endIndexFlex 1
+ (3, sourceText.GetSubTextString(startIndex + 3, fragLength), m)
+ elif isInterpolated && i=0 && startIndex < length-3 && sourceText.SubTextEquals("@$\"", startIndex) then
+ // Take of the ending quote or '{', always length 1
+ let fragLength = mLength - 3 - min endIndexFlex 1
+ (3, sourceText.GetSubTextString(startIndex + 3, fragLength), m)
+ elif not isInterpolated && i=0 && startIndex < length-2 && sourceText.SubTextEquals("@\"", startIndex) then
+ // Take of the ending quote or '{', always length 1
+ let fragLength = mLength - 2 - min endIndexFlex 1
+ (2, sourceText.GetSubTextString(startIndex + 2, fragLength), m)
+ elif isInterpolated && i=0 && startIndex < length-2 && sourceText.SubTextEquals("$\"", startIndex) then
+ // Take of the ending quote or '{', always length 1
+ let fragLength = mLength - 2 - min endIndexFlex 1
+ (2, sourceText.GetSubTextString(startIndex + 2, fragLength), m)
+ elif isInterpolated && i <> 0 && startIndex < length-1 && sourceText.SubTextEquals("}", startIndex) then
+ // Take of the ending quote or '{', always length 1
+ let fragLength = mLength - 1 - min endIndexFlex 1
+ (1, sourceText.GetSubTextString(startIndex + 1, fragLength), m)
+ else
+ // Take of the ending quote or '{', always length 1
+ let fragLength = mLength - 1 - min endIndexFlex 1
+ (1, sourceText.GetSubTextString(startIndex + 1, fragLength), m)
+ else (1, fmt, m) ]
+
+ //printfn "fmts = %A" fmts
+
+ // Join the fragments with holes. Note this join is only used on the IDE path,
+ // the TypeChecker.fs does its own joining with the right alignments etc. substituted
+ // On the IDE path we don't do any checking of these in this file (some checking is
+ // done in TypeChecker.fs) so it's ok to join with just '%P()'.
+ let fmt = fmts |> List.map p23 |> String.concat "%P()"
+ let fragments, _ =
+ (0, fmts) ||> List.mapFold (fun i (offset, fmt, fragRange) ->
+ (i, offset, fragRange), i + fmt.Length + 4) // the '4' is the length of '%P()' joins
+
+ //printfn "fmt2 = <<<%s>>>" fmt
+ //printfn "fragments = %A" fragments
+ fmt, fragments
+ | _ ->
+ // Don't muck with the fmt when there is no source code context to go get the original
+ // source code (i.e. when compiling or background checking)
+ fmt, [ (0, 1, m) ]
+
+ let len = fmt.Length
let specifierLocations = ResizeArray()
- let rec parseLoop acc (i, relLine, relCol) =
+ // For FormattableString we collect a .NET Format String with {0} etc. replacing text. '%%' are replaced
+ // by '%', we check there are no '%' formats, and '{{' and '}}' are *not* replaced since the subsequent
+ // call to String.Format etc. will process them.
+ let dotnetFormatString = StringBuilder()
+ let appendToDotnetFormatString (s: string) = dotnetFormatString.Append(s) |> ignore
+ let mutable dotnetFormatStringInterpolationHoleCount = 0
+ let percentATys = ResizeArray<_>()
+
+ // fragLine, fragCol - track our location w.r.t. the marker for the start of this chunk
+ //
+ let rec parseLoop acc (i, fragLine, fragCol) fragments =
+
+ // Check if we've moved into the next fragment. Note this will always activate on
+ // the first step, i.e. when i=0
+ let (struct (fragLine, fragCol, fragments)) =
+ match fragments with
+ | (idx, fragOffset, fragRange: range)::rest when i >= idx ->
+ //printfn "i = %d, idx = %d, moving into next fragment at %A plus fragOffset %d" i idx fragRange fragOffset
+ struct (fragRange.StartLine, fragRange.StartColumn + fragOffset, rest)
+
+ | _ -> struct (fragLine, fragCol, fragments)
+ //printfn "parseLoop: i = %d, fragLine = %d, fragCol = %d" i fragLine fragCol
+
if i >= len then
let argtys =
if acc |> List.forall (fun (p, _) -> p = None) then // without positional specifiers
@@ -80,13 +204,14 @@ let parseFormatStringInternal (m:range) (g: TcGlobals) (context: FormatStringChe
failwithf "%s" <| FSComp.SR.forPositionalSpecifiersNotPermitted()
argtys
elif System.Char.IsSurrogatePair(fmt,i) then
- parseLoop acc (i+2, relLine, relCol+2)
+ appendToDotnetFormatString (fmt.[i..i+1])
+ parseLoop acc (i+2, fragLine, fragCol+2) fragments
else
let c = fmt.[i]
match c with
| '%' ->
- let startCol = relCol
- let relCol = relCol+1
+ let startFragCol = fragCol
+ let fragCol = fragCol+1
let i = i+1
if i >= len then failwithf "%s" <| FSComp.SR.forMissingFormatSpecifier()
let info = newInfo()
@@ -110,7 +235,7 @@ let parseFormatStringInternal (m:range) (g: TcGlobals) (context: FormatStringChe
if info.numPrefixIfPos <> None then failwithf "%s" <| FSComp.SR.forPrefixFlagSpacePlusSetTwice()
info.numPrefixIfPos <- Some ' '
flags(i+1)
- | '#' -> failwithf "%s" <| FSComp.SR.forHashSpecifierIsInvalid()
+ | '#' -> failwithf "%s" <| FSComp.SR.forHashSpecifierIsInvalid()
| _ -> i
let rec digitsPrecision i =
@@ -132,18 +257,18 @@ let parseFormatStringInternal (m:range) (g: TcGlobals) (context: FormatStringChe
| '.' -> precision (i+1)
| _ -> false,i
- let rec digitsWidthAndPrecision i =
+ let rec digitsWidthAndPrecision n i =
if i >= len then failwithf "%s" <| FSComp.SR.forBadPrecision()
match fmt.[i] with
- | c when System.Char.IsDigit c -> digitsWidthAndPrecision (i+1)
- | _ -> optionalDotAndPrecision i
+ | c when System.Char.IsDigit c -> digitsWidthAndPrecision (n*10 + int c - int '0') (i+1)
+ | _ -> Some n, optionalDotAndPrecision i
let widthAndPrecision i =
if i >= len then failwithf "%s" <| FSComp.SR.forBadPrecision()
match fmt.[i] with
- | c when System.Char.IsDigit c -> false,digitsWidthAndPrecision i
- | '*' -> true,optionalDotAndPrecision (i+1)
- | _ -> false,optionalDotAndPrecision i
+ | c when System.Char.IsDigit c -> false,digitsWidthAndPrecision 0 i
+ | '*' -> true, (None, optionalDotAndPrecision (i+1))
+ | _ -> false, (None, optionalDotAndPrecision i)
let rec digitsPosition n i =
if i >= len then failwithf "%s" <| FSComp.SR.forBadPrecision()
@@ -161,15 +286,15 @@ let parseFormatStringInternal (m:range) (g: TcGlobals) (context: FormatStringChe
let oldI = i
let posi, i = position i
- let relCol = relCol + i - oldI
+ let fragCol = fragCol + i - oldI
let oldI = i
let i = flags i
- let relCol = relCol + i - oldI
+ let fragCol = fragCol + i - oldI
let oldI = i
- let widthArg,(precisionArg,i) = widthAndPrecision i
- let relCol = relCol + i - oldI
+ let widthArg,(widthValue, (precisionArg,i)) = widthAndPrecision i
+ let fragCol = fragCol + i - oldI
if i >= len then failwithf "%s" <| FSComp.SR.forBadPrecision()
@@ -177,127 +302,185 @@ let parseFormatStringInternal (m:range) (g: TcGlobals) (context: FormatStringChe
let acc = if widthArg then (Option.map ((+)1) posi, g.int_ty) :: acc else acc
- let checkNoPrecision c = if info.precision then failwithf "%s" <| FSComp.SR.forFormatDoesntSupportPrecision(c.ToString())
- let checkNoZeroFlag c = if info.addZeros then failwithf "%s" <| FSComp.SR.forDoesNotSupportZeroFlag(c.ToString())
- let checkNoNumericPrefix c = if info.numPrefixIfPos <> None then
- failwithf "%s" <| FSComp.SR.forDoesNotSupportPrefixFlag(c.ToString(), (Option.get info.numPrefixIfPos).ToString())
+ let checkNoPrecision c =
+ if info.precision then failwithf "%s" <| FSComp.SR.forFormatDoesntSupportPrecision(c.ToString())
+
+ let checkNoZeroFlag c =
+ if info.addZeros then failwithf "%s" <| FSComp.SR.forDoesNotSupportZeroFlag(c.ToString())
+
+ let checkNoNumericPrefix c =
+ match info.numPrefixIfPos with
+ | Some n -> failwithf "%s" <| FSComp.SR.forDoesNotSupportPrefixFlag(c.ToString(), n.ToString())
+ | None -> ()
let checkOtherFlags c =
checkNoPrecision c
checkNoZeroFlag c
checkNoNumericPrefix c
- let collectSpecifierLocation relLine relCol numStdArgs =
- let numArgsForSpecifier =
- numStdArgs + (if widthArg then 1 else 0) + (if precisionArg then 1 else 0)
- match relLine with
- | 0 ->
+ // Explicitly typed holes in interpolated strings "....%d{x}..." get additional '%P()' as a hole place marker
+ let skipPossibleInterpolationHole i =
+ if isInterpolated then
+ if i+1 < len && fmt.[i] = '%' && fmt.[i+1] = 'P' then
+ let i = i + 2
+ if i+1 < len && fmt.[i] = '(' && fmt.[i+1] = ')' then
+ if isFormattableString then
+ failwithf "%s" <| FSComp.SR.forFormatInvalidForInterpolated4()
+ i + 2
+ else
+ failwithf "%s" <| FSComp.SR.forFormatInvalidForInterpolated2()
+ else
+ failwithf "%s" <| FSComp.SR.forFormatInvalidForInterpolated()
+ else i
+
+ // Implicitly typed holes in interpolated strings are translated to '... %P(...)...' in the
+ // type checker. They should always have '(...)' after for format string.
+ let requireAndSkipInterpolationHoleFormat i =
+ if i < len && fmt.[i] = '(' then
+ let i2 = fmt.IndexOf(")", i+1)
+ if i2 = -1 then
+ failwithf "%s" <| FSComp.SR.forFormatInvalidForInterpolated3()
+ else
+ let dotnetAlignment = match widthValue with None -> "" | Some w -> "," + (if info.leftJustify then "-" else "") + string w
+ let dotnetNumberFormat = match fmt.[i+1..i2-1] with "" -> "" | s -> ":" + s
+ appendToDotnetFormatString ("{" + string dotnetFormatStringInterpolationHoleCount + dotnetAlignment + dotnetNumberFormat + "}")
+ dotnetFormatStringInterpolationHoleCount <- dotnetFormatStringInterpolationHoleCount + 1
+ i2+1
+ else
+ failwithf "%s" <| FSComp.SR.forFormatInvalidForInterpolated3()
+
+ let collectSpecifierLocation fragLine fragCol numStdArgs =
+ match context with
+ | Some _ ->
+ let numArgsForSpecifier =
+ numStdArgs + (if widthArg then 1 else 0) + (if precisionArg then 1 else 0)
specifierLocations.Add(
- (Range.mkFileIndexRange m.FileIndex
- (Range.mkPos m.StartLine (startCol + offset))
- (Range.mkPos m.StartLine (relCol + offset + 1))), numArgsForSpecifier)
- | _ ->
- specifierLocations.Add(
- (Range.mkFileIndexRange m.FileIndex
- (Range.mkPos (m.StartLine + relLine) startCol)
- (Range.mkPos (m.StartLine + relLine) (relCol + 1))), numArgsForSpecifier)
+ (Range.mkFileIndexRange m.FileIndex
+ (Range.mkPos fragLine startFragCol)
+ (Range.mkPos fragLine (fragCol + 1))), numArgsForSpecifier)
+ | None -> ()
let ch = fmt.[i]
match ch with
| '%' ->
- collectSpecifierLocation relLine relCol 0
- parseLoop acc (i+1, relLine, relCol+1)
+ collectSpecifierLocation fragLine fragCol 0
+ appendToDotnetFormatString "%"
+ parseLoop acc (i+1, fragLine, fragCol+1) fragments
| ('d' | 'i' | 'o' | 'u' | 'x' | 'X') ->
if info.precision then failwithf "%s" <| FSComp.SR.forFormatDoesntSupportPrecision(ch.ToString())
- collectSpecifierLocation relLine relCol 1
- parseLoop ((posi, mkFlexibleIntFormatTypar g m) :: acc) (i+1, relLine, relCol+1)
+ collectSpecifierLocation fragLine fragCol 1
+ let i = skipPossibleInterpolationHole (i+1)
+ parseLoop ((posi, mkFlexibleIntFormatTypar g m) :: acc) (i, fragLine, fragCol+1) fragments
| ('l' | 'L') ->
if info.precision then failwithf "%s" <| FSComp.SR.forFormatDoesntSupportPrecision(ch.ToString())
- let relCol = relCol+1
+ let fragCol = fragCol+1
let i = i+1
// "bad format specifier ... In F# code you can use %d, %x, %o or %u instead ..."
if i >= len then
- failwithf "%s" <| FSComp.SR.forBadFormatSpecifier()
+ raise (Failure (FSComp.SR.forBadFormatSpecifier()))
// Always error for %l and %Lx
failwithf "%s" <| FSComp.SR.forLIsUnnecessary()
match fmt.[i] with
| ('d' | 'i' | 'o' | 'u' | 'x' | 'X') ->
- collectSpecifierLocation relLine relCol 1
- parseLoop ((posi, mkFlexibleIntFormatTypar g m) :: acc) (i+1, relLine, relCol+1)
+ collectSpecifierLocation fragLine fragCol 1
+ let i = skipPossibleInterpolationHole (i+1)
+ parseLoop ((posi, mkFlexibleIntFormatTypar g m) :: acc) (i, fragLine, fragCol+1) fragments
| _ -> failwithf "%s" <| FSComp.SR.forBadFormatSpecifier()
| ('h' | 'H') ->
failwithf "%s" <| FSComp.SR.forHIsUnnecessary()
| 'M' ->
- collectSpecifierLocation relLine relCol 1
- parseLoop ((posi, mkFlexibleDecimalFormatTypar g m) :: acc) (i+1, relLine, relCol+1)
+ collectSpecifierLocation fragLine fragCol 1
+ let i = skipPossibleInterpolationHole (i+1)
+ parseLoop ((posi, mkFlexibleDecimalFormatTypar g m) :: acc) (i, fragLine, fragCol+1) fragments
| ('f' | 'F' | 'e' | 'E' | 'g' | 'G') ->
- collectSpecifierLocation relLine relCol 1
- parseLoop ((posi, mkFlexibleFloatFormatTypar g m) :: acc) (i+1, relLine, relCol+1)
+ collectSpecifierLocation fragLine fragCol 1
+ let i = skipPossibleInterpolationHole (i+1)
+ parseLoop ((posi, mkFlexibleFloatFormatTypar g m) :: acc) (i, fragLine, fragCol+1) fragments
| 'b' ->
checkOtherFlags ch
- collectSpecifierLocation relLine relCol 1
- parseLoop ((posi, g.bool_ty) :: acc) (i+1, relLine, relCol+1)
+ collectSpecifierLocation fragLine fragCol 1
+ let i = skipPossibleInterpolationHole (i+1)
+ parseLoop ((posi, g.bool_ty) :: acc) (i, fragLine, fragCol+1) fragments
| 'c' ->
checkOtherFlags ch
- collectSpecifierLocation relLine relCol 1
- parseLoop ((posi, g.char_ty) :: acc) (i+1, relLine, relCol+1)
+ collectSpecifierLocation fragLine fragCol 1
+ let i = skipPossibleInterpolationHole (i+1)
+ parseLoop ((posi, g.char_ty) :: acc) (i, fragLine, fragCol+1) fragments
| 's' ->
checkOtherFlags ch
- collectSpecifierLocation relLine relCol 1
- parseLoop ((posi, g.string_ty) :: acc) (i+1, relLine, relCol+1)
+ collectSpecifierLocation fragLine fragCol 1
+ let i = skipPossibleInterpolationHole (i+1)
+ parseLoop ((posi, g.string_ty) :: acc) (i, fragLine, fragCol+1) fragments
| 'O' ->
checkOtherFlags ch
- collectSpecifierLocation relLine relCol 1
- parseLoop ((posi, NewInferenceType ()) :: acc) (i+1, relLine, relCol+1)
+ collectSpecifierLocation fragLine fragCol 1
+ let i = skipPossibleInterpolationHole (i+1)
+ parseLoop ((posi, NewInferenceType ()) :: acc) (i, fragLine, fragCol+1) fragments
+
+ // residue of hole "...{n}..." in interpolated strings become %P(...)
+ | 'P' when isInterpolated ->
+ checkOtherFlags ch
+ let i = requireAndSkipInterpolationHoleFormat (i+1)
+ // Note, the fragCol doesn't advance at all as these are magically inserted.
+ parseLoop ((posi, NewInferenceType ()) :: acc) (i, fragLine, startFragCol) fragments
| 'A' ->
match info.numPrefixIfPos with
| None // %A has BindingFlags=Public, %+A has BindingFlags=Public | NonPublic
| Some '+' ->
- collectSpecifierLocation relLine relCol 1
- parseLoop ((posi, NewInferenceType ()) :: acc) (i+1, relLine, relCol+1)
- | Some _ -> failwithf "%s" <| FSComp.SR.forDoesNotSupportPrefixFlag(ch.ToString(), (Option.get info.numPrefixIfPos).ToString())
+ collectSpecifierLocation fragLine fragCol 1
+ let i = skipPossibleInterpolationHole (i+1)
+ let xty = NewInferenceType ()
+ percentATys.Add(xty)
+ parseLoop ((posi, xty) :: acc) (i, fragLine, fragCol+1) fragments
+ | Some n -> failwithf "%s" <| FSComp.SR.forDoesNotSupportPrefixFlag(ch.ToString(), n.ToString())
| 'a' ->
checkOtherFlags ch
let xty = NewInferenceType ()
- let fty = bty --> (xty --> cty)
- collectSpecifierLocation relLine relCol 2
- parseLoop ((Option.map ((+)1) posi, xty) :: (posi, fty) :: acc) (i+1, relLine, relCol+1)
+ let fty = printerArgTy --> (xty --> printerResidueTy)
+ collectSpecifierLocation fragLine fragCol 2
+ let i = skipPossibleInterpolationHole (i+1)
+ parseLoop ((Option.map ((+)1) posi, xty) :: (posi, fty) :: acc) (i, fragLine, fragCol+1) fragments
| 't' ->
checkOtherFlags ch
- collectSpecifierLocation relLine relCol 1
- parseLoop ((posi, bty --> cty) :: acc) (i+1, relLine, relCol+1)
+ collectSpecifierLocation fragLine fragCol 1
+ let i = skipPossibleInterpolationHole (i+1)
+ parseLoop ((posi, printerArgTy --> printerResidueTy) :: acc) (i, fragLine, fragCol+1) fragments
- | c -> failwithf "%s" <| FSComp.SR.forBadFormatSpecifierGeneral(String.make 1 c)
+ | c -> failwithf "%s" <| FSComp.SR.forBadFormatSpecifierGeneral(String.make 1 c)
- | '\n' -> parseLoop acc (i+1, relLine+1, 0)
- | _ -> parseLoop acc (i+1, relLine, relCol+1)
+ | '\n' ->
+ appendToDotnetFormatString fmt.[i..i]
+ parseLoop acc (i+1, fragLine+1, 0) fragments
+ | _ ->
+ appendToDotnetFormatString fmt.[i..i]
+ parseLoop acc (i+1, fragLine, fragCol+1) fragments
- let results = parseLoop [] (0, 0, m.StartColumn)
- results, Seq.toList specifierLocations
+ let results = parseLoop [] (0, 0, m.StartColumn) fragments
+ results, Seq.toList specifierLocations, dotnetFormatString.ToString(), percentATys.ToArray()
-let ParseFormatString m g formatStringCheckContext fmt bty cty dty =
- let argtys, specifierLocations = parseFormatStringInternal m g formatStringCheckContext fmt bty cty
- let aty = List.foldBack (-->) argtys dty
- let ety = mkRefTupledTy g argtys
- (aty, ety), specifierLocations
+let ParseFormatString m ms g isInterpolated isFormattableString formatStringCheckContext fmt printerArgTy printerResidueTy printerResultTy =
+ let argTys, specifierLocations, dotnetFormatString, percentATys = parseFormatStringInternal m ms g isInterpolated isFormattableString formatStringCheckContext fmt printerArgTy printerResidueTy
+ let printerTy = List.foldBack (-->) argTys printerResultTy
+ let printerTupleTy = mkRefTupledTy g argTys
+ argTys, printerTy, printerTupleTy, percentATys, specifierLocations, dotnetFormatString
-let TryCountFormatStringArguments m g fmt bty cty =
+let TryCountFormatStringArguments m g isInterpolated fmt printerArgTy printerResidueTy =
try
- let argtys, _specifierLocations = parseFormatStringInternal m g None fmt bty cty
- Some argtys.Length
+ let argTys, _specifierLocations, _dotnetFormatString, _percentATys = parseFormatStringInternal m [] g isInterpolated false None fmt printerArgTy printerResidueTy
+ Some argTys.Length
with _ ->
None
diff --git a/src/fsharp/CheckFormatStrings.fsi b/src/fsharp/CheckFormatStrings.fsi
index 91cce79b7d4..b96e8f88a8f 100644
--- a/src/fsharp/CheckFormatStrings.fsi
+++ b/src/fsharp/CheckFormatStrings.fsi
@@ -9,9 +9,10 @@ module internal FSharp.Compiler.CheckFormatStrings
open FSharp.Compiler
open FSharp.Compiler.NameResolution
+open FSharp.Compiler.Range
open FSharp.Compiler.TypedTree
open FSharp.Compiler.TcGlobals
-val ParseFormatString : Range.range -> TcGlobals -> formatStringCheckContext: FormatStringCheckContext option -> fmt: string -> bty: TType -> cty: TType -> dty: TType -> (TType * TType) * (Range.range * int) list
+val ParseFormatString : m: range -> fragmentRanges: range list -> g: TcGlobals -> isInterpolated: bool -> isFormattableString: bool -> formatStringCheckContext: FormatStringCheckContext option -> fmt: string -> bty: TType -> cty: TType -> dty: TType -> TType list * TType * TType * TType[] * (range * int) list * string
-val TryCountFormatStringArguments : m:Range.range -> g:TcGlobals -> fmt:string -> bty:TType -> cty:TType -> int option
+val TryCountFormatStringArguments: m: range -> g: TcGlobals -> isInterpolated: bool -> fmt:string -> bty:TType -> cty:TType -> int option
diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs
index 70e520770f4..fbbda436e58 100644
--- a/src/fsharp/CompileOps.fs
+++ b/src/fsharp/CompileOps.fs
@@ -1166,6 +1166,10 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) (canSuggestNa
| Parser.TOKEN_EOF -> getErrorString("Parser.TOKEN.EOF")
| Parser.TOKEN_CONST -> getErrorString("Parser.TOKEN.CONST")
| Parser.TOKEN_FIXED -> getErrorString("Parser.TOKEN.FIXED")
+ | Parser.TOKEN_INTERP_STRING_BEGIN_END -> getErrorString("Parser.TOKEN.INTERP.STRING.BEGIN.END")
+ | Parser.TOKEN_INTERP_STRING_BEGIN_PART -> getErrorString("Parser.TOKEN.INTERP.STRING.BEGIN.PART")
+ | Parser.TOKEN_INTERP_STRING_PART -> getErrorString("Parser.TOKEN.INTERP.STRING.PART")
+ | Parser.TOKEN_INTERP_STRING_END -> getErrorString("Parser.TOKEN.INTERP.STRING.END")
| unknown ->
Debug.Assert(false, "unknown token tag")
let result = sprintf "%+A" unknown
@@ -3588,13 +3592,13 @@ let ParseOneInputLexbuf (tcConfig: TcConfig, lexResourceManager, conditionalComp
use unwindbuildphase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse
try
let skip = true in (* don't report whitespace from lexer *)
- let lightSyntaxStatus = LightSyntaxStatus (tcConfig.ComputeLightSyntaxInitialStatus filename, true)
- let lexargs = mkLexargs (filename, conditionalCompilationDefines@tcConfig.conditionalCompilationDefines, lightSyntaxStatus, lexResourceManager, [], errorLogger, tcConfig.pathMap)
+ let lightStatus = LightSyntaxStatus (tcConfig.ComputeLightSyntaxInitialStatus filename, true)
+ let lexargs = mkLexargs (conditionalCompilationDefines@tcConfig.conditionalCompilationDefines, lightStatus, lexResourceManager, [], errorLogger, tcConfig.pathMap)
let shortFilename = SanitizeFileName filename tcConfig.implicitIncludeDir
let input =
Lexhelp.usingLexbufForParsing (lexbuf, filename) (fun lexbuf ->
if verbose then dprintn ("Parsing... "+shortFilename)
- let tokenizer = LexFilter.LexFilter(lightSyntaxStatus, tcConfig.compilingFslib, Lexer.token lexargs skip, lexbuf)
+ let tokenizer = LexFilter.LexFilter(lightStatus, tcConfig.compilingFslib, Lexer.token lexargs skip, lexbuf)
if tcConfig.tokenizeOnly then
while true do
diff --git a/src/fsharp/ErrorLogger.fs b/src/fsharp/ErrorLogger.fs
old mode 100755
new mode 100644
index 83ff5dba6d0..c7974e5c20e
--- a/src/fsharp/ErrorLogger.fs
+++ b/src/fsharp/ErrorLogger.fs
@@ -702,4 +702,9 @@ let internal tryLanguageFeatureErrorRecover langVersion langFeature m =
| None -> ()
let internal tryLanguageFeatureErrorOption langVersion langFeature m =
- tryLanguageFeatureErrorAux langVersion langFeature m
\ No newline at end of file
+ tryLanguageFeatureErrorAux langVersion langFeature m
+
+let internal languageFeatureNotSupportedInLibraryError (langVersion: LanguageVersion) (langFeature: LanguageFeature) (m: range) =
+ let featureStr = langVersion.GetFeatureString langFeature
+ let suggestedVersionStr = langVersion.GetFeatureVersionString langFeature
+ error (Error(FSComp.SR.chkFeatureNotSupportedInLibrary(featureStr, suggestedVersionStr), m))
diff --git a/src/fsharp/FSComp.txt b/src/fsharp/FSComp.txt
index e1fb144f116..2733248bea1 100644
--- a/src/fsharp/FSComp.txt
+++ b/src/fsharp/FSComp.txt
@@ -1490,6 +1490,7 @@ notAFunctionButMaybeDeclaration,"This value is not a function and cannot be appl
3350,chkFeatureNotLanguageSupported,"Feature '%s' is not available in F# %s. Please use language version %s or greater."
3351,chkFeatureNotRuntimeSupported,"Feature '%s' is not supported by target runtime."
3352,typrelInterfaceMemberNoMostSpecificImplementation,"Interface member '%s' does not have a most specific implementation."
+3353,chkFeatureNotSupportedInLibrary,"Feature '%s' requires the F# library for language version %s or greater."
useSdkRefs,"Use reference assemblies for .NET framework references when available (Enabled by default)."
optsLangVersion,"Display the allowed values for language version, specify language version such as 'latest' or 'preview'"
optsSupportedLangVersions,"Supported language versions:"
@@ -1509,6 +1510,7 @@ featureFixedIndexSlice3d4d,"fixed-index slice 3d/4d"
featureAndBang,"applicative computation expressions"
featureNullableOptionalInterop,"nullable optional interop"
featureDefaultInterfaceMemberConsumption,"default interface member consumption"
+featureStringInterpolation,"string interpolation"
featureWitnessPassing,"witness passing for trait constraints in F# quotations"
3353,fsiInvalidDirective,"Invalid directive '#%s %s'"
3360,typrelInterfaceWithConcreteAndVariable,"'%s' cannot implement the interface '%s' with the two instantiations '%s' and '%s' because they may unify."
@@ -1516,4 +1518,19 @@ featureWitnessPassing,"witness passing for trait constraints in F# quotations"
featureInterfacesWithMultipleGenericInstantiation,"interfaces with multiple generic instantiation"
3362,tcLiteralFieldAssignmentWithArg,"Cannot assign '%s' to a value marked literal"
3363,tcLiteralFieldAssignmentNoArg,"Cannot assign a value to another value marked literal"
+forFormatInvalidForInterpolated,"Interpolated strings may not use '%%' format specifiers unless each is given an expression, e.g. '%%d{{1+1}}'."
+forFormatInvalidForInterpolated2,".NET-style format specifiers such as '{{x,3}}' or '{{x:N5}}' may not be mixed with '%%' format specifiers."
+forFormatInvalidForInterpolated3,"The '%%P' specifier may not be used explicitly."
+forFormatInvalidForInterpolated4,"Interpolated strings used as type IFormattable or type FormattableString may not use '%%' specifiers, only .NET-style interpolands such as '{{expr}}', '{{expr,3}}' or '{{expr:N5}}' may be used."
+3371,tcInterpolationMixedWithPercent,"Mismatch in interpolated string. Interpolated strings may not use '%%' format specifiers unless each is given an expression, e.g. '%%d{{1+1}}'"
+3372,tcInvalidAlignmentInInterpolatedString,"Invalid alignment in interpolated string"
+3373,lexSingleQuoteInSingleQuote,"Invalid interpolated string. Single quote or verbatim string literals may not be used in interpolated expressions in single quote or verbatim strings. Consider using an explicit 'let' binding for the interpolation expression or use a triple quote string as the outer string literal."
+3374,lexTripleQuoteInTripleQuote,"Invalid interpolated string. Triple quote string literals may not be used in interpolated expressions. Consider using an explicit 'let' binding for the interpolation expression."
+3376,tcUnableToParseInterpolatedString,"Invalid interpolated string. %s"
+3377,lexByteStringMayNotBeInterpolated,"a byte string may not be interpolated"
+3378,parsEofInInterpolatedStringFill,"Incomplete interpolated string expression fill begun at or before here"
+3379,parsEofInInterpolatedString,"Incomplete interpolated string begun at or before here"
+3380,parsEofInInterpolatedVerbatimString,"Incomplete interpolated verbatim string begun at or before here"
+3381,parsEofInInterpolatedTripleQuoteString,"Incomplete interpolated triple-quote string begun at or before here"
+3382,lexRBraceInInterpolatedString,"A '}}' character must be escaped (by doubling) in an interpolated string."
#3501 "This construct is not supported by your version of the F# compiler" CompilerMessage(ExperimentalAttributeMessages.NotSupportedYet, 3501, IsError=true)
diff --git a/src/fsharp/FSStrings.resx b/src/fsharp/FSStrings.resx
index e593da16d05..288a96c8efd 100644
--- a/src/fsharp/FSStrings.resx
+++ b/src/fsharp/FSStrings.resx
@@ -441,6 +441,18 @@
keyword 'fixed'
+
+ interpolated string
+
+
+ interpolated string (first part)
+
+
+ interpolated string (part)
+
+
+ interpolated string (final part)
+
keyword 'constraint'
diff --git a/src/fsharp/FSharp.Core/printf.fs b/src/fsharp/FSharp.Core/printf.fs
index d751ba1317f..05ffcce3ea6 100644
--- a/src/fsharp/FSharp.Core/printf.fs
+++ b/src/fsharp/FSharp.Core/printf.fs
@@ -2,17 +2,43 @@
namespace Microsoft.FSharp.Core
-type PrintfFormat<'Printer,'State,'Residue,'Result>(value:string) =
- member x.Value = value
+open System
+open System.IO
+open System.Text
- override __.ToString() = value
+open System.Collections.Concurrent
+open System.Globalization
+open System.Reflection
+
+open Microsoft.FSharp.Core
+open Microsoft.FSharp.Core.Operators
+open Microsoft.FSharp.Collections
+
+open LanguagePrimitives.IntrinsicOperators
+
+type PrintfFormat<'Printer, 'State, 'Residue, 'Result>(value:string, captures: obj[], captureTys: Type[]) =
+
+ new (value) = new PrintfFormat<'Printer, 'State, 'Residue, 'Result>(value, null, null)
+
+ member _.Value = value
+
+ member _.Captures = captures
+
+ member _.CaptureTypes = captureTys
+
+ override _.ToString() = value
-type PrintfFormat<'Printer,'State,'Residue,'Result,'Tuple>(value:string) =
- inherit PrintfFormat<'Printer,'State,'Residue,'Result>(value)
+type PrintfFormat<'Printer, 'State, 'Residue, 'Result, 'Tuple>(value:string, captures, captureTys: Type[]) =
+
+ inherit PrintfFormat<'Printer, 'State, 'Residue, 'Result>(value, captures, captureTys)
+
+ new (value) = new PrintfFormat<'Printer, 'State, 'Residue, 'Result, 'Tuple>(value, null, null)
-type Format<'Printer,'State,'Residue,'Result> = PrintfFormat<'Printer,'State,'Residue,'Result>
-type Format<'Printer,'State,'Residue,'Result,'Tuple> = PrintfFormat<'Printer,'State,'Residue,'Result,'Tuple>
+type Format<'Printer, 'State, 'Residue, 'Result> = PrintfFormat<'Printer, 'State, 'Residue, 'Result>
+type Format<'Printer, 'State, 'Residue, 'Result, 'Tuple> = PrintfFormat<'Printer, 'State, 'Residue, 'Result, 'Tuple>
+
+[]
module internal PrintfImpl =
/// Basic idea of implementation:
@@ -36,18 +62,6 @@ module internal PrintfImpl =
/// with just one reflection call
/// 2. we can make combinable parts independent from particular printf implementation. Thus final result can be cached and shared.
/// i.e when first call to printf "%s %s" will trigger creation of the specialization. Subsequent calls will pick existing specialization
- open System
- open System.IO
- open System.Text
-
- open System.Collections.Generic
- open System.Reflection
- open Microsoft.FSharp.Core
- open Microsoft.FSharp.Core.Operators
- open Microsoft.FSharp.Collections
- open LanguagePrimitives.IntrinsicOperators
-
- open System.IO
[]
type FormatFlags =
@@ -78,677 +92,442 @@ module internal PrintfImpl =
Precision: int
Width: int
Flags: FormatFlags
+ InteropHoleDotNetFormat: string voption
}
- member this.IsStarPrecision = this.Precision = StarValue
- member this.IsPrecisionSpecified = this.Precision <> NotSpecifiedValue
- member this.IsStarWidth = this.Width = StarValue
- member this.IsWidthSpecified = this.Width <> NotSpecifiedValue
+ member spec.IsStarPrecision = (spec.Precision = StarValue)
+
+ member spec.IsPrecisionSpecified = (spec.Precision <> NotSpecifiedValue)
+
+ member spec.IsStarWidth = (spec.Width = StarValue)
+
+ member spec.IsWidthSpecified = (spec.Width <> NotSpecifiedValue)
+
+ member spec.ArgCount =
+ let n =
+ if spec.TypeChar = 'a' then 2
+ elif spec.IsStarWidth || spec.IsStarPrecision then
+ if spec.IsStarWidth = spec.IsStarPrecision then 3
+ else 2
+ else 1
- override this.ToString() =
+ let n = if spec.TypeChar = '%' then n - 1 else n
+
+ assert (n <> 0)
+
+ n
+
+ override spec.ToString() =
let valueOf n = match n with StarValue -> "*" | NotSpecifiedValue -> "-" | n -> n.ToString()
System.String.Format
(
"'{0}', Precision={1}, Width={2}, Flags={3}",
- this.TypeChar,
- (valueOf this.Precision),
- (valueOf this.Width),
- this.Flags
+ spec.TypeChar,
+ (valueOf spec.Precision),
+ (valueOf spec.Width),
+ spec.Flags
)
+
+ member spec.IsDecimalFormat =
+ spec.TypeChar = 'M'
+
+ member spec.GetPadAndPrefix allowZeroPadding =
+ let padChar = if allowZeroPadding && isPadWithZeros spec.Flags then '0' else ' ';
+ let prefix =
+ if isPlusForPositives spec.Flags then "+"
+ elif isSpaceForPositives spec.Flags then " "
+ else ""
+ padChar, prefix
+
+ member spec.IsGFormat =
+ spec.IsDecimalFormat || System.Char.ToLower(spec.TypeChar) = 'g'
+
/// Set of helpers to parse format string
module private FormatString =
- let intFromString (s: string) pos =
- let rec go acc i =
- if Char.IsDigit s.[i] then
- let n = int s.[i] - int '0'
- go (acc * 10 + n) (i + 1)
- else acc, i
- go 0 pos
-
- let parseFlags (s: string) i =
- let rec go flags i =
+ let intFromString (s: string) (i: byref) =
+ let mutable res = 0
+ while (Char.IsDigit s.[i]) do
+ let n = int s.[i] - int '0'
+ res <- res * 10 + n
+ i <- i + 1
+ res
+
+ let parseFlags (s: string) (i: byref) =
+ let mutable flags = FormatFlags.None
+ let mutable fin = false
+ while not fin do
match s.[i] with
- | '0' -> go (flags ||| FormatFlags.PadWithZeros) (i + 1)
- | '+' -> go (flags ||| FormatFlags.PlusForPositives) (i + 1)
- | ' ' -> go (flags ||| FormatFlags.SpaceForPositives) (i + 1)
- | '-' -> go (flags ||| FormatFlags.LeftJustify) (i + 1)
- | _ -> flags, i
- go FormatFlags.None i
-
- let parseWidth (s: string) i =
- if s.[i] = '*' then StarValue, (i + 1)
- elif Char.IsDigit s.[i] then intFromString s i
- else NotSpecifiedValue, i
-
- let parsePrecision (s: string) i =
+ | '0' ->
+ flags <- flags ||| FormatFlags.PadWithZeros
+ i <- i + 1
+ | '+' ->
+ flags <- flags ||| FormatFlags.PlusForPositives
+ i <- i + 1
+ | ' ' ->
+ flags <- flags ||| FormatFlags.SpaceForPositives
+ i <- i + 1
+ | '-' ->
+ flags <- flags ||| FormatFlags.LeftJustify
+ i <- i + 1
+ | _ ->
+ fin <- true
+ flags
+
+ let parseWidth (s: string) (i: byref) =
+ if s.[i] = '*' then
+ i <- i + 1
+ StarValue
+ elif Char.IsDigit s.[i] then
+ intFromString s (&i)
+ else
+ NotSpecifiedValue
+
+ let parsePrecision (s: string) (i: byref) =
if s.[i] = '.' then
- if s.[i + 1] = '*' then StarValue, i + 2
- elif Char.IsDigit s.[i + 1] then intFromString s (i + 1)
+ if s.[i + 1] = '*' then
+ i <- i + 2
+ StarValue
+ elif Char.IsDigit s.[i + 1] then
+ i <- i + 1
+ intFromString s (&i)
else raise (ArgumentException("invalid precision value"))
- else NotSpecifiedValue, i
+ else
+ NotSpecifiedValue
- let parseTypeChar (s: string) i =
- s.[i], (i + 1)
+ let parseTypeChar (s: string) (i: byref) =
+ let res = s.[i]
+ i <- i + 1
+ res
+
+ let parseInterpolatedHoleDotNetFormat typeChar (s: string) (i: byref) =
+ if typeChar = 'P' then
+ if i < s.Length && s.[i] = '(' then
+ let i2 = s.IndexOf(")", i)
+ if i2 = -1 then
+ ValueNone
+ else
+ let res = s.[i+1..i2-1]
+ i <- i2+1
+ ValueSome res
+ else
+ ValueNone
+ else
+ ValueNone
+
+ // Skip %P() added for hole in "...%d{x}..."
+ let skipInterpolationHole typeChar (fmt: string) (i: byref) =
+ if typeChar <> 'P' then
+ if i+1 < fmt.Length && fmt.[i] = '%' && fmt.[i+1] = 'P' then
+ i <- i + 2
+ if i+1 < fmt.Length && fmt.[i] = '(' && fmt.[i+1] = ')' then
+ i <- i+2
- let findNextFormatSpecifier (s: string) i =
- let rec go i (buf: Text.StringBuilder) =
+ let findNextFormatSpecifier (s: string) (i: byref) =
+ let buf = StringBuilder()
+ let mutable fin = false
+ while not fin do
if i >= s.Length then
- s.Length, buf.ToString()
+ fin <- true
else
let c = s.[i]
if c = '%' then
if i + 1 < s.Length then
- let _, i1 = parseFlags s (i + 1)
- let w, i2 = parseWidth s i1
- let p, i3 = parsePrecision s i2
- let typeChar, i4 = parseTypeChar s i3
+ let mutable i2 = i+1
+ let _ = parseFlags s &i2
+ let w = parseWidth s &i2
+ let p = parsePrecision s &i2
+ let typeChar = parseTypeChar s &i2
+
// shortcut for the simpliest case
// if typeChar is not % or it has star as width\precision - resort to long path
if typeChar = '%' && not (w = StarValue || p = StarValue) then
buf.Append('%') |> ignore
- go i4 buf
+ i <- i2
else
- i, buf.ToString()
+ fin <- true
else
raise (ArgumentException("Missing format specifier"))
else
buf.Append c |> ignore
- go (i + 1) buf
- go i (Text.StringBuilder())
+ i <- i + 1
+ buf.ToString()
+
+ []
+ /// Represents one step in the execution of a format string
+ type Step =
+ | StepWithArg of prefix: string * conv: (obj -> string)
+ | StepWithTypedArg of prefix: string * conv: (obj -> Type -> string)
+ | StepString of prefix: string
+ | StepLittleT of prefix: string
+ | StepLittleA of prefix: string
+ | StepStar1 of prefix: string * conv: (obj -> int -> string)
+ | StepPercentStar1 of prefix: string
+ | StepStar2 of prefix: string * conv: (obj -> int -> int -> string)
+ | StepPercentStar2 of prefix: string
+
+ // Count the number of string fragments in a sequence of steps
+ static member BlockCount(steps: Step[]) =
+ let mutable count = 0
+ for step in steps do
+ match step with
+ | StepWithArg (prefix, _conv) ->
+ if not (String.IsNullOrEmpty prefix) then count <- count + 1
+ count <- count + 1
+ | StepWithTypedArg (prefix, _conv) ->
+ if not (String.IsNullOrEmpty prefix) then count <- count + 1
+ count <- count + 1
+ | StepString prefix ->
+ if not (String.IsNullOrEmpty prefix) then count <- count + 1
+ | StepLittleT(prefix) ->
+ if not (String.IsNullOrEmpty prefix) then count <- count + 1
+ count <- count + 1
+ | StepLittleA(prefix) ->
+ if not (String.IsNullOrEmpty prefix) then count <- count + 1
+ count <- count + 1
+ | StepStar1(prefix, _conv) ->
+ if not (String.IsNullOrEmpty prefix) then count <- count + 1
+ count <- count + 1
+ | StepPercentStar1(prefix) ->
+ if not (String.IsNullOrEmpty prefix) then count <- count + 1
+ count <- count + 1
+ | StepStar2(prefix, _conv) ->
+ if not (String.IsNullOrEmpty prefix) then count <- count + 1
+ count <- count + 1
+ | StepPercentStar2(prefix) ->
+ if not (String.IsNullOrEmpty prefix) then count <- count + 1
+ count <- count + 1
+ count
/// Abstracts generated printer from the details of particular environment: how to write text, how to produce results etc...
[]
- type PrintfEnv<'State, 'Residue, 'Result> =
- val State: 'State
- new(s: 'State) = { State = s }
+ type PrintfEnv<'State, 'Residue, 'Result>(state: 'State) =
+ member _.State = state
+
abstract Finish: unit -> 'Result
+
abstract Write: string -> unit
+
+ /// Write the result of a '%t' format. If this is a string it is written. If it is a 'unit' value
+ /// the side effect has already happened
abstract WriteT: 'Residue -> unit
+
+ member env.WriteSkipEmpty(s: string) =
+ if not (String.IsNullOrEmpty s) then
+ env.Write s
- type Utils =
- static member inline Write (env: PrintfEnv<_, _, _>, a, b) =
- env.Write a
- env.Write b
- static member inline Write (env: PrintfEnv<_, _, _>, a, b, c) =
- Utils.Write(env, a, b)
- env.Write c
- static member inline Write (env: PrintfEnv<_, _, _>, a, b, c, d) =
- Utils.Write(env, a, b)
- Utils.Write(env, c, d)
- static member inline Write (env: PrintfEnv<_, _, _>, a, b, c, d, e) =
- Utils.Write(env, a, b, c)
- Utils.Write(env, d, e)
- static member inline Write (env: PrintfEnv<_, _, _>, a, b, c, d, e, f) =
- Utils.Write(env, a, b, c, d)
- Utils.Write(env, e, f)
- static member inline Write (env: PrintfEnv<_, _, _>, a, b, c, d, e, f, g) =
- Utils.Write(env, a, b, c, d, e)
- Utils.Write(env, f, g)
- static member inline Write (env: PrintfEnv<_, _, _>, a, b, c, d, e, f, g, h) =
- Utils.Write(env, a, b, c, d, e, f)
- Utils.Write(env, g, h)
- static member inline Write (env: PrintfEnv<_, _, _>, a, b, c, d, e, f, g, h, i) =
- Utils.Write(env, a, b, c, d, e, f, g)
- Utils.Write(env, h, i)
- static member inline Write (env: PrintfEnv<_, _, _>, a, b, c, d, e, f, g, h, i, j) =
- Utils.Write(env, a, b, c, d, e, f, g, h)
- Utils.Write(env, i, j)
- static member inline Write (env: PrintfEnv<_, _, _>, a, b, c, d, e, f, g, h, i, j, k) =
- Utils.Write(env, a, b, c, d, e, f, g, h, i)
- Utils.Write(env, j, k)
- static member inline Write (env: PrintfEnv<_, _, _>, a, b, c, d, e, f, g, h, i, j, k, l, m) =
- Utils.Write(env, a, b, c, d, e, f, g, h, i, j, k)
- Utils.Write(env, l, m)
+ member env.RunSteps (args: obj[], argTys: Type[], steps: Step[]) =
+ let mutable argIndex = 0
+ let mutable tyIndex = 0
+
+ for step in steps do
+ match step with
+ | StepWithArg (prefix, conv) ->
+ env.WriteSkipEmpty prefix
+ let arg = args.[argIndex]
+ argIndex <- argIndex + 1
+ env.Write(conv arg)
+
+ | StepWithTypedArg (prefix, conv) ->
+ env.WriteSkipEmpty prefix
+ let arg = args.[argIndex]
+ let argTy = argTys.[tyIndex]
+ argIndex <- argIndex + 1
+ tyIndex <- tyIndex + 1
+ env.Write(conv arg argTy)
+
+ | StepString prefix ->
+ env.WriteSkipEmpty prefix
+
+ | StepLittleT(prefix) ->
+ env.WriteSkipEmpty prefix
+ let farg = args.[argIndex]
+ argIndex <- argIndex + 1
+ let f = farg :?> ('State -> 'Residue)
+ env.WriteT(f env.State)
+
+ | StepLittleA(prefix) ->
+ env.WriteSkipEmpty prefix
+ let farg = args.[argIndex]
+ argIndex <- argIndex + 1
+ let arg = args.[argIndex]
+ argIndex <- argIndex + 1
+ let f = farg :?> ('State -> obj -> 'Residue)
+ env.WriteT(f env.State arg)
+
+ | StepStar1(prefix, conv) ->
+ env.WriteSkipEmpty prefix
+ let star1 = args.[argIndex] :?> int
+ argIndex <- argIndex + 1
+ let arg1 = args.[argIndex]
+ argIndex <- argIndex + 1
+ env.Write (conv arg1 star1)
+
+ | StepPercentStar1(prefix) ->
+ argIndex <- argIndex + 1
+ env.WriteSkipEmpty prefix
+ env.Write("%")
+
+ | StepStar2(prefix, conv) ->
+ env.WriteSkipEmpty prefix
+ let star1 = args.[argIndex] :?> int
+ argIndex <- argIndex + 1
+ let star2 = args.[argIndex] :?> int
+ argIndex <- argIndex + 1
+ let arg1 = args.[argIndex]
+ argIndex <- argIndex + 1
+ env.Write (conv arg1 star1 star2)
+
+ | StepPercentStar2(prefix) ->
+ env.WriteSkipEmpty prefix
+ argIndex <- argIndex + 2
+ env.Write("%")
- /// Type of results produced by specialization
- /// This is function that accepts thunk to create PrintfEnv on demand and returns concrete instance of Printer (curried function)
- /// After all arguments is collected, specialization obtains concrete PrintfEnv from the thunk and use it to output collected data.
- type PrintfFactory<'State, 'Residue, 'Result, 'Printer> = (unit -> PrintfEnv<'State, 'Residue, 'Result>) -> 'Printer
+ env.Finish()
+
+ /// Type of results produced by specialization.
+ ///
+ /// This is a function that accepts a thunk to create PrintfEnv on demand (at the very last
+ /// appliction of an argument) and returns a concrete instance of an appriate curried printer.
+ ///
+ /// After all arguments are collected, specialization obtains concrete PrintfEnv from the thunk
+ /// and uses it to output collected data.
+ ///
+ /// Note the arguments must be captured in an *immutable* collection. For example consider
+ /// let f1 = printf "%d%d%d" 3 // activation captures '3' (args --> [3])
+ /// let f2 = f1 4 // same activation captures 4 (args --> [3;4])
+ /// let f3 = f1 5 // same activation captures 5 (args --> [3;5])
+ /// f2 7 // same activation captures 7 (args --> [3;4;7])
+ /// f3 8 // same activation captures 8 (args --> [3;5;8])
+ ///
+ /// If we captured into an mutable array then these would interfere
+ type PrintfInitial<'State, 'Residue, 'Result> = (unit -> PrintfEnv<'State, 'Residue, 'Result>)
+ type PrintfFuncFactory<'Printer, 'State, 'Residue, 'Result> =
+ delegate of obj list * PrintfInitial<'State, 'Residue, 'Result> -> 'Printer
[]
- let MaxArgumentsInSpecialization = 5
-
- /// Specializations are created via factory methods. These methods accepts 2 kinds of arguments
- /// - parts of format string that corresponds to raw text
- /// - functions that can transform collected values to strings
- /// basic shape of the signature of specialization
- /// + + + ... +
- type Specializations<'State, 'Residue, 'Result> private ()=
+ let MaxArgumentsInSpecialization = 3
+
+ let revToArray extra (args: 'T list) =
+ // We've reached the end, now fill in the array, reversing steps, avoiding reallocating
+ let n = args.Length
+ let res = Array.zeroCreate (n+extra)
+ let mutable j = 0
+ for arg in args do
+ res.[n-j-1] <- arg
+ j <- j + 1
+ res
+
+ type Specializations<'State, 'Residue, 'Result>() =
- static member Final1<'A>
- (
- s0, conv1, s1
- ) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (a: 'A) ->
- let env = env()
- Utils.Write(env, s0, (conv1 a), s1)
- env.Finish()
- )
- )
-
- static member FinalFastEnd1<'A>
- (
- s0, conv1
- ) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (a: 'A) ->
- let env = env()
- Utils.Write(env, s0, (conv1 a))
- env.Finish()
- )
- )
-
- static member FinalFastStart1<'A>
- (
- conv1, s1
- ) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (a: 'A) ->
- let env = env()
- Utils.Write(env, (conv1 a), s1)
- env.Finish()
- )
- )
-
- static member FinalFast1<'A>
- (
- conv1
- ) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (a: 'A) ->
- let env = env()
- env.Write (conv1 a)
- env.Finish()
- )
- )
-
- static member Final2<'A, 'B>
- (
- s0, conv1, s1, conv2, s2
- ) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (a: 'A) (b: 'B) ->
- let env = env()
- Utils.Write(env, s0, (conv1 a), s1, (conv2 b), s2)
- env.Finish()
- )
- )
-
- static member FinalFastEnd2<'A, 'B>
- (
- s0, conv1, s1, conv2
- ) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (a: 'A) (b: 'B) ->
- let env = env()
- Utils.Write(env, s0, (conv1 a), s1, (conv2 b))
- env.Finish()
- )
- )
-
- static member FinalFastStart2<'A, 'B>
- (
- conv1, s1, conv2, s2
- ) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (a: 'A) (b: 'B) ->
- let env = env()
- Utils.Write(env, (conv1 a), s1, (conv2 b), s2)
- env.Finish()
- )
- )
-
- static member FinalFast2<'A, 'B>
- (
- conv1, s1, conv2
- ) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (a: 'A) (b: 'B) ->
- let env = env()
- Utils.Write(env, (conv1 a), s1, (conv2 b))
- env.Finish()
- )
- )
-
- static member Final3<'A, 'B, 'C>
- (
- s0, conv1, s1, conv2, s2, conv3, s3
- ) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (a: 'A) (b: 'B) (c: 'C) ->
- let env = env()
- Utils.Write(env, s0, (conv1 a), s1, (conv2 b), s2, (conv3 c), s3)
- env.Finish()
- )
- )
-
- static member FinalFastEnd3<'A, 'B, 'C>
- (
- s0, conv1, s1, conv2, s2, conv3
- ) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (a: 'A) (b: 'B) (c: 'C) ->
- let env = env()
- Utils.Write(env, s0, (conv1 a), s1, (conv2 b), s2, (conv3 c))
- env.Finish()
- )
- )
-
- static member FinalFastStart3<'A, 'B, 'C>
- (
- conv1, s1, conv2, s2, conv3, s3
- ) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (a: 'A) (b: 'B) (c: 'C) ->
- let env = env()
- Utils.Write(env, (conv1 a), s1, (conv2 b), s2, (conv3 c), s3)
- env.Finish()
- )
- )
-
- static member FinalFast3<'A, 'B, 'C>
- (
- conv1, s1, conv2, s2, conv3
- ) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (a: 'A) (b: 'B) (c: 'C) ->
- let env = env()
- Utils.Write(env, (conv1 a), s1, (conv2 b), s2, (conv3 c))
- env.Finish()
- )
- )
-
- static member Final4<'A, 'B, 'C, 'D>
- (
- s0, conv1, s1, conv2, s2, conv3, s3, conv4, s4
- ) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (a: 'A) (b: 'B) (c: 'C) (d: 'D)->
- let env = env()
- Utils.Write(env, s0, (conv1 a), s1, (conv2 b), s2, (conv3 c), s3, (conv4 d), s4)
- env.Finish()
- )
- )
-
- static member FinalFastEnd4<'A, 'B, 'C, 'D>
- (
- s0, conv1, s1, conv2, s2, conv3, s3, conv4
- ) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (a: 'A) (b: 'B) (c: 'C) (d: 'D)->
- let env = env()
- Utils.Write(env, s0, (conv1 a), s1, (conv2 b), s2, (conv3 c), s3, (conv4 d))
- env.Finish()
- )
- )
-
- static member FinalFastStart4<'A, 'B, 'C, 'D>
- (
- conv1, s1, conv2, s2, conv3, s3, conv4, s4
- ) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (a: 'A) (b: 'B) (c: 'C) (d: 'D)->
- let env = env()
- Utils.Write(env, (conv1 a), s1, (conv2 b), s2, (conv3 c), s3, (conv4 d), s4)
- env.Finish()
- )
- )
-
- static member FinalFast4<'A, 'B, 'C, 'D>
- (
- conv1, s1, conv2, s2, conv3, s3, conv4
- ) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (a: 'A) (b: 'B) (c: 'C) (d: 'D)->
- let env = env()
- Utils.Write(env, (conv1 a), s1, (conv2 b), s2, (conv3 c), s3, (conv4 d))
- env.Finish()
- )
- )
-
- static member Final5<'A, 'B, 'C, 'D, 'E>
- (
- s0, conv1, s1, conv2, s2, conv3, s3, conv4, s4, conv5, s5
- ) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (a: 'A) (b: 'B) (c: 'C) (d: 'D) (e: 'E)->
- let env = env()
- Utils.Write(env, s0, (conv1 a), s1, (conv2 b), s2, (conv3 c), s3, (conv4 d), s4, (conv5 e), s5)
- env.Finish()
- )
- )
-
- static member FinalFastEnd5<'A, 'B, 'C, 'D, 'E>
- (
- s0, conv1, s1, conv2, s2, conv3, s3, conv4, s4, conv5
- ) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (a: 'A) (b: 'B) (c: 'C) (d: 'D) (e: 'E)->
- let env = env()
- Utils.Write(env, s0, (conv1 a), s1, (conv2 b), s2, (conv3 c), s3, (conv4 d), s4, (conv5 e))
- env.Finish()
- )
+ static member Final0(allSteps) =
+ PrintfFuncFactory<_, 'State, 'Residue, 'Result>(fun args initial ->
+ let env = initial()
+ env.RunSteps(revToArray 0 args, null, allSteps)
)
- static member FinalFastStart5<'A, 'B, 'C, 'D, 'E>
- (
- conv1, s1, conv2, s2, conv3, s3, conv4, s4, conv5, s5
- ) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (a: 'A) (b: 'B) (c: 'C) (d: 'D) (e: 'E)->
- let env = env()
- Utils.Write(env, (conv1 a), s1, (conv2 b), s2, (conv3 c), s3, (conv4 d), s4, (conv5 e), s5)
- env.Finish()
- )
- )
-
- static member FinalFast5<'A, 'B, 'C, 'D, 'E>
- (
- conv1, s1, conv2, s2, conv3, s3, conv4, s4, conv5
- ) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (a: 'A) (b: 'B) (c: 'C) (d: 'D) (e: 'E)->
- let env = env()
- Utils.Write(env, (conv1 a), s1, (conv2 b), s2, (conv3 c), s3, (conv4 d), s4, (conv5 e))
- env.Finish()
+ static member CaptureFinal1<'A>(allSteps) =
+ PrintfFuncFactory<_, 'State, 'Residue, 'Result>(fun args initial ->
+ (fun (arg1: 'A) ->
+ let env = initial()
+ let argArray = revToArray 1 args
+ argArray.[argArray.Length-1] <- box arg1
+ env.RunSteps(argArray, null, allSteps)
)
)
- static member Chained1<'A, 'Tail>
- (
- s0, conv1,
- next
- ) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (a: 'A) ->
- let env() =
- let env = env()
- Utils.Write(env, s0, (conv1 a))
- env
- next env : 'Tail
+ static member CaptureFinal2<'A, 'B>(allSteps) =
+ PrintfFuncFactory<_, 'State, 'Residue, 'Result>(fun args initial ->
+ (fun (arg1: 'A) (arg2: 'B) ->
+ let env = initial()
+ let argArray = revToArray 2 args
+ argArray.[argArray.Length-1] <- box arg2
+ argArray.[argArray.Length-2] <- box arg1
+ env.RunSteps(argArray, null, allSteps)
)
)
- static member ChainedFastStart1<'A, 'Tail>
- (
- conv1,
- next
- ) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (a: 'A) ->
- let env() =
- let env = env()
- env.Write(conv1 a)
- env
- next env : 'Tail
+ static member CaptureFinal3<'A, 'B, 'C>(allSteps) =
+ PrintfFuncFactory<_, 'State, 'Residue, 'Result>(fun args initial ->
+ (fun (arg1: 'A) (arg2: 'B) (arg3: 'C) ->
+ let env = initial()
+ let argArray = revToArray 3 args
+ argArray.[argArray.Length-1] <- box arg3
+ argArray.[argArray.Length-2] <- box arg2
+ argArray.[argArray.Length-3] <- box arg1
+ env.RunSteps(argArray, null, allSteps)
)
)
- static member Chained2<'A, 'B, 'Tail>
- (
- s0, conv1, s1, conv2,
- next
- ) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (a: 'A) (b: 'B) ->
- let env() =
- let env = env()
- Utils.Write(env, s0, (conv1 a), s1, (conv2 b))
- env
- next env : 'Tail
+ static member Capture1<'A, 'Tail>(next: PrintfFuncFactory<_, 'State, 'Residue, 'Result>) =
+ PrintfFuncFactory<_, 'State, 'Residue, 'Result>(fun args initial ->
+ (fun (arg1: 'A) ->
+ let args = (box arg1 :: args)
+ next.Invoke(args, initial) : 'Tail
)
)
- static member ChainedFastStart2<'A, 'B, 'Tail>
- (
- conv1, s1, conv2,
- next
- ) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (a: 'A) (b: 'B) ->
- let env() =
- let env = env()
- Utils.Write(env, (conv1 a), s1, (conv2 b))
- env
- next env : 'Tail
+ static member CaptureLittleA<'A, 'Tail>(next: PrintfFuncFactory<_, 'State, 'Residue, 'Result>) =
+ PrintfFuncFactory<_, 'State, 'Residue, 'Result>(fun args initial ->
+ (fun (f: 'State -> 'A -> 'Residue) (arg1: 'A) ->
+ let args = box arg1 :: box (fun s (arg:obj) -> f s (unbox arg)) :: args
+ next.Invoke(args, initial) : 'Tail
)
)
- static member Chained3<'A, 'B, 'C, 'Tail>
- (
- s0, conv1, s1, conv2, s2, conv3,
- next
- ) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (a: 'A) (b: 'B) (c: 'C) ->
- let env() =
- let env = env()
- Utils.Write(env, s0, (conv1 a), s1, (conv2 b), s2, (conv3 c))
- env
- next env : 'Tail
- )
- )
-
- static member ChainedFastStart3<'A, 'B, 'C, 'Tail>
- (
- conv1, s1, conv2, s2, conv3,
- next
- ) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (a: 'A) (b: 'B) (c: 'C) ->
- let env() =
- let env = env()
- Utils.Write(env, (conv1 a), s1, (conv2 b), s2, (conv3 c))
- env
- next env : 'Tail
- )
- )
-
- static member Chained4<'A, 'B, 'C, 'D, 'Tail>
- (
- s0, conv1, s1, conv2, s2, conv3, s3, conv4,
- next
- ) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (a: 'A) (b: 'B) (c: 'C) (d: 'D)->
- let env() =
- let env = env()
- Utils.Write(env, s0, (conv1 a), s1, (conv2 b), s2, (conv3 c), s3, (conv4 d))
- env
- next env : 'Tail
- )
- )
-
- static member ChainedFastStart4<'A, 'B, 'C, 'D, 'Tail>
- (
- conv1, s1, conv2, s2, conv3, s3, conv4,
- next
- ) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (a: 'A) (b: 'B) (c: 'C) (d: 'D)->
- let env() =
- let env = env()
- Utils.Write(env, (conv1 a), s1, (conv2 b), s2, (conv3 c), s3, (conv4 d))
- env
- next env : 'Tail
- )
- )
-
- static member Chained5<'A, 'B, 'C, 'D, 'E, 'Tail>
- (
- s0, conv1, s1, conv2, s2, conv3, s3, conv4, s4, conv5,
- next
- ) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (a: 'A) (b: 'B) (c: 'C) (d: 'D) (e: 'E)->
- let env() =
- let env = env()
- Utils.Write(env, s0, (conv1 a), s1, (conv2 b), s2, (conv3 c), s3, (conv4 d), s4, (conv5 e))
- env
- next env : 'Tail
- )
- )
-
- static member ChainedFastStart5<'A, 'B, 'C, 'D, 'E, 'Tail>
- (
- conv1, s1, conv2, s2, conv3, s3, conv4, s4, conv5,
- next
- ) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (a: 'A) (b: 'B) (c: 'C) (d: 'D) (e: 'E)->
- let env() =
- let env = env()
- Utils.Write(env, (conv1 a), s1, (conv2 b), s2, (conv3 c), s3, (conv4 d), s4, (conv5 e))
- env
- next env : 'Tail
- )
- )
-
- static member TFinal(s1: string, s2: string) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (f: 'State -> 'Residue) ->
- let env = env()
- env.Write s1
- env.WriteT(f env.State)
- env.Write s2
- env.Finish()
- )
- )
- static member TChained<'Tail>(s1: string, next: PrintfFactory<'State, 'Residue, 'Result,'Tail>) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (f: 'State -> 'Residue) ->
- let env() =
- let env = env()
- env.Write s1
- env.WriteT(f env.State)
- env
- next env: 'Tail
- )
- )
-
- static member LittleAFinal<'A>(s1: string, s2: string) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (f: 'State -> 'A ->'Residue) (a: 'A) ->
- let env = env()
- env.Write s1
- env.WriteT(f env.State a)
- env.Write s2
- env.Finish()
- )
- )
- static member LittleAChained<'A, 'Tail>(s1: string, next: PrintfFactory<'State, 'Residue, 'Result,'Tail>) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (f: 'State -> 'A ->'Residue) (a: 'A) ->
- let env() =
- let env = env()
- env.Write s1
- env.WriteT(f env.State a)
- env
- next env: 'Tail
- )
- )
-
- static member StarFinal1<'A>(s1: string, conv, s2: string) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (star1: int) (a: 'A) ->
- let env = env()
- env.Write s1
- env.Write (conv a star1: string)
- env.Write s2
- env.Finish()
- )
- )
-
- static member PercentStarFinal1(s1: string, s2: string) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (_star1 : int) ->
- let env = env()
- env.Write s1
- env.Write("%")
- env.Write s2
- env.Finish()
+ static member Capture2<'A, 'B, 'Tail>(next: PrintfFuncFactory<_, 'State, 'Residue, 'Result>) =
+ PrintfFuncFactory<_, 'State, 'Residue, 'Result>(fun args initial ->
+ (fun (arg1: 'A) (arg2: 'B) ->
+ let args = box arg2 :: box arg1 :: args
+ next.Invoke(args, initial) : 'Tail
)
)
- static member StarFinal2<'A>(s1: string, conv, s2: string) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (star1: int) (star2: int) (a: 'A) ->
- let env = env()
- env.Write s1
- env.Write (conv a star1 star2: string)
- env.Write s2
- env.Finish()
+ static member Capture3<'A, 'B, 'C, 'Tail>(next: PrintfFuncFactory<_, 'State, 'Residue, 'Result>) =
+ PrintfFuncFactory<_, 'State, 'Residue, 'Result>(fun args initial ->
+ (fun (arg1: 'A) (arg2: 'B) (arg3: 'C) ->
+ let args = box arg3 :: box arg2 :: box arg1 :: args
+ next.Invoke(args, initial) : 'Tail
)
)
- /// Handles case when '%*.*%' is used at the end of string
- static member PercentStarFinal2(s1: string, s2: string) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (_star1 : int) (_star2 : int) ->
- let env = env()
- env.Write s1
- env.Write("%")
- env.Write s2
- env.Finish()
- )
+ // Special case for format strings containing just one '%d' etc, i.e. StepWithArg then StepString.
+ // This avoids allocating an argument array, and unfolds the single iteration of RunSteps.
+ static member OneStepWithArg<'A>(prefix1, conv1, prefix2) =
+ PrintfFuncFactory<_, 'State, 'Residue, 'Result>(fun _args initial ->
+ // Note this is the actual computed/stored closure for
+ // sprintf "prefix1 %d prefix2"
+ // for any simple format specifiers, where conv1 and conv2 will depend on the format specifiers etc.
+ (fun (arg1: 'A) ->
+ let env = initial()
+ env.WriteSkipEmpty prefix1
+ env.Write(conv1 (box arg1))
+ env.WriteSkipEmpty prefix2
+ env.Finish())
)
- static member StarChained1<'A, 'Tail>(s1: string, conv, next: PrintfFactory<'State, 'Residue, 'Result,'Tail>) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (star1: int) (a: 'A) ->
- let env() =
- let env = env()
- env.Write s1
- env.Write(conv a star1 : string)
- env
- next env : 'Tail
- )
- )
-
- /// Handles case when '%*%' is used in the middle of the string so it needs to be chained to another printing block
- static member PercentStarChained1<'Tail>(s1: string, next: PrintfFactory<'State, 'Residue, 'Result,'Tail>) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (_star1 : int) ->
- let env() =
- let env = env()
- env.Write s1
- env.Write("%")
- env
- next env: 'Tail
- )
+ // Special case for format strings containing two simple formats like '%d %s' etc, i.e.
+ ///StepWithArg then StepWithArg then StepString. This avoids allocating an argument array,
+ // and unfolds the two iteration of RunSteps.
+ static member TwoStepWithArg<'A, 'B>(prefix1, conv1, prefix2, conv2, prefix3) =
+ PrintfFuncFactory<_, 'State, 'Residue, 'Result>(fun _args initial ->
+ // Note this is the actual computed/stored closure for
+ // sprintf "prefix1 %d prefix2 %s prefix3"
+ // for any simple format specifiers, where conv1 and conv2 will depend on the format specifiers etc.
+ (fun (arg1: 'A) (arg2: 'B) ->
+ let env = initial()
+ env.WriteSkipEmpty prefix1
+ env.Write(conv1 (box arg1))
+ env.WriteSkipEmpty prefix2
+ env.Write(conv2 (box arg2))
+ env.WriteSkipEmpty prefix3
+ env.Finish())
)
- static member StarChained2<'A, 'Tail>(s1: string, conv, next: PrintfFactory<'State, 'Residue, 'Result,'Tail>) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (star1: int) (star2: int) (a: 'A) ->
- let env() =
- let env = env()
- env.Write s1
- env.Write(conv a star1 star2 : string)
- env
- next env : 'Tail
- )
- )
-
- /// Handles case when '%*.*%' is used in the middle of the string so it needs to be chained to another printing block
- static member PercentStarChained2<'Tail>(s1: string, next: PrintfFactory<'State, 'Residue, 'Result,'Tail>) =
- (fun (env: unit -> PrintfEnv<'State, 'Residue, 'Result>) ->
- (fun (_star1 : int) (_star2 : int) ->
- let env() =
- let env = env()
- env.Write s1
- env.Write("%")
- env
- next env : 'Tail
- )
- )
-
let inline (===) a b = Object.ReferenceEquals(a, b)
- let invariantCulture = System.Globalization.CultureInfo.InvariantCulture
let inline boolToString v = if v then "true" else "false"
+
let inline stringToSafeString v =
match v with
| null -> ""
@@ -757,7 +536,18 @@ module internal PrintfImpl =
[]
let DefaultPrecision = 6
+ /// A wrapper struct used to slightly strengthen the types of "ValueConverter" objects produced during composition of
+ /// the dynamic implementation. These are always functions but sometimes they take one argument, sometimes two.
+ []
+ type ValueConverter private (f: obj) =
+ member x.FuncObj = f
+
+ static member inline Make (f: obj -> string) = ValueConverter(box f)
+ static member inline Make (f: obj -> int -> string) = ValueConverter(box f)
+ static member inline Make (f: obj -> int-> int -> string) = ValueConverter(box f)
+
let getFormatForFloat (ch: char) (prec: int) = ch.ToString() + prec.ToString()
+
let normalizePrecision prec = min (max prec 0) 99
/// Contains helpers to convert printer functions to functions that prints value with respect to specified justification
@@ -768,32 +558,33 @@ module internal PrintfImpl =
/// - withPadding - adapts first category
/// - withPaddingFormatted - adapts second category
module Padding =
+
/// pad here is function that converts T to string with respect of justification
/// basic - function that converts T to string without applying justification rules
/// adaptPaddedFormatted returns boxed function that has various number of arguments depending on if width\precision flags has '*' value
- let inline adaptPaddedFormatted (spec: FormatSpecifier) getFormat (basic: string -> 'T -> string) (pad: string -> int -> 'T -> string) =
+ let adaptPaddedFormatted (spec: FormatSpecifier) getFormat (basic: string -> obj -> string) (pad: string -> int -> obj -> string) : ValueConverter =
if spec.IsStarWidth then
if spec.IsStarPrecision then
// width=*, prec=*
- box(fun v width prec ->
+ ValueConverter.Make (fun v width prec ->
let fmt = getFormat (normalizePrecision prec)
pad fmt width v)
else
// width=*, prec=?
let prec = if spec.IsPrecisionSpecified then normalizePrecision spec.Precision else DefaultPrecision
let fmt = getFormat prec
- box(fun v width ->
+ ValueConverter.Make (fun v width ->
pad fmt width v)
elif spec.IsStarPrecision then
if spec.IsWidthSpecified then
// width=val, prec=*
- box(fun v prec ->
+ ValueConverter.Make (fun v prec ->
let fmt = getFormat prec
pad fmt spec.Width v)
else
// width=X, prec=*
- box(fun v prec ->
+ ValueConverter.Make (fun v prec ->
let fmt = getFormat prec
basic fmt v)
else
@@ -801,75 +592,88 @@ module internal PrintfImpl =
let fmt = getFormat prec
if spec.IsWidthSpecified then
// width=val, prec=*
- box(fun v ->
+ ValueConverter.Make (fun v ->
pad fmt spec.Width v)
else
// width=X, prec=*
- box(fun v ->
+ ValueConverter.Make (fun v ->
basic fmt v)
/// pad here is function that converts T to string with respect of justification
/// basic - function that converts T to string without applying justification rules
/// adaptPadded returns boxed function that has various number of arguments depending on if width flags has '*' value
- let inline adaptPadded (spec: FormatSpecifier) (basic: 'T -> string) (pad: int -> 'T -> string) =
+ let adaptPadded (spec: FormatSpecifier) (basic: obj -> string) (pad: int -> obj -> string) : ValueConverter =
if spec.IsStarWidth then
- // width=*, prec=?
- box(fun v width ->
- pad width v)
+ // width=*, prec=?
+ ValueConverter.Make (fun v width ->
+ pad width v)
else
if spec.IsWidthSpecified then
// width=val, prec=*
- box(fun v ->
+ ValueConverter.Make (fun v ->
pad spec.Width v)
else
// width=X, prec=*
- box(fun v ->
+ ValueConverter.Make (fun v ->
basic v)
- let inline withPaddingFormatted (spec: FormatSpecifier) getFormat (defaultFormat: string) (f: string -> 'T -> string) left right =
+ let withPaddingFormatted (spec: FormatSpecifier) getFormat (defaultFormat: string) (f: string -> obj -> string) left right : ValueConverter =
if not (spec.IsWidthSpecified || spec.IsPrecisionSpecified) then
- box (f defaultFormat)
+ ValueConverter.Make (f defaultFormat)
else
if isLeftJustify spec.Flags then
adaptPaddedFormatted spec getFormat f left
else
adaptPaddedFormatted spec getFormat f right
- let inline withPadding (spec: FormatSpecifier) (f: 'T -> string) left right =
+ let withPadding (spec: FormatSpecifier) (f: obj -> string) left right : ValueConverter =
if not spec.IsWidthSpecified then
- box f
+ ValueConverter.Make f
else
if isLeftJustify spec.Flags then
adaptPadded spec f left
else
adaptPadded spec f right
- let inline isNumber (x: ^T) =
- not (^T: (static member IsPositiveInfinity: 'T -> bool) x) && not (^T: (static member IsNegativeInfinity: 'T -> bool) x) && not (^T: (static member IsNaN: 'T -> bool) x)
-
- let inline isInteger n =
- n % LanguagePrimitives.GenericOne = LanguagePrimitives.GenericZero
-
- let inline isPositive n =
- n >= LanguagePrimitives.GenericZero
-
- /// contains functions to handle left\right justifications for non-numeric types (strings\bools)
+ /// Contains functions to handle left/right justifications for non-numeric types (strings/bools)
module Basic =
- let inline leftJustify (f: 'T -> string) padChar =
+ let leftJustify (f: obj -> string) padChar =
fun (w: int) v ->
(f v).PadRight(w, padChar)
- let inline rightJustify (f: 'T -> string) padChar =
+ let rightJustify (f: obj -> string) padChar =
fun (w: int) v ->
(f v).PadLeft(w, padChar)
- /// contains functions to handle left\right and no justification case for numbers
+ let withPadding (spec: FormatSpecifier) f =
+ let padChar, _ = spec.GetPadAndPrefix false
+ Padding.withPadding spec f (leftJustify f padChar) (rightJustify f padChar)
+
+ /// Contains functions to handle left/right and no justification case for numbers
module GenericNumber =
+
+ let isPositive (n: obj) =
+ match n with
+ | :? int8 as n -> n >= 0y
+ | :? uint8 -> true
+ | :? int16 as n -> n >= 0s
+ | :? uint16 -> true
+ | :? int32 as n -> n >= 0
+ | :? uint32 -> true
+ | :? int64 as n -> n >= 0L
+ | :? uint64 -> true
+ | :? nativeint as n -> n >= 0n
+ | :? unativeint -> true
+ | :? single as n -> n >= 0.0f
+ | :? double as n -> n >= 0.0
+ | :? decimal as n -> n >= 0.0M
+ | _ -> failwith "isPositive: unreachable"
+
/// handles right justification when pad char = '0'
/// this case can be tricky:
/// - negative numbers, -7 should be printed as '-007', not '00-7'
/// - positive numbers when prefix for positives is set: 7 should be '+007', not '00+7'
- let inline rightJustifyWithZeroAsPadChar (str: string) isNumber isPositive w (prefixForPositives: string) =
+ let rightJustifyWithZeroAsPadChar (str: string) isNumber isPositive w (prefixForPositives: string) =
System.Diagnostics.Debug.Assert(prefixForPositives.Length = 0 || prefixForPositives.Length = 1)
if isNumber then
if isPositive then
@@ -884,12 +688,12 @@ module internal PrintfImpl =
str.PadLeft(w, ' ')
/// handler right justification when pad char = ' '
- let inline rightJustifyWithSpaceAsPadChar (str: string) isNumber isPositive w (prefixForPositives: string) =
+ let rightJustifyWithSpaceAsPadChar (str: string) isNumber isPositive w (prefixForPositives: string) =
System.Diagnostics.Debug.Assert(prefixForPositives.Length = 0 || prefixForPositives.Length = 1)
(if isNumber && isPositive then prefixForPositives + str else str).PadLeft(w, ' ')
/// handles left justification with formatting with 'G'\'g' - either for decimals or with 'g'\'G' is explicitly set
- let inline leftJustifyWithGFormat (str: string) isNumber isInteger isPositive w (prefixForPositives: string) padChar =
+ let leftJustifyWithGFormat (str: string) isNumber isInteger isPositive w (prefixForPositives: string) padChar =
if isNumber then
let str = if isPositive then prefixForPositives + str else str
// NOTE: difference - for 'g' format we use isInt check to detect situations when '5.0' is printed as '5'
@@ -901,7 +705,7 @@ module internal PrintfImpl =
else
str.PadRight(w, ' ') // pad NaNs with ' '
- let inline leftJustifyWithNonGFormat (str: string) isNumber isPositive w (prefixForPositives: string) padChar =
+ let leftJustifyWithNonGFormat (str: string) isNumber isPositive w (prefixForPositives: string) padChar =
if isNumber then
let str = if isPositive then prefixForPositives + str else str
str.PadRight(w, padChar)
@@ -909,163 +713,217 @@ module internal PrintfImpl =
str.PadRight(w, ' ') // pad NaNs with ' '
/// processes given string based depending on values isNumber\isPositive
- let inline noJustificationCore (str: string) isNumber isPositive prefixForPositives =
+ let noJustificationCore (str: string) isNumber isPositive prefixForPositives =
if isNumber && isPositive then prefixForPositives + str
else str
/// noJustification handler for f: 'T -> string - basic integer types
- let inline noJustification f (prefix: string) isUnsigned =
+ let noJustification (f: obj -> string) (prefix: string) isUnsigned =
if isUnsigned then
- fun v -> noJustificationCore (f v) true true prefix
+ fun (v: obj) -> noJustificationCore (f v) true true prefix
else
- fun v -> noJustificationCore (f v) true (isPositive v) prefix
+ fun (v: obj) -> noJustificationCore (f v) true (isPositive v) prefix
- /// noJustification handler for f: string -> 'T -> string - floating point types
- let inline noJustificationWithFormat f (prefix: string) =
- fun (fmt: string) v -> noJustificationCore (f fmt v) true (isPositive v) prefix
-
- /// leftJustify handler for f: 'T -> string - basic integer types
- let inline leftJustify isGFormat f (prefix: string) padChar isUnsigned =
+ /// contains functions to handle left\right and no justification case for numbers
+ module Integer =
+
+ let eliminateNative (v: obj) =
+ match v with
+ | :? nativeint as n ->
+ if IntPtr.Size = 4 then box (n.ToInt32())
+ else box (n.ToInt64())
+ | :? unativeint as n ->
+ if IntPtr.Size = 4 then box (uint32 (n.ToUInt32()))
+ else box (uint64 (n.ToUInt64()))
+ | _ -> v
+
+ let rec toString (v: obj) =
+ match v with
+ | :? int32 as n -> n.ToString(CultureInfo.InvariantCulture)
+ | :? int64 as n -> n.ToString(CultureInfo.InvariantCulture)
+ | :? sbyte as n -> n.ToString(CultureInfo.InvariantCulture)
+ | :? byte as n -> n.ToString(CultureInfo.InvariantCulture)
+ | :? int16 as n -> n.ToString(CultureInfo.InvariantCulture)
+ | :? uint16 as n -> n.ToString(CultureInfo.InvariantCulture)
+ | :? uint32 as n -> n.ToString(CultureInfo.InvariantCulture)
+ | :? uint64 as n -> n.ToString(CultureInfo.InvariantCulture)
+ | :? nativeint | :? unativeint -> toString (eliminateNative v)
+ | _ -> failwith "toString: unreachable"
+
+ let rec toFormattedString fmt (v: obj) =
+ match v with
+ | :? int32 as n -> n.ToString(fmt, CultureInfo.InvariantCulture)
+ | :? int64 as n -> n.ToString(fmt, CultureInfo.InvariantCulture)
+ | :? sbyte as n -> n.ToString(fmt, CultureInfo.InvariantCulture)
+ | :? byte as n -> n.ToString(fmt, CultureInfo.InvariantCulture)
+ | :? int16 as n -> n.ToString(fmt, CultureInfo.InvariantCulture)
+ | :? uint16 as n -> n.ToString(fmt, CultureInfo.InvariantCulture)
+ | :? uint32 as n -> n.ToString(fmt, CultureInfo.InvariantCulture)
+ | :? uint64 as n -> n.ToString(fmt, CultureInfo.InvariantCulture)
+ | :? nativeint | :? unativeint -> toFormattedString fmt (eliminateNative v)
+ | _ -> failwith "toFormattedString: unreachable"
+
+ let rec toUnsigned (v: obj) =
+ match v with
+ | :? int32 as n -> box (uint32 n)
+ | :? int64 as n -> box (uint64 n)
+ | :? sbyte as n -> box (byte n)
+ | :? int16 as n -> box (uint16 n)
+ | :? nativeint | :? unativeint -> toUnsigned (eliminateNative v)
+ | _ -> v
+
+ /// Left justification handler for f: 'T -> string - basic integer types
+ let leftJustify isGFormat (f: obj -> string) (prefix: string) padChar isUnsigned =
if isUnsigned then
if isGFormat then
- fun (w: int) v ->
- leftJustifyWithGFormat (f v) true (isInteger v) true w prefix padChar
+ fun (w: int) (v: obj) ->
+ GenericNumber.leftJustifyWithGFormat (f v) true true true w prefix padChar
else
- fun (w: int) v ->
- leftJustifyWithNonGFormat (f v) true true w prefix padChar
+ fun (w: int) (v: obj) ->
+ GenericNumber.leftJustifyWithNonGFormat (f v) true true w prefix padChar
else
if isGFormat then
- fun (w: int) v ->
- leftJustifyWithGFormat (f v) true (isInteger v) (isPositive v) w prefix padChar
+ fun (w: int) (v: obj) ->
+ GenericNumber.leftJustifyWithGFormat (f v) true true (GenericNumber.isPositive v) w prefix padChar
else
- fun (w: int) v ->
- leftJustifyWithNonGFormat (f v) true (isPositive v) w prefix padChar
+ fun (w: int) (v: obj) ->
+ GenericNumber.leftJustifyWithNonGFormat (f v) true (GenericNumber.isPositive v) w prefix padChar
- /// leftJustify handler for f: string -> 'T -> string - floating point types
- let inline leftJustifyWithFormat isGFormat f (prefix: string) padChar =
- if isGFormat then
- fun (fmt: string) (w: int) v ->
- leftJustifyWithGFormat (f fmt v) true (isInteger v) (isPositive v) w prefix padChar
- else
- fun (fmt: string) (w: int) v ->
- leftJustifyWithNonGFormat (f fmt v) true (isPositive v) w prefix padChar
-
- /// rightJustify handler for f: 'T -> string - basic integer types
- let inline rightJustify f (prefixForPositives: string) padChar isUnsigned =
+ /// Right justification handler for f: 'T -> string - basic integer types
+ let rightJustify f (prefixForPositives: string) padChar isUnsigned =
if isUnsigned then
if padChar = '0' then
- fun (w: int) v ->
- rightJustifyWithZeroAsPadChar (f v) true true w prefixForPositives
+ fun (w: int) (v: obj) ->
+ GenericNumber.rightJustifyWithZeroAsPadChar (f v) true true w prefixForPositives
else
System.Diagnostics.Debug.Assert((padChar = ' '))
- fun (w: int) v ->
- rightJustifyWithSpaceAsPadChar (f v) true true w prefixForPositives
+ fun (w: int) (v: obj) ->
+ GenericNumber.rightJustifyWithSpaceAsPadChar (f v) true true w prefixForPositives
else
if padChar = '0' then
- fun (w: int) v ->
- rightJustifyWithZeroAsPadChar (f v) true (isPositive v) w prefixForPositives
+ fun (w: int) (v: obj) ->
+ GenericNumber.rightJustifyWithZeroAsPadChar (f v) true (GenericNumber.isPositive v) w prefixForPositives
else
System.Diagnostics.Debug.Assert((padChar = ' '))
fun (w: int) v ->
- rightJustifyWithSpaceAsPadChar (f v) true (isPositive v) w prefixForPositives
-
- /// rightJustify handler for f: string -> 'T -> string - floating point types
- let inline rightJustifyWithFormat f (prefixForPositives: string) padChar =
- if padChar = '0' then
- fun (fmt: string) (w: int) v ->
- rightJustifyWithZeroAsPadChar (f fmt v) true (isPositive v) w prefixForPositives
-
- else
- System.Diagnostics.Debug.Assert((padChar = ' '))
- fun (fmt: string) (w: int) v ->
- rightJustifyWithSpaceAsPadChar (f fmt v) true (isPositive v) w prefixForPositives
- module Float =
- let inline noJustification f (prefixForPositives: string) =
- fun (fmt: string) v ->
- GenericNumber.noJustificationCore (f fmt v) (isNumber v) (isPositive v) prefixForPositives
+ GenericNumber.rightJustifyWithSpaceAsPadChar (f v) true (GenericNumber.isPositive v) w prefixForPositives
+
+ /// Computes a new function from 'f' that wraps the basic conversion given
+ /// by 'f' with padding for 0, spacing and justification, if the flags specify
+ /// it. If they don't, f is made into a value converter
+ let withPadding (spec: FormatSpecifier) isUnsigned (f: obj -> string) =
+ let allowZeroPadding = not (isLeftJustify spec.Flags) || spec.IsDecimalFormat
+ let padChar, prefix = spec.GetPadAndPrefix allowZeroPadding
+ Padding.withPadding spec
+ (GenericNumber.noJustification f prefix isUnsigned)
+ (leftJustify spec.IsGFormat f prefix padChar isUnsigned)
+ (rightJustify f prefix padChar isUnsigned)
+
+ let getValueConverter (spec: FormatSpecifier) : ValueConverter =
+ let c = spec.TypeChar
+ if c = 'd' || c = 'i' then
+ withPadding spec false toString
+ elif c = 'u' then
+ withPadding spec true (toUnsigned >> toString)
+ elif c = 'x' then
+ withPadding spec true (toFormattedString "x")
+ elif c = 'X' then
+ withPadding spec true (toFormattedString "X")
+ elif c = 'o' then
+ withPadding spec true (fun (v: obj) ->
+ match toUnsigned v with
+ | :? uint64 as u -> Convert.ToString(int64 u, 8)
+ | u -> Convert.ToString(Convert.ToInt64 u, 8))
+ else raise (ArgumentException())
+
+ module FloatAndDecimal =
+
+ let rec toFormattedString fmt (v: obj) =
+ match v with
+ | :? single as n -> n.ToString(fmt, CultureInfo.InvariantCulture)
+ | :? double as n -> n.ToString(fmt, CultureInfo.InvariantCulture)
+ | :? decimal as n -> n.ToString(fmt, CultureInfo.InvariantCulture)
+ | _ -> failwith "toFormattedString: unreachable"
+
+ let isNumber (x: obj) =
+ match x with
+ | :? single as x ->
+ not (Single.IsPositiveInfinity(x)) &&
+ not (Single.IsNegativeInfinity(x)) &&
+ not (Single.IsNaN(x))
+ | :? double as x ->
+ not (Double.IsPositiveInfinity(x)) &&
+ not (Double.IsNegativeInfinity(x)) &&
+ not (Double.IsNaN(x))
+ | :? decimal -> true
+ | _ -> failwith "isNumber: unreachable"
+
+ let isInteger (n: obj) =
+ match n with
+ | :? single as n -> n % 1.0f = 0.0f
+ | :? double as n -> n % 1. = 0.
+ | :? decimal as n -> n % 1.0M = 0.0M
+ | _ -> failwith "isInteger: unreachable"
+
+ let noJustification (prefixForPositives: string) =
+ fun (fmt: string) (v: obj) ->
+ GenericNumber.noJustificationCore (toFormattedString fmt v) (isNumber v) (GenericNumber.isPositive v) prefixForPositives
- let inline leftJustify isGFormat f (prefix: string) padChar =
+ let leftJustify isGFormat (prefix: string) padChar =
if isGFormat then
- fun (fmt: string) (w: int) v ->
- GenericNumber.leftJustifyWithGFormat (f fmt v) (isNumber v) (isInteger v) (isPositive v) w prefix padChar
+ fun (fmt: string) (w: int) (v: obj) ->
+ GenericNumber.leftJustifyWithGFormat (toFormattedString fmt v) (isNumber v) (isInteger v) (GenericNumber.isPositive v) w prefix padChar
else
- fun (fmt: string) (w: int) v ->
- GenericNumber.leftJustifyWithNonGFormat (f fmt v) (isNumber v) (isPositive v) w prefix padChar
+ fun (fmt: string) (w: int) (v: obj) ->
+ GenericNumber.leftJustifyWithNonGFormat (toFormattedString fmt v) (isNumber v) (GenericNumber.isPositive v) w prefix padChar
- let inline rightJustify f (prefixForPositives: string) padChar =
+ let rightJustify (prefixForPositives: string) padChar =
if padChar = '0' then
- fun (fmt: string) (w: int) v ->
- GenericNumber.rightJustifyWithZeroAsPadChar (f fmt v) (isNumber v) (isPositive v) w prefixForPositives
+ fun (fmt: string) (w: int) (v: obj) ->
+ GenericNumber.rightJustifyWithZeroAsPadChar (toFormattedString fmt v) (isNumber v) (GenericNumber.isPositive v) w prefixForPositives
else
System.Diagnostics.Debug.Assert((padChar = ' '))
- fun (fmt: string) (w: int) v ->
- GenericNumber.rightJustifyWithSpaceAsPadChar (f fmt v) (isNumber v) (isPositive v) w prefixForPositives
-
- let isDecimalFormatSpecifier (spec: FormatSpecifier) =
- spec.TypeChar = 'M'
-
- let getPadAndPrefix allowZeroPadding (spec: FormatSpecifier) =
- let padChar = if allowZeroPadding && isPadWithZeros spec.Flags then '0' else ' ';
- let prefix =
- if isPlusForPositives spec.Flags then "+"
- elif isSpaceForPositives spec.Flags then " "
- else ""
- padChar, prefix
-
- let isGFormat(spec: FormatSpecifier) =
- isDecimalFormatSpecifier spec || System.Char.ToLower(spec.TypeChar) = 'g'
-
- let inline basicWithPadding (spec: FormatSpecifier) f =
- let padChar, _ = getPadAndPrefix false spec
- Padding.withPadding spec f (Basic.leftJustify f padChar) (Basic.rightJustify f padChar)
-
- let inline numWithPadding (spec: FormatSpecifier) isUnsigned f =
- let allowZeroPadding = not (isLeftJustify spec.Flags) || isDecimalFormatSpecifier spec
- let padChar, prefix = getPadAndPrefix allowZeroPadding spec
- let isGFormat = isGFormat spec
- Padding.withPadding spec (GenericNumber.noJustification f prefix isUnsigned) (GenericNumber.leftJustify isGFormat f prefix padChar isUnsigned) (GenericNumber.rightJustify f prefix padChar isUnsigned)
-
- let inline decimalWithPadding (spec: FormatSpecifier) getFormat defaultFormat f =
- let padChar, prefix = getPadAndPrefix true spec
- let isGFormat = isGFormat spec
- Padding.withPaddingFormatted spec getFormat defaultFormat (GenericNumber.noJustificationWithFormat f prefix) (GenericNumber.leftJustifyWithFormat isGFormat f prefix padChar) (GenericNumber.rightJustifyWithFormat f prefix padChar)
-
- let inline floatWithPadding (spec: FormatSpecifier) getFormat defaultFormat f =
- let padChar, prefix = getPadAndPrefix true spec
- let isGFormat = isGFormat spec
- Padding.withPaddingFormatted spec getFormat defaultFormat (Float.noJustification f prefix) (Float.leftJustify isGFormat f prefix padChar) (Float.rightJustify f prefix padChar)
-
- let inline identity v = v
- let inline toString v = (^T : (member ToString: IFormatProvider -> string)(v, invariantCulture))
- let inline toFormattedString fmt = fun (v: ^T) -> (^T: (member ToString: string * IFormatProvider -> string)(v, fmt, invariantCulture))
-
- let inline numberToString c spec alt unsignedConv =
- if c = 'd' || c = 'i' then
- numWithPadding spec false (alt >> toString: ^T -> string)
- elif c = 'u' then
- numWithPadding spec true (alt >> unsignedConv >> toString: ^T -> string)
- elif c = 'x' then
- numWithPadding spec true (alt >> toFormattedString "x": ^T -> string)
- elif c = 'X' then
- numWithPadding spec true (alt >> toFormattedString "X": ^T -> string )
- elif c = 'o' then
- numWithPadding spec true (fun (v: ^T) -> Convert.ToString(int64(unsignedConv (alt v)), 8))
- else raise (ArgumentException())
-
+ fun (fmt: string) (w: int) (v: obj) ->
+ GenericNumber.rightJustifyWithSpaceAsPadChar (toFormattedString fmt v) (isNumber v) (GenericNumber.isPositive v) w prefixForPositives
+
+ let withPadding (spec: FormatSpecifier) getFormat defaultFormat =
+ let padChar, prefix = spec.GetPadAndPrefix true
+ Padding.withPaddingFormatted spec getFormat defaultFormat
+ (noJustification prefix)
+ (leftJustify spec.IsGFormat prefix padChar)
+ (rightJustify prefix padChar)
+
type ObjectPrinter =
- static member ObjectToString<'T>(spec: FormatSpecifier) =
- basicWithPadding spec (fun (v: 'T) -> match box v with null -> "" | x -> x.ToString())
+
+ static member ObjectToString(spec: FormatSpecifier) : ValueConverter =
+ Basic.withPadding spec (fun (v: obj) ->
+ match v with
+ | null -> ""
+ | x -> x.ToString())
+
+ /// Convert an interpoland to a string
+ static member InterpolandToString(spec: FormatSpecifier) : ValueConverter =
+ let fmt =
+ match spec.InteropHoleDotNetFormat with
+ | ValueNone -> null
+ | ValueSome fmt -> "{0:" + fmt + "}"
+ Basic.withPadding spec (fun (vobj: obj) ->
+ match vobj with
+ | null -> ""
+ | x ->
+ match fmt with
+ | null -> x.ToString()
+ | fmt -> String.Format(fmt, x))
static member GenericToStringCore(v: 'T, opts: Microsoft.FSharp.Text.StructuredPrintfImpl.FormatOptions, bindingFlags) =
- // printfn %0A is considered to mean 'print width zero'
- match box v with
- | null ->
- Microsoft.FSharp.Text.StructuredPrintfImpl.Display.anyToStringForPrintf opts bindingFlags (v, typeof<'T>)
- | _ ->
- Microsoft.FSharp.Text.StructuredPrintfImpl.Display.anyToStringForPrintf opts bindingFlags (v, v.GetType())
-
- static member GenericToString<'T>(spec: FormatSpecifier) =
+ let vty =
+ match box v with
+ | null -> typeof<'T>
+ | _ -> v.GetType()
+ Microsoft.FSharp.Text.StructuredPrintfImpl.Display.anyToStringForPrintf opts bindingFlags (v, vty)
+
+ static member GenericToString<'T>(spec: FormatSpecifier) : ValueConverter =
let bindingFlags =
if isPlusForPositives spec.Flags then BindingFlags.Public ||| BindingFlags.NonPublic
else BindingFlags.Public
@@ -1079,100 +937,70 @@ module internal PrintfImpl =
else o
if spec.IsPrecisionSpecified then { o with PrintSize = spec.Precision}
else o
+
match spec.IsStarWidth, spec.IsStarPrecision with
| true, true ->
- box (fun (v: 'T) (width: int) (prec: int) ->
+ ValueConverter.Make (fun (vobj: obj) (width: int) (prec: int) ->
+ let v = unbox<'T> vobj
let opts = { opts with PrintSize = prec }
let opts = if not useZeroWidth then { opts with PrintWidth = width} else opts
ObjectPrinter.GenericToStringCore(v, opts, bindingFlags)
)
+
| true, false ->
- box (fun (v: 'T) (width: int) ->
+ ValueConverter.Make (fun (vobj: obj) (width: int) ->
+ let v = unbox<'T> vobj
let opts = if not useZeroWidth then { opts with PrintWidth = width} else opts
- ObjectPrinter.GenericToStringCore(v, opts, bindingFlags)
- )
+ ObjectPrinter.GenericToStringCore(v, opts, bindingFlags))
+
| false, true ->
- box (fun (v: 'T) (prec: int) ->
+ ValueConverter.Make (fun (vobj: obj) (prec: int) ->
+ let v = unbox<'T> vobj
let opts = { opts with PrintSize = prec }
- ObjectPrinter.GenericToStringCore(v, opts, bindingFlags)
- )
- | false, false ->
- box (fun (v: 'T) ->
- ObjectPrinter.GenericToStringCore(v, opts, bindingFlags)
- )
-
- let basicNumberToString (ty: Type) (spec: FormatSpecifier) =
- System.Diagnostics.Debug.Assert(not spec.IsPrecisionSpecified, "not spec.IsPrecisionSpecified")
-
- let ch = spec.TypeChar
-
- match Type.GetTypeCode ty with
- | TypeCode.Int32 -> numberToString ch spec identity (uint32: int -> uint32)
- | TypeCode.Int64 -> numberToString ch spec identity (uint64: int64 -> uint64)
- | TypeCode.Byte -> numberToString ch spec identity (byte: byte -> byte)
- | TypeCode.SByte -> numberToString ch spec identity (byte: sbyte -> byte)
- | TypeCode.Int16 -> numberToString ch spec identity (uint16: int16 -> uint16)
- | TypeCode.UInt16 -> numberToString ch spec identity (uint16: uint16 -> uint16)
- | TypeCode.UInt32 -> numberToString ch spec identity (uint32: uint32 -> uint32)
- | TypeCode.UInt64 -> numberToString ch spec identity (uint64: uint64 -> uint64)
- | _ ->
- if ty === typeof then
- if IntPtr.Size = 4 then
- numberToString ch spec (fun (v: IntPtr) -> v.ToInt32()) uint32
- else
- numberToString ch spec (fun (v: IntPtr) -> v.ToInt64()) uint64
- elif ty === typeof then
- if IntPtr.Size = 4 then
- numberToString ch spec (fun (v: UIntPtr) -> v.ToUInt32()) uint32
- else
- numberToString ch spec (fun (v: UIntPtr) -> v.ToUInt64()) uint64
-
- else raise (ArgumentException(ty.Name + " not a basic integer type"))
+ ObjectPrinter.GenericToStringCore(v, opts, bindingFlags) )
- let basicFloatToString ty spec =
+ | false, false ->
+ ValueConverter.Make (fun (vobj: obj) ->
+ let v = unbox<'T> vobj
+ ObjectPrinter.GenericToStringCore(v, opts, bindingFlags))
+
+ let basicFloatToString spec =
let defaultFormat = getFormatForFloat spec.TypeChar DefaultPrecision
- match Type.GetTypeCode ty with
- | TypeCode.Single -> floatWithPadding spec (getFormatForFloat spec.TypeChar) defaultFormat (fun fmt (v: float32) -> toFormattedString fmt v)
- | TypeCode.Double -> floatWithPadding spec (getFormatForFloat spec.TypeChar) defaultFormat (fun fmt (v: float) -> toFormattedString fmt v)
- | TypeCode.Decimal -> decimalWithPadding spec (getFormatForFloat spec.TypeChar) defaultFormat (fun fmt (v: decimal) -> toFormattedString fmt v)
- | _ -> raise (ArgumentException(ty.Name + " not a basic floating point type"))
+ FloatAndDecimal.withPadding spec (getFormatForFloat spec.TypeChar) defaultFormat
let private NonPublicStatics = BindingFlags.NonPublic ||| BindingFlags.Static
- let private getValueConverter (ty: Type) (spec: FormatSpecifier) : obj =
+ let mi_GenericToString = typeof.GetMethod("GenericToString", NonPublicStatics)
+
+ let private getValueConverter (ty: Type) (spec: FormatSpecifier) : ValueConverter =
match spec.TypeChar with
| 'b' ->
- System.Diagnostics.Debug.Assert(ty === typeof, "ty === typeof")
- basicWithPadding spec boolToString
+ Basic.withPadding spec (unbox >> boolToString)
| 's' ->
- System.Diagnostics.Debug.Assert(ty === typeof, "ty === typeof")
- basicWithPadding spec stringToSafeString
+ Basic.withPadding spec (unbox >> stringToSafeString)
| 'c' ->
- System.Diagnostics.Debug.Assert(ty === typeof, "ty === typeof")
- basicWithPadding spec (fun (c: char) -> c.ToString())
+ Basic.withPadding spec (fun (c: obj) -> (unbox c).ToString())
| 'M' ->
- System.Diagnostics.Debug.Assert(ty === typeof, "ty === typeof")
- decimalWithPadding spec (fun _ -> "G") "G" (fun fmt (v: decimal) -> toFormattedString fmt v) // %M ignores precision
+ FloatAndDecimal.withPadding spec (fun _ -> "G") "G" // %M ignores precision
| 'd' | 'i' | 'x' | 'X' | 'u' | 'o'->
- basicNumberToString ty spec
+ Integer.getValueConverter spec
| 'e' | 'E'
| 'f' | 'F'
| 'g' | 'G' ->
- basicFloatToString ty spec
+ basicFloatToString spec
| 'A' ->
- let mi = typeof.GetMethod("GenericToString", NonPublicStatics)
- let mi = mi.MakeGenericMethod ty
- mi.Invoke(null, [| box spec |])
+ let mi = mi_GenericToString.MakeGenericMethod ty
+ mi.Invoke(null, [| box spec |]) |> unbox
| 'O' ->
- let mi = typeof.GetMethod("ObjectToString", NonPublicStatics)
- let mi = mi.MakeGenericMethod ty
- mi.Invoke(null, [| box spec |])
+ ObjectPrinter.ObjectToString(spec)
+ | 'P' ->
+ ObjectPrinter.InterpolandToString(spec)
| _ ->
raise (ArgumentException(SR.GetString(SR.printfBadFormatSpecifier)))
let extractCurriedArguments (ty: Type) n =
System.Diagnostics.Debug.Assert(n = 1 || n = 2 || n = 3, "n = 1 || n = 2 || n = 3")
- let buf = Array.zeroCreate (n + 1)
+ let buf = Array.zeroCreate n
let rec go (ty: Type) i =
if i < n then
match ty.GetGenericArguments() with
@@ -1182,470 +1010,440 @@ module internal PrintfImpl =
| _ -> failwith (String.Format("Expected function with {0} arguments", n))
else
System.Diagnostics.Debug.Assert((i = n), "i = n")
- buf.[i] <- ty
- buf
+ (buf, ty)
go ty 0
-
- type private PrintfBuilderStack() =
- let args = Stack 10
- let types = Stack 5
-
- let stackToArray size start count (s: Stack<_>) =
- let arr = Array.zeroCreate size
- for i = 0 to count - 1 do
- arr.[start + i] <- s.Pop()
- arr
-
- member __.GetArgumentAndTypesAsArrays
- (
- argsArraySize, argsArrayStartPos, argsArrayTotalCount,
- typesArraySize, typesArrayStartPos, typesArrayTotalCount
- ) =
- let argsArray = stackToArray argsArraySize argsArrayStartPos argsArrayTotalCount args
- let typesArray = stackToArray typesArraySize typesArrayStartPos typesArrayTotalCount types
- argsArray, typesArray
-
- member __.PopContinuationWithType() =
- System.Diagnostics.Debug.Assert(args.Count = 1, "args.Count = 1")
- System.Diagnostics.Debug.Assert(types.Count = 1, "types.Count = 1")
-
- let cont = args.Pop()
- let contTy = types.Pop()
-
- cont, contTy
- member __.PopValueUnsafe() = args.Pop()
- member this.PushContinuationWithType (cont: obj, contTy: Type) =
- System.Diagnostics.Debug.Assert(this.IsEmpty, "this.IsEmpty")
- System.Diagnostics.Debug.Assert(
- (
- let _arg, retTy = Microsoft.FSharp.Reflection.FSharpType.GetFunctionElements(cont.GetType())
- contTy.IsAssignableFrom retTy
- ),
- "incorrect type"
- )
-
- this.PushArgumentWithType(cont, contTy)
+ type LargeStringPrintfEnv<'Result>(continuation, blockSize) =
+ inherit PrintfEnv(())
+ let buf: string[] = Array.zeroCreate blockSize
+ let mutable ptr = 0
- member __.PushArgument(value: obj) =
- args.Push value
+ override _.Finish() : 'Result = continuation (String.Concat buf)
- member __.PushArgumentWithType(value: obj, ty) =
- args.Push value
- types.Push ty
+ override _.Write(s: string) =
+ buf.[ptr] <- s
+ ptr <- ptr + 1
- member __.HasContinuationOnStack expectedNumberOfArguments =
- types.Count = expectedNumberOfArguments + 1
+ override x.WriteT s = x.Write(s)
- member __.IsEmpty =
- System.Diagnostics.Debug.Assert(args.Count = types.Count, "args.Count = types.Count")
- args.Count = 0
+ type SmallStringPrintfEnv2() =
+ inherit PrintfEnv(())
+ let mutable c = null
- /// Parses format string and creates result printer function.
- /// First it recursively consumes format string up to the end, then during unwinding builds printer using PrintfBuilderStack as storage for arguments.
- /// idea of implementation is very simple: every step can either push argument to the stack (if current block of 5 format specifiers is not yet filled)
- // or grab the content of stack, build intermediate printer and push it back to stack (so it can later be consumed by as argument)
- type private PrintfBuilder<'S, 'Re, 'Res>() =
+ override _.Finish() : string = if isNull c then "" else c
+ override _.Write(s: string) = if isNull c then c <- s else c <- c + s
+ override x.WriteT s = x.Write(s)
+
+ type SmallStringPrintfEnv4() =
+ inherit PrintfEnv(())
+ let mutable s1 : string = null
+ let mutable s2 : string = null
+ let mutable s3 : string = null
+ let mutable s4 : string = null
+
+ override _.Finish() : string = String.Concat(s1, s2, s3, s4)
+ override _.Write(s: string) =
+ if isNull s1 then s1 <- s
+ elif isNull s2 then s2 <- s
+ elif isNull s3 then s3 <- s
+ else s4 <- s
+ override x.WriteT s = x.Write(s)
+
+ let StringPrintfEnv blockSize =
+ if blockSize <= 2 then
+ SmallStringPrintfEnv2() :> PrintfEnv<_,_,_>
+ elif blockSize <= 4 then
+ SmallStringPrintfEnv4() :> PrintfEnv<_,_,_>
+ else
+ LargeStringPrintfEnv(id, blockSize) :> PrintfEnv<_,_,_>
+
+ let StringBuilderPrintfEnv<'Result>(k, buf) =
+ { new PrintfEnv(buf) with
+ override _.Finish() : 'Result = k ()
+ override _.Write(s: string) = ignore(buf.Append s)
+ override _.WriteT(()) = () }
+
+ let TextWriterPrintfEnv<'Result>(k, tw: IO.TextWriter) =
+ { new PrintfEnv(tw) with
+ override _.Finish() : 'Result = k()
+ override _.Write(s: string) = tw.Write s
+ override _.WriteT(()) = () }
+
+ let MAX_CAPTURE = 3
+
+ /// Parses format string and creates resulting step list and printer factory function.
+ []
+ type FormatParser<'Printer, 'State, 'Residue, 'Result>(fmt: string) =
- let mutable count = 0
- let mutable optimizedArgCount = 0
-#if DEBUG
- let verifyMethodInfoWasTaken (mi: System.Reflection.MemberInfo) =
- if isNull mi then
- ignore (System.Diagnostics.Debugger.Launch())
-#endif
-
- let buildSpecialChained(spec: FormatSpecifier, argTys: Type[], prefix: string, tail: obj, retTy) =
+ let buildCaptureFunc (spec: FormatSpecifier, allSteps, argTys: Type[], retTy, nextInfo) =
+ let (next:obj, nextCanCombine: bool, nextArgTys: Type[], nextRetTy, nextNextOpt) = nextInfo
+ assert (argTys.Length > 0)
+
+ // See if we can compress a capture to a multi-capture
+ // CaptureN + Final --> CaptureFinalN
+ // Capture1 + Capture1 --> Capture2
+ // Capture1 + Capture2 --> Capture3
+ // Capture2 + Capture1 --> Capture3
+ match argTys.Length, nextArgTys.Length with
+ | _ when spec.TypeChar = 'a' ->
+ // %a has an existential type which must be converted to obj
+ assert (argTys.Length = 2)
+ let captureMethName = "CaptureLittleA"
+ let mi = typeof>.GetMethod(captureMethName, NonPublicStatics)
+ let mi = mi.MakeGenericMethod([| argTys.[1]; retTy |])
+ let factoryObj = mi.Invoke(null, [| next |])
+ factoryObj, false, argTys, retTy, None
+
+ | n1, n2 when nextCanCombine && n1 + n2 <= MAX_CAPTURE ->
+ // 'next' is thrown away on this path and replaced by a combined Capture
+ let captureCount = n1 + n2
+ let combinedArgTys = Array.append argTys nextArgTys
+ match nextNextOpt with
+ | None ->
+ let captureMethName = "CaptureFinal" + string captureCount
+ let mi = typeof>.GetMethod(captureMethName, NonPublicStatics)
+ let mi = mi.MakeGenericMethod(combinedArgTys)
+ let factoryObj = mi.Invoke(null, [| allSteps |])
+ factoryObj, true, combinedArgTys, nextRetTy, None
+ | Some nextNext ->
+ let captureMethName = "Capture" + string captureCount
+ let mi = typeof>.GetMethod(captureMethName, NonPublicStatics)
+ let mi = mi.MakeGenericMethod(Array.append combinedArgTys [| nextRetTy |])
+ let factoryObj = mi.Invoke(null, [| nextNext |])
+ factoryObj, true, combinedArgTys, nextRetTy, nextNextOpt
+
+ | captureCount, _ ->
+ let captureMethName = "Capture" + string captureCount
+ let mi = typeof>.GetMethod(captureMethName, NonPublicStatics)
+ let mi = mi.MakeGenericMethod(Array.append argTys [| retTy |])
+ let factoryObj = mi.Invoke(null, [| next |])
+ factoryObj, true, argTys, retTy, Some next
+
+ let buildStep (spec: FormatSpecifier) (argTys: Type[]) prefix =
if spec.TypeChar = 'a' then
- let mi = typeof>.GetMethod("LittleAChained", NonPublicStatics)
-#if DEBUG
- verifyMethodInfoWasTaken mi
-#endif
-
- let mi = mi.MakeGenericMethod([| argTys.[1]; retTy |])
- let args = [| box prefix; tail |]
- mi.Invoke(null, args)
+ StepLittleA prefix
elif spec.TypeChar = 't' then
- let mi = typeof>.GetMethod("TChained", NonPublicStatics)
-#if DEBUG
- verifyMethodInfoWasTaken mi
-#endif
- let mi = mi.MakeGenericMethod([| retTy |])
- let args = [| box prefix; tail |]
- mi.Invoke(null, args)
- else
- System.Diagnostics.Debug.Assert(spec.IsStarPrecision || spec.IsStarWidth, "spec.IsStarPrecision || spec.IsStarWidth ")
-
- let mi =
- let n = if spec.IsStarWidth = spec.IsStarPrecision then 2 else 1
- let prefix = if spec.TypeChar = '%' then "PercentStarChained" else "StarChained"
- let name = prefix + (string n)
- typeof>.GetMethod(name, NonPublicStatics)
-#if DEBUG
- verifyMethodInfoWasTaken mi
-#endif
- let argTypes, args =
- if spec.TypeChar = '%' then
- [| retTy |], [| box prefix; tail |]
+ StepLittleT prefix
+ elif spec.IsStarPrecision || spec.IsStarWidth then
+ let isTwoStar = (spec.IsStarWidth = spec.IsStarPrecision)
+ match isTwoStar, spec.TypeChar with
+ | false, '%' -> StepPercentStar1 prefix
+ | true, '%' -> StepPercentStar2 prefix
+ | _ ->
+ // For curried interpolated string format processing, the static types of the '%A' arguments
+ // are provided via the argument typed extracted from the curried function. They are known on first phase.
+ let argTy = match argTys with null -> typeof | _ -> argTys.[argTys.Length - 1]
+ let conv = getValueConverter argTy spec
+ if isTwoStar then
+ let convFunc = conv.FuncObj :?> (obj -> int -> int -> string)
+ StepStar2 (prefix, convFunc)
else
- let argTy = argTys.[argTys.Length - 2]
- let conv = getValueConverter argTy spec
- [| argTy; retTy |], [| box prefix; box conv; tail |]
-
- let mi = mi.MakeGenericMethod argTypes
- mi.Invoke(null, args)
-
- let buildSpecialFinal(spec: FormatSpecifier, argTys: Type[], prefix: string, suffix: string) =
- if spec.TypeChar = 'a' then
- let mi = typeof>.GetMethod("LittleAFinal", NonPublicStatics)
-#if DEBUG
- verifyMethodInfoWasTaken mi
-#endif
- let mi = mi.MakeGenericMethod(argTys.[1] : Type)
- let args = [| box prefix; box suffix |]
- mi.Invoke(null, args)
- elif spec.TypeChar = 't' then
- let mi = typeof>.GetMethod("TFinal", NonPublicStatics)
-#if DEBUG
- verifyMethodInfoWasTaken mi
-#endif
- let args = [| box prefix; box suffix |]
- mi.Invoke(null, args)
+ let convFunc = conv.FuncObj :?> (obj -> int -> string)
+ StepStar1 (prefix, convFunc)
else
- System.Diagnostics.Debug.Assert(spec.IsStarPrecision || spec.IsStarWidth, "spec.IsStarPrecision || spec.IsStarWidth ")
-
- let mi =
- let n = if spec.IsStarWidth = spec.IsStarPrecision then 2 else 1
- let prefix = if spec.TypeChar = '%' then "PercentStarFinal" else "StarFinal"
- let name = prefix + (string n)
- typeof>.GetMethod(name, NonPublicStatics)
-#if DEBUG
- verifyMethodInfoWasTaken mi
-#endif
-
- let mi, args =
- if spec.TypeChar = '%' then
- mi, [| box prefix; box suffix |]
- else
- let argTy = argTys.[argTys.Length - 2]
- let mi = mi.MakeGenericMethod argTy
- let conv = getValueConverter argTy spec
- mi, [| box prefix; box conv; box suffix |]
-
- mi.Invoke(null, args)
-
- let buildPlainFinal(args: obj[], argTypes: Type[]) =
- let argsCount = args.Length
- let methodName,args =
- if argsCount > 0 && args.[0].ToString() = "" then
- if argsCount > 1 && args.[argsCount - 1].ToString() = "" then
- let args = Array.sub args 1 (argsCount - 2)
- optimizedArgCount <- optimizedArgCount + 2
- "FinalFast", args
- else
- optimizedArgCount <- optimizedArgCount + 1
- "FinalFastStart", args |> Array.skip 1
- elif argsCount > 0 && args.[argsCount - 1].ToString() = "" then
- let args = Array.sub args 0 (argsCount - 1)
- optimizedArgCount <- optimizedArgCount + 1
- "FinalFastEnd", args
- else
- "Final",args
-
- let mi = typeof>.GetMethod(methodName + argTypes.Length.ToString(), NonPublicStatics)
-#if DEBUG
- verifyMethodInfoWasTaken mi
-#endif
- let mi = mi.MakeGenericMethod argTypes
- mi.Invoke(null, args)
-
- let buildPlainChained(args: obj[], argTypes: Type[]) =
- let argsCount = args.Length
- let methodName,args =
- if argsCount > 0 && args.[0].ToString() = "" then
- optimizedArgCount <- optimizedArgCount + 1
- "ChainedFastStart", args |> Array.skip 1
- else
- "Chained", args
-
- let mi = typeof>.GetMethod(methodName + (argTypes.Length - 1).ToString(), NonPublicStatics)
-#if DEBUG
- verifyMethodInfoWasTaken mi
-#endif
- let mi = mi.MakeGenericMethod argTypes
- mi.Invoke(null, args)
-
- let builderStack = PrintfBuilderStack()
-
- let ContinuationOnStack = -1
-
- let buildPlain numberOfArgs prefix =
- let n = numberOfArgs * 2
- let hasCont = builderStack.HasContinuationOnStack numberOfArgs
-
- let extra = if hasCont then 1 else 0
- let plainArgs, plainTypes =
- builderStack.GetArgumentAndTypesAsArrays(n + 1, 1, n, (numberOfArgs + extra), 0, numberOfArgs)
-
- plainArgs.[0] <- box prefix
-
- if hasCont then
- let cont, contTy = builderStack.PopContinuationWithType()
- plainArgs.[plainArgs.Length - 1] <- cont
- plainTypes.[plainTypes.Length - 1] <- contTy
-
- buildPlainChained(plainArgs, plainTypes)
+ // For interpolated string format processing, the static types of the '%A' arguments
+ // are provided via CaptureTypes and are only known on second phase.
+ match argTys with
+ | null when spec.TypeChar = 'A' ->
+ let convFunc arg argTy =
+ let mi = mi_GenericToString.MakeGenericMethod [| argTy |]
+ let f = mi.Invoke(null, [| box spec |]) :?> ValueConverter
+ let f2 = f.FuncObj :?> (obj -> string)
+ f2 arg
+
+ StepWithTypedArg (prefix, convFunc)
+
+ | _ ->
+ // For curried interpolated string format processing, the static types of the '%A' arguments
+ // are provided via the argument typed extracted from the curried function. They are known on first phase.
+ let argTy = match argTys with null -> typeof | _ -> argTys.[0]
+ let conv = getValueConverter argTy spec
+ let convFunc = conv.FuncObj :?> (obj -> string)
+ StepWithArg (prefix, convFunc)
+
+ let parseSpec (i: byref) =
+ i <- i + 1
+ let flags = FormatString.parseFlags fmt &i
+ let width = FormatString.parseWidth fmt &i
+ let precision = FormatString.parsePrecision fmt &i
+ let typeChar = FormatString.parseTypeChar fmt &i
+ let interpHoleDotnetFormat = FormatString.parseInterpolatedHoleDotNetFormat typeChar fmt &i
+
+ // Skip %P insertion points added after %d{...} etc. in interpolated strings
+ FormatString.skipInterpolationHole typeChar fmt &i
+
+ let spec =
+ { TypeChar = typeChar
+ Precision = precision
+ Flags = flags
+ Width = width
+ InteropHoleDotNetFormat = interpHoleDotnetFormat }
+ spec
+
+ // The steps, populated on-demand. This is for the case where the string is being used
+ // with interpolands captured in the Format object, including the %A capture types.
+ //
+ // We may initialize this twice, but the assignment is atomic and the computation will give functionally
+ // identical results each time, so it is ok.
+ let mutable stepsForCapturedFormat = Unchecked.defaultof<_>
+
+ // The function factory, populated on-demand, for the case where the string is being used to make a curried function for printf.
+ //
+ // We may initialize this twice, but the assignment is atomic and the computation will give functionally
+ // identical results each time, so it is ok.
+ let mutable factory = Unchecked.defaultof>
+ let mutable printer = Unchecked.defaultof<'Printer>
+
+ // The function factory, populated on-demand.
+ //
+ // We may initialize this twice, but the assignment is atomic and the computation will give functionally
+ // identical results each time, so it is ok.
+ let mutable stringCount = 0
+
+ // A simplified parser. For the case where the string is being used with interpolands captured in the Format object.
+ let rec parseAndCreateStepsForCapturedFormatAux steps (prefix: string) (i: byref) =
+ if i >= fmt.Length then
+ let step = StepString(prefix)
+ let allSteps = revToArray 1 steps
+ allSteps.[allSteps.Length-1] <- step
+ stringCount <- Step.BlockCount allSteps
+ stepsForCapturedFormat <- allSteps
else
- buildPlainFinal(plainArgs, plainTypes)
-
- let rec parseFromFormatSpecifier (prefix: string) (s: string) (funcTy: Type) i: int =
+ let spec = parseSpec &i
+ let suffix = FormatString.findNextFormatSpecifier fmt &i
+ let step = buildStep spec null prefix
+ parseAndCreateStepsForCapturedFormatAux (step::steps) suffix &i
+
+ let parseAndCreateStepsForCapturedFormat () =
+ let mutable i = 0
+ let prefix = FormatString.findNextFormatSpecifier fmt &i
+ parseAndCreateStepsForCapturedFormatAux [] prefix &i
+
+ /// The more advanced parser which both builds the steps (with %A types extracted from the funcTy),
+ /// and produces a curried function value of the right type guided by funcTy
+ let rec parseAndCreateFuncFactoryAux steps (prefix: string) (funcTy: Type) (i: byref) =
- if i >= s.Length then 0
+ if i >= fmt.Length then
+ let step = StepString(prefix)
+ let allSteps = revToArray 1 steps
+ allSteps.[allSteps.Length-1] <- step
+ let last = Specializations<'State, 'Residue, 'Result>.Final0(allSteps)
+ stringCount <- Step.BlockCount allSteps
+ let nextInfo = (box last, true, [| |], funcTy, None)
+ (allSteps, nextInfo)
else
+ assert (fmt.[i] = '%')
+ let spec = parseSpec &i
+ let suffix = FormatString.findNextFormatSpecifier fmt &i
+ let n = spec.ArgCount
+ let (argTys, retTy) = extractCurriedArguments funcTy n
+ let step = buildStep spec argTys prefix
+ let (allSteps, nextInfo) = parseAndCreateFuncFactoryAux (step::steps) suffix retTy &i
+ let nextInfoNew = buildCaptureFunc (spec, allSteps, argTys, retTy, nextInfo)
+ (allSteps, nextInfoNew)
+
+ let parseAndCreateFunctionFactory () =
+ let funcTy = typeof<'Printer>
+
+ // Find the first format specifier
+ let mutable i = 0
+ let prefix = FormatString.findNextFormatSpecifier fmt &i
- System.Diagnostics.Debug.Assert(s.[i] = '%', "s.[i] = '%'")
- count <- count + 1
-
- let flags, i = FormatString.parseFlags s (i + 1)
- let width, i = FormatString.parseWidth s i
- let precision, i = FormatString.parsePrecision s i
- let typeChar, i = FormatString.parseTypeChar s i
- let spec = { TypeChar = typeChar; Precision = precision; Flags = flags; Width = width}
+ let (allSteps, (factoryObj, _, combinedArgTys, _, _)) = parseAndCreateFuncFactoryAux [] prefix funcTy &i
- let next, suffix = FormatString.findNextFormatSpecifier s i
-
- let argTys =
- let n =
- if spec.TypeChar = 'a' then 2
- elif spec.IsStarWidth || spec.IsStarPrecision then
- if spec.IsStarWidth = spec.IsStarPrecision then 3
- else 2
- else 1
-
- let n = if spec.TypeChar = '%' then n - 1 else n
-
- System.Diagnostics.Debug.Assert(n <> 0, "n <> 0")
-
- extractCurriedArguments funcTy n
-
- let retTy = argTys.[argTys.Length - 1]
-
- let numberOfArgs = parseFromFormatSpecifier suffix s retTy next
-
- if spec.TypeChar = 'a' || spec.TypeChar = 't' || spec.IsStarWidth || spec.IsStarPrecision then
- if numberOfArgs = ContinuationOnStack then
-
- let cont, contTy = builderStack.PopContinuationWithType()
- let currentCont = buildSpecialChained(spec, argTys, prefix, cont, contTy)
- builderStack.PushContinuationWithType(currentCont, funcTy)
-
- ContinuationOnStack
- else
- if numberOfArgs = 0 then
- System.Diagnostics.Debug.Assert(builderStack.IsEmpty, "builderStack.IsEmpty")
-
- let currentCont = buildSpecialFinal(spec, argTys, prefix, suffix)
- builderStack.PushContinuationWithType(currentCont, funcTy)
- ContinuationOnStack
- else
- let hasCont = builderStack.HasContinuationOnStack numberOfArgs
-
- let expectedNumberOfItemsOnStack = numberOfArgs * 2
- let sizeOfTypesArray =
- if hasCont then numberOfArgs + 1
- else numberOfArgs
-
- let plainArgs, plainTypes =
- builderStack.GetArgumentAndTypesAsArrays(expectedNumberOfItemsOnStack + 1, 1, expectedNumberOfItemsOnStack, sizeOfTypesArray, 0, numberOfArgs )
-
- plainArgs.[0] <- box suffix
-
- let next =
- if hasCont then
- let nextCont, nextContTy = builderStack.PopContinuationWithType()
- plainArgs.[plainArgs.Length - 1] <- nextCont
- plainTypes.[plainTypes.Length - 1] <- nextContTy
- buildPlainChained(plainArgs, plainTypes)
- else
- buildPlainFinal(plainArgs, plainTypes)
-
- let next = buildSpecialChained(spec, argTys, prefix, next, retTy)
- builderStack.PushContinuationWithType(next, funcTy)
-
- ContinuationOnStack
- else
- if numberOfArgs = ContinuationOnStack then
- let idx = argTys.Length - 2
- builderStack.PushArgument suffix
- builderStack.PushArgumentWithType((getValueConverter argTys.[idx] spec), argTys.[idx])
- 1
- else
- builderStack.PushArgument suffix
- builderStack.PushArgumentWithType((getValueConverter argTys.[0] spec), argTys.[0])
-
- if numberOfArgs = MaxArgumentsInSpecialization - 1 then
- let cont = buildPlain (numberOfArgs + 1) prefix
- builderStack.PushContinuationWithType(cont, funcTy)
- ContinuationOnStack
- else
- numberOfArgs + 1
-
- let parseFormatString (s: string) (funcTy: System.Type) : obj =
- optimizedArgCount <- 0
- let prefixPos, prefix = FormatString.findNextFormatSpecifier s 0
- if prefixPos = s.Length then
- box (fun (env: unit -> PrintfEnv<'S, 'Re, 'Res>) ->
- let env = env()
- env.Write prefix
+ // If there are no format specifiers then take a simple path
+ match allSteps with
+ | [| StepString prefix |] ->
+ PrintfFuncFactory<_, 'State, 'Residue, 'Result>(fun _args initial ->
+ let env = initial()
+ env.WriteSkipEmpty prefix
env.Finish()
- )
- else
- let n = parseFromFormatSpecifier prefix s funcTy prefixPos
-
- if n = ContinuationOnStack || n = 0 then
- builderStack.PopValueUnsafe()
- else
- buildPlain n prefix
-
- member __.Build<'T>(s: string) : PrintfFactory<'S, 'Re, 'Res, 'T> * int =
- parseFormatString s typeof<'T> :?> _, (2 * count + 1) - optimizedArgCount // second component is used in SprintfEnv as value for internal buffer
-
- /// Type of element that is stored in cache
- /// Pair: factory for the printer + number of text blocks that printer will produce (used to preallocate buffers)
- type CachedItem<'T, 'State, 'Residue, 'Result> = PrintfFactory<'State, 'Residue, 'Result, 'T> * int
-
- /// 2-level cache.
- /// 1st-level stores last value that was consumed by the current thread in thread-static field thus providing shortcuts for scenarios when
- /// printf is called in tight loop
- /// 2nd level is global dictionary that maps format string to the corresponding PrintfFactory
- type Cache<'T, 'State, 'Residue, 'Result>() =
- static let generate fmt = PrintfBuilder<'State, 'Residue, 'Result>().Build<'T>(fmt)
- static let mutable map = System.Collections.Concurrent.ConcurrentDictionary>()
- static let getOrAddFunc = Func<_, _>(generate)
- static let get (key: string) = map.GetOrAdd(key, getOrAddFunc)
-
- []
- []
- static val mutable private last: string * CachedItem<'T, 'State, 'Residue, 'Result>
+ ) |> box
+
+ // If there is one simple format specifier then we can create an even better factory function
+ | [| StepWithArg (prefix1, conv1); StepString prefix2 |] ->
+ let captureMethName = "OneStepWithArg"
+ let mi = typeof>.GetMethod(captureMethName, NonPublicStatics)
+ let mi = mi.MakeGenericMethod(combinedArgTys)
+ let factoryObj = mi.Invoke(null, [| box prefix1; box conv1; box prefix2 |])
+ factoryObj
+
+ // If there are two simple format specifiers then we can create an even better factory function
+ | [| StepWithArg (prefix1, conv1); StepWithArg (prefix2, conv2); StepString prefix3 |] ->
+ let captureMethName = "TwoStepWithArg"
+ let mi = typeof>.GetMethod(captureMethName, NonPublicStatics)
+ let mi = mi.MakeGenericMethod(combinedArgTys)
+ let factoryObj = mi.Invoke(null, [| box prefix1; box conv1; box prefix2; box conv2; box prefix3 |])
+ factoryObj
+
+ | _ ->
+ factoryObj
+
+ /// The format string, used to help identify the cache entry (the cache index types are taken
+ /// into account as well).
+ member _.FormatString = fmt
+
+ /// The steps involved in executing the format string when interpolands are captured
+ ///
+ /// If %A patterns are involved these steps are only accurate when the %A capture types
+ /// are given in the format string through interpolation capture.
+ member _.GetStepsForCapturedFormat() =
+ match stepsForCapturedFormat with
+ | null -> parseAndCreateStepsForCapturedFormat ()
+ | _ -> ()
+ stepsForCapturedFormat
+
+ /// The number of strings produced for a sprintf
+ member _.BlockCount = stringCount
+
+ /// The factory function used to generate the result or the resulting function.
+ member _.GetCurriedPrinterFactory() =
+ match box factory with
+ | null ->
+ let factoryObj = parseAndCreateFunctionFactory ()
+ let p = (factoryObj :?> PrintfFuncFactory<'Printer, 'State, 'Residue, 'Result>)
+ // We may initialize this twice, but the assignment is atomic and the computation will give functionally
+ // identical results each time it is ok
+ factory <- p
+ p
+ | _ -> factory
+
+ /// This avoids reallocation and application of 'initial' for sprintf printers
+ member this.GetCurriedStringPrinter() =
+ match box printer with
+ | null ->
+ let f = this.GetCurriedPrinterFactory()
+ let initial() = (StringPrintfEnv stringCount |> box :?> PrintfEnv<'State, 'Residue, 'Result>)
+ let p = f.Invoke([], initial)
+ // We may initialize this twice, but the assignment is atomic and the computation will give functionally
+ // identical results each time it is ok
+ printer <- p
+ p
+ | _ -> printer
+
+
+ /// 2-level cache, keyed by format string and index types
+ type Cache<'Printer, 'State, 'Residue, 'Result>() =
+
+ /// 1st level cache (type-indexed). Stores last value that was consumed by the current thread in
+ /// thread-static field thus providing shortcuts for scenarios when printf is called in tight loop.
+ []
+ static val mutable private mostRecent: FormatParser<'Printer, 'State, 'Residue, 'Result>
- static member Get(key: Format<'T, 'State, 'Residue, 'Result>) =
- if not (Cache<'T, 'State, 'Residue, 'Result>.last === null)
- && key.Value.Equals (fst Cache<'T, 'State, 'Residue, 'Result>.last) then
- snd Cache<'T, 'State, 'Residue, 'Result>.last
+ // 2nd level cache (type-indexed). Dictionary that maps format string to the corresponding cache entry
+ static let mutable dict : ConcurrentDictionary> = null
+
+ static member GetParser(format: Format<'Printer, 'State, 'Residue, 'Result>) =
+ let recent = Cache<'Printer, 'State, 'Residue, 'Result>.mostRecent
+ let fmt = format.Value
+ if isNull recent then
+ let parser = FormatParser(fmt)
+ Cache<'Printer, 'State, 'Residue, 'Result>.mostRecent <- parser
+ parser
+ elif fmt.Equals recent.FormatString then
+ recent
else
- let v = get key.Value
- Cache<'T, 'State, 'Residue, 'Result>.last <- (key.Value, v)
- v
-
- type StringPrintfEnv<'Result>(k, n) =
- inherit PrintfEnv(())
-
- let buf: string[] = Array.zeroCreate n
- let mutable ptr = 0
-
- override __.Finish() : 'Result = k (String.Concat buf)
- override __.Write(s: string) =
- buf.[ptr] <- s
- ptr <- ptr + 1
- override __.WriteT s =
- buf.[ptr] <- s
- ptr <- ptr + 1
-
- type SmallStringPrintfEnv<'Result>(k) =
- inherit PrintfEnv(())
-
- let mutable c = null
-
- override __.Finish() : 'Result = k c
- override __.Write(s: string) = if isNull c then c <- s else c <- c + s
- override __.WriteT s = if isNull c then c <- s else c <- c + s
-
- type StringBuilderPrintfEnv<'Result>(k, buf) =
- inherit PrintfEnv(buf)
- override __.Finish() : 'Result = k ()
- override __.Write(s: string) = ignore(buf.Append s)
- override __.WriteT(()) = ()
-
- type TextWriterPrintfEnv<'Result>(k, tw: IO.TextWriter) =
- inherit PrintfEnv(tw)
- override __.Finish() : 'Result = k()
- override __.Write(s: string) = tw.Write s
- override __.WriteT(()) = ()
-
- let inline doPrintf fmt f =
- let formatter, n = Cache<_, _, _, _>.Get fmt
- let env() = f n
- formatter env
+ // Initialize the 2nd level cache if necessary. Note there's a race condition but it doesn't
+ // matter if we initialize these values twice (and lose one entry)
+ if isNull dict then
+ dict <- ConcurrentDictionary<_,_>()
+
+ let parser =
+ match dict.TryGetValue(fmt) with
+ | true, res -> res
+ | _ ->
+ let parser = FormatParser(fmt)
+ // There's a race condition - but the computation is functional and it doesn't matter if we do it twice
+ dict.TryAdd(fmt, parser) |> ignore
+ parser
+ Cache<'Printer, 'State, 'Residue, 'Result>.mostRecent <- parser
+ parser
[]
module Printf =
- open System
- open System.IO
- open System.Text
- open PrintfImpl
-
- type BuilderFormat<'T,'Result> = Format<'T, StringBuilder, unit, 'Result>
- type StringFormat<'T,'Result> = Format<'T, unit, string, 'Result>
- type TextWriterFormat<'T,'Result> = Format<'T, TextWriter, unit, 'Result>
- type BuilderFormat<'T> = BuilderFormat<'T,unit>
- type StringFormat<'T> = StringFormat<'T,string>
+ type BuilderFormat<'T, 'Result> = Format<'T, StringBuilder, unit, 'Result>
+ type StringFormat<'T, 'Result> = Format<'T, unit, string, 'Result>
+ type TextWriterFormat<'T, 'Result> = Format<'T, TextWriter, unit, 'Result>
+ type BuilderFormat<'T> = BuilderFormat<'T,unit>
+ type StringFormat<'T> = StringFormat<'T,string>
type TextWriterFormat<'T> = TextWriterFormat<'T,unit>
+ let gprintf envf (format: Format<'Printer, 'State, 'Residue, 'Result>) =
+ let cacheItem = Cache.GetParser format
+ match format.Captures with
+ | null ->
+ // The ksprintf "...%d ...." arg path, producing a function
+ let factory = cacheItem.GetCurriedPrinterFactory()
+ let initial() = (envf cacheItem.BlockCount :> PrintfEnv<_,_,_>)
+ factory.Invoke([], initial)
+ | captures ->
+ // The ksprintf $"...%d{3}...." path, running the steps straight away to produce a string
+ let steps = cacheItem.GetStepsForCapturedFormat()
+ let env = envf cacheItem.BlockCount :> PrintfEnv<_,_,_>
+ let res = env.RunSteps(captures, format.CaptureTypes, steps)
+ unbox res // prove 'T = 'Result
+ //continuation res
+
[]
let ksprintf continuation (format: StringFormat<'T, 'Result>) : 'T =
- doPrintf format (fun n ->
- if n <= 2 then
- SmallStringPrintfEnv continuation :> PrintfEnv<_, _, _>
- else
- StringPrintfEnv(continuation, n) :> PrintfEnv<_, _, _>
- )
+ gprintf (fun stringCount -> LargeStringPrintfEnv(continuation, stringCount)) format
[]
let sprintf (format: StringFormat<'T>) =
- doPrintf format (fun n ->
- if n <= 2 then
- SmallStringPrintfEnv id :> PrintfEnv<_, _, _>
- else
- StringPrintfEnv(id, n) :> PrintfEnv<_, _, _>
- )
+ // We inline gprintf by hand here to be sure to remove a few allocations
+ let cacheItem = Cache.GetParser format
+ match format.Captures with
+ | null ->
+ // The sprintf "...%d ...." arg path, producing a function
+ cacheItem.GetCurriedStringPrinter()
+ | captures ->
+ // The sprintf $"...%d{3}...." path, running the steps straight away to produce a string
+ let steps = cacheItem.GetStepsForCapturedFormat()
+ let env = StringPrintfEnv cacheItem.BlockCount
+ let res = env.RunSteps(captures, format.CaptureTypes, steps)
+ unbox res // proves 'T = string
[]
let kprintf continuation format = ksprintf continuation format
[]
- let kbprintf continuation (builder: StringBuilder) format =
- doPrintf format (fun _ ->
- StringBuilderPrintfEnv(continuation, builder) :> PrintfEnv<_, _, _>
- )
+ let kbprintf continuation (builder: StringBuilder) (format: BuilderFormat<'T, 'Result>) : 'T =
+ gprintf (fun _stringCount -> StringBuilderPrintfEnv(continuation, builder)) format
[]
- let kfprintf continuation textWriter format =
- doPrintf format (fun _ ->
- TextWriterPrintfEnv(continuation, textWriter) :> PrintfEnv<_, _, _>
- )
+ let kfprintf continuation textWriter (format: TextWriterFormat<'T, 'Result>) =
+ gprintf (fun _stringCount -> TextWriterPrintfEnv(continuation, textWriter)) format
[]
- let bprintf builder format = kbprintf ignore builder format
+ let bprintf builder format =
+ kbprintf ignore builder format
[]
- let fprintf (textWriter: TextWriter) format = kfprintf ignore textWriter format
+ let fprintf (textWriter: TextWriter) format =
+ kfprintf ignore textWriter format
[]
- let fprintfn (textWriter: TextWriter) format = kfprintf (fun _ -> textWriter.WriteLine()) textWriter format
+ let fprintfn (textWriter: TextWriter) format =
+ kfprintf (fun _ -> textWriter.WriteLine()) textWriter format
[]
- let failwithf format = ksprintf failwith format
+ let failwithf format =
+ ksprintf failwith format
[]
- let printf format = fprintf Console.Out format
+ let printf format =
+ fprintf Console.Out format
[]
- let eprintf format = fprintf Console.Error format
+ let eprintf format =
+ fprintf Console.Error format
[]
- let printfn format = fprintfn Console.Out format
+ let printfn format =
+ fprintfn Console.Out format
[]
- let eprintfn format = fprintfn Console.Error format
+ let eprintfn format =
+ fprintfn Console.Error format
diff --git a/src/fsharp/FSharp.Core/printf.fsi b/src/fsharp/FSharp.Core/printf.fsi
index 37e98e99d27..877b4b8c346 100644
--- a/src/fsharp/FSharp.Core/printf.fsi
+++ b/src/fsharp/FSharp.Core/printf.fsi
@@ -22,8 +22,22 @@ type PrintfFormat<'Printer,'State,'Residue,'Result> =
/// The PrintfFormat containing the formatted result.
new : value:string -> PrintfFormat<'Printer,'State,'Residue,'Result>
+ /// Construct a format string
+ /// The input string.
+ /// The captured expressions in an interpolated string.
+ /// The types of expressions for %A holes in interpolated string.
+ /// The PrintfFormat containing the formatted result.
+ []
+ new : value:string * captures: obj[] * captureTys: Type[] -> PrintfFormat<'Printer,'State,'Residue,'Result>
+
/// The raw text of the format string.
member Value : string
+
+ []
+ member Captures: obj[]
+
+ []
+ member CaptureTypes: System.Type[]
/// Type of a formatting expression.
/// Function type generated by printf.
@@ -42,6 +56,14 @@ type PrintfFormat<'Printer,'State,'Residue,'Result,'Tuple> =
/// The created format string.
new: value:string -> PrintfFormat<'Printer,'State,'Residue,'Result,'Tuple>
+ /// Construct a format string
+ /// The input string.
+ /// The captured expressions in an interpolated string.
+ /// The types of expressions for %A holes in interpolated string.
+ /// The created format string.
+ []
+ new: value:string * captures: obj[] * captureTys: Type[] -> PrintfFormat<'Printer,'State,'Residue,'Result,'Tuple>
+
/// Type of a formatting expression.
/// Function type generated by printf.
/// Type argument passed to %a formatters
@@ -66,11 +88,11 @@ module Printf =
/// Represents a statically-analyzed format associated with writing to a . The first type parameter indicates the
/// arguments of the format operation and the last the overall return type.
- type BuilderFormat<'T,'Result> = Format<'T, StringBuilder, unit, 'Result>
+ type BuilderFormat<'T,'Result> = Format<'T, StringBuilder, unit, 'Result>
/// Represents a statically-analyzed format when formatting builds a string. The first type parameter indicates the
/// arguments of the format operation and the last the overall return type.
- type StringFormat<'T,'Result> = Format<'T, unit, string, 'Result>
+ type StringFormat<'T,'Result> = Format<'T, unit, string, 'Result>
/// Represents a statically-analyzed format associated with writing to a . The first type parameter indicates the
/// arguments of the format operation and the last the overall return type.
@@ -78,15 +100,15 @@ module Printf =
/// Represents a statically-analyzed format associated with writing to a . The type parameter indicates the
/// arguments and return type of the format operation.
- type BuilderFormat<'T> = BuilderFormat<'T,unit>
+ type BuilderFormat<'T> = BuilderFormat<'T, unit>
/// Represents a statically-analyzed format when formatting builds a string. The type parameter indicates the
/// arguments and return type of the format operation.
- type StringFormat<'T> = StringFormat<'T,string>
+ type StringFormat<'T> = StringFormat<'T,string>
/// Represents a statically-analyzed format associated with writing to a . The type parameter indicates the
/// arguments and return type of the format operation.
- type TextWriterFormat<'T> = TextWriterFormat<'T,unit>
+ type TextWriterFormat<'T> = TextWriterFormat<'T,unit>
/// Print to a
///
@@ -95,7 +117,7 @@ module Printf =
///
/// The return type and arguments of the formatter.
[]
- val bprintf : builder:StringBuilder -> format:BuilderFormat<'T> -> 'T
+ val bprintf: builder:StringBuilder -> format:BuilderFormat<'T> -> 'T
/// Print to a text writer.
///
@@ -104,7 +126,7 @@ module Printf =
///
/// The return type and arguments of the formatter.
[]
- val fprintf : textWriter:TextWriter -> format:TextWriterFormat<'T> -> 'T
+ val fprintf: textWriter:TextWriter -> format:TextWriterFormat<'T> -> 'T
/// Print to a text writer, adding a newline
///
@@ -113,7 +135,7 @@ module Printf =
///
/// The return type and arguments of the formatter.
[]
- val fprintfn : textWriter:TextWriter -> format:TextWriterFormat<'T> -> 'T
+ val fprintfn: textWriter:TextWriter -> format:TextWriterFormat<'T> -> 'T
/// Formatted printing to stderr
///
@@ -121,7 +143,7 @@ module Printf =
///
/// The return type and arguments of the formatter.
[]
- val eprintf : format:TextWriterFormat<'T> -> 'T
+ val eprintf: format:TextWriterFormat<'T> -> 'T
/// Formatted printing to stderr, adding a newline
///
@@ -129,7 +151,7 @@ module Printf =
///
/// The return type and arguments of the formatter.
[]
- val eprintfn : format:TextWriterFormat<'T> -> 'T
+ val eprintfn: format:TextWriterFormat<'T> -> 'T
/// Formatted printing to stdout
///
@@ -137,7 +159,7 @@ module Printf =
///
/// The return type and arguments of the formatter.
[]
- val printf : format:TextWriterFormat<'T> -> 'T
+ val printf: format:TextWriterFormat<'T> -> 'T
/// Formatted printing to stdout, adding a newline.
///
@@ -145,7 +167,7 @@ module Printf =
///
/// The return type and arguments of the formatter.
[]
- val printfn : format:TextWriterFormat<'T> -> 'T
+ val printfn: format:TextWriterFormat<'T> -> 'T
/// Print to a string via an internal string buffer and return
/// the result as a string. Helper printers must return strings.
@@ -154,7 +176,7 @@ module Printf =
///
/// The formatted string.
[]
- val sprintf : format:StringFormat<'T> -> 'T
+ val sprintf: format:StringFormat<'T> -> 'T
/// bprintf, but call the given 'final' function to generate the result.
/// See kprintf.
@@ -165,7 +187,7 @@ module Printf =
///
/// The arguments of the formatter.
[]
- val kbprintf : continuation:(unit -> 'Result) -> builder:StringBuilder -> format:BuilderFormat<'T,'Result> -> 'T
+ val kbprintf: continuation:(unit -> 'Result) -> builder:StringBuilder -> format:BuilderFormat<'T,'Result> -> 'T
/// fprintf, but call the given 'final' function to generate the result.
/// See kprintf.
@@ -176,7 +198,7 @@ module Printf =
///
/// The arguments of the formatter.
[]
- val kfprintf : continuation:(unit -> 'Result) -> textWriter:TextWriter -> format:TextWriterFormat<'T,'Result> -> 'T
+ val kfprintf: continuation:(unit -> 'Result) -> textWriter:TextWriter -> format:TextWriterFormat<'T,'Result> -> 'T
/// printf, but call the given 'final' function to generate the result.
/// For example, these let the printing force a flush after all output has
@@ -187,7 +209,7 @@ module Printf =
///
/// The arguments of the formatter.
[]
- val kprintf : continuation:(string -> 'Result) -> format:StringFormat<'T,'Result> -> 'T
+ val kprintf: continuation:(string -> 'Result) -> format:StringFormat<'T,'Result> -> 'T
/// sprintf, but call the given 'final' function to generate the result.
/// See kprintf.
@@ -197,7 +219,7 @@ module Printf =
///
/// The arguments of the formatter.
[]
- val ksprintf : continuation:(string -> 'Result) -> format:StringFormat<'T,'Result> -> 'T
+ val ksprintf: continuation:(string -> 'Result) -> format:StringFormat<'T,'Result> -> 'T
/// Print to a string buffer and raise an exception with the given
/// result. Helper printers must return strings.
diff --git a/src/fsharp/LanguageFeatures.fs b/src/fsharp/LanguageFeatures.fs
index ad0d8c0185b..8c8330ea4d1 100644
--- a/src/fsharp/LanguageFeatures.fs
+++ b/src/fsharp/LanguageFeatures.fs
@@ -33,6 +33,7 @@ type LanguageFeature =
| DefaultInterfaceMemberConsumption
| WitnessPassing
| InterfacesWithMultipleGenericInstantiation
+ | StringInterpolation
/// LanguageVersion management
type LanguageVersion (specifiedVersionAsString) =
@@ -71,6 +72,7 @@ type LanguageVersion (specifiedVersionAsString) =
LanguageFeature.WitnessPassing, previewVersion
LanguageFeature.InterfacesWithMultipleGenericInstantiation, previewVersion
LanguageFeature.NameOf, previewVersion
+ LanguageFeature.StringInterpolation, previewVersion
]
let specified =
@@ -141,6 +143,7 @@ type LanguageVersion (specifiedVersionAsString) =
| LanguageFeature.DefaultInterfaceMemberConsumption -> FSComp.SR.featureDefaultInterfaceMemberConsumption()
| LanguageFeature.WitnessPassing -> FSComp.SR.featureWitnessPassing()
| LanguageFeature.InterfacesWithMultipleGenericInstantiation -> FSComp.SR.featureInterfacesWithMultipleGenericInstantiation()
+ | LanguageFeature.StringInterpolation -> FSComp.SR.featureStringInterpolation()
/// Get a version string associated with the given feature.
member _.GetFeatureVersionString feature =
diff --git a/src/fsharp/LanguageFeatures.fsi b/src/fsharp/LanguageFeatures.fsi
index e616a3a9c3e..95ad370a5e7 100644
--- a/src/fsharp/LanguageFeatures.fsi
+++ b/src/fsharp/LanguageFeatures.fsi
@@ -21,6 +21,7 @@ type LanguageFeature =
| DefaultInterfaceMemberConsumption
| WitnessPassing
| InterfacesWithMultipleGenericInstantiation
+ | StringInterpolation
/// LanguageVersion management
type LanguageVersion =
diff --git a/src/fsharp/LexFilter.fs b/src/fsharp/LexFilter.fs
index 1f2d9b70178..956b351e9dc 100644
--- a/src/fsharp/LexFilter.fs
+++ b/src/fsharp/LexFilter.fs
@@ -86,7 +86,7 @@ type Context =
| CtxtDo _ -> "do"
| CtxtInterfaceHead _ -> "interface-decl"
| CtxtTypeDefns _ -> "type"
- | CtxtParen _ -> "paren"
+ | CtxtParen(_, p) -> sprintf "paren(%s)" (stringOfPos p)
| CtxtMemberHead _ -> "member-head"
| CtxtMemberBody _ -> "body"
| CtxtSeqBlock (b, p, _addBlockEnd) -> sprintf "seqblock(%s, %s)" (match b with FirstInSeqBlock -> "first" | NotFirstInSeqBlock -> "subsequent") (stringOfPos p)
@@ -271,7 +271,7 @@ let rec isTypeContinuator token =
// end with <--- 'end' HERE
// static member M() = 1
// end
- | RBRACE | WITH | BAR | AND | END -> true
+ | RBRACE _ | WITH | BAR | AND | END -> true
// The following arise during reprocessing of the inserted tokens when we hit a DONE
| ORIGHT_BLOCK_END | OBLOCKEND | ODECLEND -> true
@@ -340,7 +340,7 @@ let rec isSeqBlockElementContinuator token =
// ...
// ), <------- NOTE RPAREN HERE
// Shortcut.CtrlO)
- | END | AND | WITH | THEN | RPAREN | RBRACE | BAR_RBRACE | RBRACK | BAR_RBRACK | RQUOTE _ -> true
+ | END | AND | WITH | THEN | RPAREN | RBRACE _ | BAR_RBRACE | RBRACK | BAR_RBRACK | RQUOTE _ -> true
// The following arise during reprocessing of the inserted tokens when we hit a DONE
| ORIGHT_BLOCK_END | OBLOCKEND | ODECLEND -> true
@@ -368,7 +368,7 @@ let isAtomicExprEndToken token =
| UINT8 _ | UINT16 _ | UINT32 _ | UINT64 _ | UNATIVEINT _
| DECIMAL _ | BIGNUM _ | STRING _ | BYTEARRAY _ | CHAR _
| IEEE32 _ | IEEE64 _
- | RPAREN | RBRACK | RBRACE | BAR_RBRACE | BAR_RBRACK | END
+ | RPAREN | RBRACK | RBRACE _ | BAR_RBRACE | BAR_RBRACK | END
| NULL | FALSE | TRUE | UNDERSCORE -> true
| _ -> false
@@ -378,13 +378,17 @@ let isAtomicExprEndToken token =
let parenTokensBalance t1 t2 =
match t1, t2 with
| (LPAREN, RPAREN)
- | (LBRACE, RBRACE)
+ | (LBRACE _, RBRACE _)
| (LBRACE_BAR, BAR_RBRACE)
| (LBRACK, RBRACK)
| (INTERFACE, END)
| (CLASS, END)
| (SIG, END)
| (STRUCT, END)
+ | (INTERP_STRING_BEGIN_PART _, INTERP_STRING_END _)
+ | (INTERP_STRING_BEGIN_PART _, INTERP_STRING_PART _)
+ | (INTERP_STRING_PART _, INTERP_STRING_PART _)
+ | (INTERP_STRING_PART _, INTERP_STRING_END _)
| (LBRACK_BAR, BAR_RBRACK)
| (LESS true, GREATER true)
| (BEGIN, END) -> true
@@ -524,7 +528,7 @@ type PositionWithColumn =
//----------------------------------------------------------------------------
// build a LexFilter
//--------------------------------------------------------------------------*)
-type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, lexbuf: UnicodeLexing.Lexbuf) =
+type LexFilterImpl (lightStatus: LightSyntaxStatus, compilingFsLib, lexer, lexbuf: UnicodeLexing.Lexbuf) =
//----------------------------------------------------------------------------
// Part I. Building a new lex stream from an old
@@ -651,7 +655,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer,
let detectJoinInCtxt stack =
let rec check s =
match s with
- | CtxtParen(LBRACE, _) :: _ -> true
+ | CtxtParen(LBRACE _, _) :: _ -> true
| (CtxtSeqBlock _ | CtxtDo _ | CtxtFor _) :: rest -> check rest
| _ -> false
match stack with
@@ -707,9 +711,9 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer,
// 'f ...{' places no limit until we hit a CtxtLetDecl etc...
// 'f ...[' places no limit until we hit a CtxtLetDecl etc...
// 'f ...[|' places no limit until we hit a CtxtLetDecl etc...
- | _, (CtxtParen ((LBRACE | LBRACK | LBRACK_BAR), _) :: CtxtSeqBlock _ :: rest)
- | _, (CtxtParen ((LBRACE | LBRACK | LBRACK_BAR), _) :: CtxtVanilla _ :: CtxtSeqBlock _ :: rest)
- | _, (CtxtSeqBlock _ :: CtxtParen((LBRACE | LBRACK | LBRACK_BAR), _) :: CtxtVanilla _ :: CtxtSeqBlock _ :: rest)
+ | _, (CtxtParen ((LBRACE _ | LBRACK | LBRACK_BAR), _) :: CtxtSeqBlock _ :: rest)
+ | _, (CtxtParen ((LBRACE _ | LBRACK | LBRACK_BAR), _) :: CtxtVanilla _ :: CtxtSeqBlock _ :: rest)
+ | _, (CtxtSeqBlock _ :: CtxtParen((LBRACE _ | LBRACK | LBRACK_BAR), _) :: CtxtVanilla _ :: CtxtSeqBlock _ :: rest)
-> undentationLimit false rest
// MAJOR PERMITTED UNDENTATION This is allowing:
@@ -787,8 +791,8 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer,
// 'if ... else [' limited by 'if'
// 'if ... else [|' limited by 'if'
| _, (CtxtParen ((SIG | STRUCT | BEGIN), _) :: CtxtSeqBlock _ :: (CtxtModuleBody (_, false) as limitCtxt) :: _)
- | _, (CtxtParen ((BEGIN | LPAREN | LBRACK | LBRACE | LBRACE_BAR | LBRACK_BAR), _) :: CtxtSeqBlock _ :: CtxtThen _ :: (CtxtIf _ as limitCtxt) :: _)
- | _, (CtxtParen ((BEGIN | LPAREN | LBRACK | LBRACE | LBRACE_BAR | LBRACK_BAR | LBRACK_LESS), _) :: CtxtSeqBlock _ :: CtxtElse _ :: (CtxtIf _ as limitCtxt) :: _)
+ | _, (CtxtParen ((BEGIN | LPAREN | LBRACK | LBRACE _ | LBRACE_BAR | LBRACK_BAR), _) :: CtxtSeqBlock _ :: CtxtThen _ :: (CtxtIf _ as limitCtxt) :: _)
+ | _, (CtxtParen ((BEGIN | LPAREN | LBRACK | LBRACE _ | LBRACE_BAR | LBRACK_BAR | LBRACK_LESS), _) :: CtxtSeqBlock _ :: CtxtElse _ :: (CtxtIf _ as limitCtxt) :: _)
// 'f ... (' in seqblock limited by 'f'
// 'f ... {' in seqblock limited by 'f' NOTE: this is covered by the more generous case above
@@ -814,7 +818,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer,
// REVIEW: document these
| _, (CtxtSeqBlock _ :: CtxtParen((BEGIN | LPAREN | LBRACK | LBRACK_BAR), _) :: CtxtVanilla _ :: (CtxtSeqBlock _ as limitCtxt) :: _)
- | (CtxtSeqBlock _), (CtxtParen ((BEGIN | LPAREN | LBRACE | LBRACE_BAR | LBRACK | LBRACK_BAR), _) :: CtxtSeqBlock _ :: ((CtxtTypeDefns _ | CtxtLetDecl _ | CtxtMemberBody _ | CtxtWithAsLet _) as limitCtxt) :: _)
+ | (CtxtSeqBlock _), (CtxtParen ((BEGIN | LPAREN | LBRACE _ | LBRACE_BAR | LBRACK | LBRACK_BAR), _) :: CtxtSeqBlock _ :: ((CtxtTypeDefns _ | CtxtLetDecl _ | CtxtMemberBody _ | CtxtWithAsLet _) as limitCtxt) :: _)
-> PositionWithColumn(limitCtxt.StartPos, limitCtxt.StartCol + 1)
// Permitted inner-construct (e.g. "then" block and "else" block in overall
@@ -845,7 +849,9 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer,
match newCtxt with
// Don't bother to check pushes of Vanilla blocks since we've
// always already pushed a SeqBlock at this position.
- | CtxtVanilla _ -> ()
+ | CtxtVanilla _
+ // String interpolation inner expressions are not limited (e.g. multiline strings)
+ | CtxtParen((INTERP_STRING_BEGIN_PART _ | INTERP_STRING_PART _),_) -> ()
| _ ->
let p1 = undentationLimit true offsideStack
let c2 = newCtxt.StartCol
@@ -1053,7 +1059,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer,
// WITH balances except in the following contexts.... Phew - an overused keyword!
| WITH, ( ((CtxtMatch _ | CtxtException _ | CtxtMemberHead _ | CtxtInterfaceHead _ | CtxtTry _ | CtxtTypeDefns _ | CtxtMemberBody _) :: _)
// This is the nasty record/object-expression case
- | (CtxtSeqBlock _ :: CtxtParen((LBRACE | LBRACE_BAR), _) :: _) )
+ | (CtxtSeqBlock _ :: CtxtParen((LBRACE _ | LBRACE_BAR), _) :: _) )
| FINALLY, (CtxtTry _ :: _) ->
true
@@ -1177,7 +1183,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer,
false // no member currently on the stack, nothing to pop
else
// there is a member context
- if List.exists (function CtxtParen(LBRACE, _) -> true | _ -> false) ctxtStack then
+ if List.exists (function CtxtParen(LBRACE _, _) -> true | _ -> false) ctxtStack then
false // an LBRACE could mean an object expression, and object expressions can have 'member' tokens in them, so do not pop, to be safe
elif List.count (function CtxtParen(LPAREN, _) -> true | _ -> false) ctxtStack >= 2 then
false // static member constraints always are embedded in at least two LPARENS, so do not pop, to be safe
@@ -1223,12 +1229,14 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer,
| IN
| RPAREN
| GREATER true
- | RBRACE
+ | RBRACE _
| BAR_RBRACE
| RBRACK
| BAR_RBRACK
| WITH
| FINALLY
+ | INTERP_STRING_PART _
+ | INTERP_STRING_END _
| RQUOTE _ ->
not (tokenBalancesHeadContext token stack) &&
// Only close the context if some context is going to match at some point in the stack.
@@ -1263,7 +1271,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer,
while not offsideStack.IsEmpty && (not(nextOuterMostInterestingContextIsNamespaceOrModule offsideStack)) &&
(match offsideStack.Head with
// open-parens of sorts
- | CtxtParen((LPAREN|LBRACK|LBRACE|LBRACE_BAR|LBRACK_BAR), _) -> true
+ | CtxtParen((LPAREN|LBRACK|LBRACE _ |LBRACE_BAR|LBRACK_BAR), _) -> true
// seq blocks
| CtxtSeqBlock _ -> true
// vanillas
@@ -1314,7 +1322,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer,
| _ when tokenForcesHeadContextClosure token offsideStack ->
let ctxt = offsideStack.Head
- if debug then dprintf "IN/ELSE/ELIF/DONE/RPAREN/RBRACE/END at %a terminates context at position %a\n" outputPos tokenStartPos outputPos ctxt.StartPos
+ if debug then dprintf "IN/ELSE/ELIF/DONE/RPAREN/RBRACE/END/INTERP at %a terminates context at position %a\n" outputPos tokenStartPos outputPos ctxt.StartPos
popCtxt()
match endTokenForACtxt ctxt with
| Some tok ->
@@ -1362,12 +1370,20 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer,
hwTokenFetch useBlockRule
// Balancing rule. Encountering a ')' or '}' balances with a '(' or '{', even if not offside
- | ((END | RPAREN | RBRACE | BAR_RBRACE | RBRACK | BAR_RBRACK | RQUOTE _ | GREATER true) as t2), (CtxtParen (t1, _) :: _)
+ | ((END | RPAREN | RBRACE _ | BAR_RBRACE | RBRACK | BAR_RBRACK | RQUOTE _ | GREATER true | INTERP_STRING_END _ | INTERP_STRING_PART _) as t2), (CtxtParen (t1, _) :: _)
when parenTokensBalance t1 t2 ->
if debug then dprintf "RPAREN/RBRACE/BAR_RBRACE/RBRACK/BAR_RBRACK/RQUOTE/END at %a terminates CtxtParen()\n" outputPos tokenStartPos
popCtxt()
- // Queue a dummy token at this position to check if any closing rules apply
- delayToken(pool.UseLocation(tokenTup, ODUMMY token))
+ match t2 with
+ // $".... { ... } ... { ....} " pushes a block context at second {
+ // ~~~~~~~~
+ // ^---------INTERP_STRING_PART
+ | INTERP_STRING_PART _ ->
+ pushCtxt tokenTup (CtxtParen (token, tokenTup.LexbufState.EndPos))
+ pushCtxtSeqBlock(false, NoAddBlockEnd)
+ | _ ->
+ // Queue a dummy token at this position to check if any closing rules apply
+ delayToken(pool.UseLocation(tokenTup, ODUMMY token))
returnToken tokenLexbufState token
// Balancing rule. Encountering a 'end' can balance with a 'with' but only when not offside
@@ -1852,6 +1868,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer,
else
returnToken tokenLexbufState token
+
// 'with id = ' ~~~> CtxtSeqBlock
// 'with M.id = ' ~~~> CtxtSeqBlock
// 'with id1 = 1
@@ -1865,7 +1882,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer,
// '{ id1 = 1
// M.id2 = ... ' ~~~> CtxtSeqBlock
| EQUALS, ((CtxtWithAsLet _) :: _) // This detects 'with = '.
- | EQUALS, ((CtxtVanilla (_, true)) :: (CtxtSeqBlock _) :: (CtxtWithAsLet _ | CtxtParen((LBRACE | LBRACE_BAR), _)) :: _) ->
+ | EQUALS, ((CtxtVanilla (_, true)) :: (CtxtSeqBlock _) :: (CtxtWithAsLet _ | CtxtParen((LBRACE _ | LBRACE_BAR), _)) :: _) ->
if debug then dprintf "CtxtLetDecl/CtxtWithAsLet: EQUALS, pushing CtxtSeqBlock\n"
// We don't insert begin/end block tokens for single-line bindings since we can't properly distinguish single-line *)
// record update expressions such as "{ t with gbuckets=Array.copy t.gbuckets; gcount=t.gcount }" *)
@@ -1889,9 +1906,15 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer,
returnToken tokenLexbufState token
// '(' tokens are balanced with ')' tokens and also introduce a CtxtSeqBlock
- | (BEGIN | LPAREN | SIG | LBRACE | LBRACE_BAR | LBRACK | LBRACK_BAR | LQUOTE _ | LESS true), _ ->
+ // $".... { ... } ... { ....} " pushes a block context at first {
+ // ~~~~~~~~
+ // ^---------INTERP_STRING_BEGIN_PART
+ | (BEGIN | LPAREN | SIG | LBRACE _ | LBRACE_BAR | LBRACK | LBRACK_BAR | LQUOTE _ | LESS true | INTERP_STRING_BEGIN_PART _), _ ->
if debug then dprintf "LPAREN etc., pushes CtxtParen, pushing CtxtSeqBlock, tokenStartPos = %a\n" outputPos tokenStartPos
- pushCtxt tokenTup (CtxtParen (token, tokenStartPos))
+ let pos = match token with
+ | INTERP_STRING_BEGIN_PART _ -> tokenTup.LexbufState.EndPos
+ | _ -> tokenStartPos
+ pushCtxt tokenTup (CtxtParen (token, pos))
pushCtxtSeqBlock(false, NoAddBlockEnd)
returnToken tokenLexbufState token
@@ -1915,7 +1938,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer,
// comprehension/match
| (CtxtWhile _ | CtxtFor _ | CtxtWhen _ | CtxtMatchClauses _ | CtxtFun _) :: _ -> true
// comprehension
- | (CtxtSeqBlock _ :: CtxtParen ((LBRACK | LBRACE | LBRACE_BAR | LBRACK_BAR), _) :: _) -> true
+ | (CtxtSeqBlock _ :: CtxtParen ((LBRACK | LBRACE _ | LBRACE_BAR | LBRACK_BAR), _) :: _) -> true
// comprehension
| (CtxtSeqBlock _ :: (CtxtDo _ | CtxtWhile _ | CtxtFor _ | CtxtWhen _ | CtxtMatchClauses _ | CtxtTry _ | CtxtThen _ | CtxtElse _) :: _) -> true
| _ -> false) ->
@@ -1966,11 +1989,11 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer,
returnToken tokenLexbufState token
| WITH, (((CtxtException _ | CtxtTypeDefns _ | CtxtMemberHead _ | CtxtInterfaceHead _ | CtxtMemberBody _) as limCtxt) :: _)
- | WITH, ((CtxtSeqBlock _) as limCtxt :: CtxtParen((LBRACE | LBRACE_BAR), _) :: _) ->
+ | WITH, ((CtxtSeqBlock _) as limCtxt :: CtxtParen((LBRACE _ | LBRACE_BAR), _) :: _) ->
let lookaheadTokenTup = peekNextTokenTup()
let lookaheadTokenStartPos = startPosOfTokenTup lookaheadTokenTup
match lookaheadTokenTup.Token with
- | RBRACE
+ | RBRACE _
| IDENT _
// The next clause detects the access annotations after the 'with' in:
// member x.PublicGetSetProperty
@@ -2331,7 +2354,7 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer,
let _firstTokenTup = peekInitial()
()
- if lightSyntaxStatus.Status
+ if lightStatus.Status
then hwTokenFetch true
else swTokenFetch()
@@ -2339,8 +2362,8 @@ type LexFilterImpl (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer,
// LexFilterImpl does the majority of the work for offsides rules and other magic.
// LexFilter just wraps it with light post-processing that introduces a few more 'coming soon' symbols, to
// make it easier for the parser to 'look ahead' and safely shift tokens in a number of recovery scenarios.
-type LexFilter (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, lexbuf: UnicodeLexing.Lexbuf) =
- let inner = new LexFilterImpl (lightSyntaxStatus, compilingFsLib, lexer, lexbuf)
+type LexFilter (lightStatus: LightSyntaxStatus, compilingFsLib, lexer, lexbuf: UnicodeLexing.Lexbuf) =
+ let inner = new LexFilterImpl (lightStatus, compilingFsLib, lexer, lexbuf)
// We don't interact with lexbuf state at all, any inserted tokens have same state/location as the real one read, so
// we don't have to do any of the wrapped lexbuf magic that you see in LexFilterImpl.
@@ -2365,7 +2388,7 @@ type LexFilter (lightSyntaxStatus: LightSyntaxStatus, compilingFsLib, lexer, lex
let rec loop() =
let token = popNextToken()
match token with
- | RBRACE ->
+ | RBRACE _ ->
insertComingSoonTokens RBRACE_COMING_SOON RBRACE_IS_HERE
loop()
| RPAREN ->
diff --git a/src/fsharp/MethodCalls.fs b/src/fsharp/MethodCalls.fs
index 61ce01d1af0..441c999d75d 100644
--- a/src/fsharp/MethodCalls.fs
+++ b/src/fsharp/MethodCalls.fs
@@ -853,7 +853,8 @@ let TryImportProvidedMethodBaseAsLibraryIntrinsic (amap: Import.ImportMap, m: ra
match tryTcrefOfAppTy amap.g declaringType with
| ValueSome declaringEntity ->
if not declaringEntity.IsLocalRef && ccuEq declaringEntity.nlr.Ccu amap.g.fslibCcu then
- match amap.g.knownIntrinsics.TryGetValue ((declaringEntity.LogicalName, methodName)) with
+ let n = mbase.PUntaint((fun x -> x.GetParameters().Length), m)
+ match amap.g.knownIntrinsics.TryGetValue ((declaringEntity.LogicalName, None, methodName, n)) with
| true, vref -> Some vref
| _ ->
match amap.g.knownFSharpCoreModules.TryGetValue declaringEntity.LogicalName with
diff --git a/src/fsharp/ParseHelpers.fs b/src/fsharp/ParseHelpers.fs
index 0024246643b..33e7872b186 100644
--- a/src/fsharp/ParseHelpers.fs
+++ b/src/fsharp/ParseHelpers.fs
@@ -116,6 +116,7 @@ type LexerIfdefStackEntry =
| IfDefIf
| IfDefElse
+/// Represents the active #if/#else blocks
type LexerIfdefStackEntries = (LexerIfdefStackEntry * range) list
type LexerIfdefStack = LexerIfdefStackEntries
@@ -124,12 +125,8 @@ type LexerIfdefStack = LexerIfdefStackEntries
/// it reaches end of line or eof. The options are to continue with 'token' function
/// or to continue with 'skip' function.
type LexerEndlineContinuation =
- | Token of LexerIfdefStackEntries
- | Skip of LexerIfdefStackEntries * int * range: range
- member x.LexerIfdefStack =
- match x with
- | LexerEndlineContinuation.Token ifd
- | LexerEndlineContinuation.Skip(ifd, _, _) -> ifd
+ | Token
+ | Skip of int * range: range
type LexerIfdefExpression =
| IfdefAnd of LexerIfdefExpression*LexerIfdefExpression
@@ -147,42 +144,67 @@ let rec LexerIfdefEval (lookup: string -> bool) = function
// Parsing: continuations for whitespace tokens
//------------------------------------------------------------------------
+[]
+type LexerStringStyle =
+ | Verbatim
+ | TripleQuote
+ | SingleQuote
+
+[]
+type LexerStringKind =
+ { IsByteString: bool
+ IsInterpolated: bool
+ IsInterpolatedFirst: bool }
+ static member String = { IsByteString = false; IsInterpolated = false; IsInterpolatedFirst=false }
+ static member ByteString = { IsByteString = true; IsInterpolated = false; IsInterpolatedFirst=false }
+ static member InterpolatedStringFirst = { IsByteString = false; IsInterpolated = true; IsInterpolatedFirst=true }
+ static member InterpolatedStringPart = { IsByteString = false; IsInterpolated = true; IsInterpolatedFirst=false }
+
+/// Represents the degree of nesting of '{..}' and the style of the string to continue afterwards, in an interpolation fill.
+/// Nesting counters and styles of outer interpolating strings are pushed on this stack.
+type LexerInterpolatedStringNesting = (int * LexerStringStyle * range) list
+
/// The parser defines a number of tokens for whitespace and
/// comments eliminated by the lexer. These carry a specification of
/// a continuation for the lexer for continued processing after we've dealt with
/// the whitespace.
[]
[]
-type LexerWhitespaceContinuation =
- | Token of ifdef: LexerIfdefStackEntries
- | IfDefSkip of ifdef: LexerIfdefStackEntries * int * range: range
- | String of ifdef: LexerIfdefStackEntries * range: range
- | VerbatimString of ifdef: LexerIfdefStackEntries * range: range
- | TripleQuoteString of ifdef: LexerIfdefStackEntries * range: range
- | Comment of ifdef: LexerIfdefStackEntries * int * range: range
- | SingleLineComment of ifdef: LexerIfdefStackEntries * int * range: range
- | StringInComment of ifdef: LexerIfdefStackEntries * int * range: range
- | VerbatimStringInComment of ifdef: LexerIfdefStackEntries * int * range: range
- | TripleQuoteStringInComment of ifdef: LexerIfdefStackEntries * int * range: range
- | MLOnly of ifdef: LexerIfdefStackEntries * range: range
- | EndLine of LexerEndlineContinuation
+type LexerContinuation =
+ | Token of ifdef: LexerIfdefStackEntries * nesting: LexerInterpolatedStringNesting
+ | IfDefSkip of ifdef: LexerIfdefStackEntries * nesting: LexerInterpolatedStringNesting * int * range: range
+ | String of ifdef: LexerIfdefStackEntries * nesting: LexerInterpolatedStringNesting * style: LexerStringStyle * kind: LexerStringKind * range: range
+ | Comment of ifdef: LexerIfdefStackEntries * nesting: LexerInterpolatedStringNesting * int * range: range
+ | SingleLineComment of ifdef: LexerIfdefStackEntries * nesting: LexerInterpolatedStringNesting * int * range: range
+ | StringInComment of ifdef: LexerIfdefStackEntries * nesting: LexerInterpolatedStringNesting * style: LexerStringStyle * int * range: range
+ | MLOnly of ifdef: LexerIfdefStackEntries * nesting: LexerInterpolatedStringNesting * range: range
+ | EndLine of ifdef: LexerIfdefStackEntries * nesting: LexerInterpolatedStringNesting * LexerEndlineContinuation
+
+ static member Default = LexCont.Token([],[])
member x.LexerIfdefStack =
match x with
| LexCont.Token (ifdef=ifd)
| LexCont.IfDefSkip (ifdef=ifd)
| LexCont.String (ifdef=ifd)
- | LexCont.VerbatimString (ifdef=ifd)
| LexCont.Comment (ifdef=ifd)
| LexCont.SingleLineComment (ifdef=ifd)
- | LexCont.TripleQuoteString (ifdef=ifd)
| LexCont.StringInComment (ifdef=ifd)
- | LexCont.VerbatimStringInComment (ifdef=ifd)
- | LexCont.TripleQuoteStringInComment (ifdef=ifd)
+ | LexCont.EndLine (ifdef=ifd)
| LexCont.MLOnly (ifdef=ifd) -> ifd
- | LexCont.EndLine endl -> endl.LexerIfdefStack
-and LexCont = LexerWhitespaceContinuation
+ member x.LexerInterpStringNesting =
+ match x with
+ | LexCont.Token (nesting=nesting)
+ | LexCont.IfDefSkip (nesting=nesting)
+ | LexCont.String (nesting=nesting)
+ | LexCont.Comment (nesting=nesting)
+ | LexCont.SingleLineComment (nesting=nesting)
+ | LexCont.StringInComment (nesting=nesting)
+ | LexCont.EndLine (nesting=nesting)
+ | LexCont.MLOnly (nesting=nesting) -> nesting
+
+and LexCont = LexerContinuation
//------------------------------------------------------------------------
// Parse IL assembly code
diff --git a/src/fsharp/PostInferenceChecks.fs b/src/fsharp/PostInferenceChecks.fs
index dda6f889e8f..1bd7e324dfd 100644
--- a/src/fsharp/PostInferenceChecks.fs
+++ b/src/fsharp/PostInferenceChecks.fs
@@ -842,7 +842,7 @@ and CheckForOverAppliedExceptionRaisingPrimitive (cenv: cenv) expr =
| OptionalCoerce(Expr.Val (failwithfFunc, _, funcRange)) when valRefEq g failwithfFunc g.failwithf_vref ->
match argsl with
| Expr.App (Expr.Val (newFormat, _, _), _, [_; typB; typC; _; _], [Expr.Const (Const.String formatString, formatRange, _)], _) :: xs when valRefEq g newFormat g.new_format_vref ->
- match CheckFormatStrings.TryCountFormatStringArguments formatRange g formatString typB typC with
+ match CheckFormatStrings.TryCountFormatStringArguments formatRange g false formatString typB typC with
| Some n ->
let expected = n + 1
let actual = List.length xs + 1
diff --git a/src/fsharp/SyntaxTree.fs b/src/fsharp/SyntaxTree.fs
index 94fd921eaff..74f2be21d6f 100644
--- a/src/fsharp/SyntaxTree.fs
+++ b/src/fsharp/SyntaxTree.fs
@@ -1008,6 +1008,12 @@ type SynExpr =
expr: SynExpr *
range: range
+ /// F# syntax: interpolated string, e.g. "abc{x}" or "abc{x,3}" or "abc{x:N4}"
+ /// Note the string ranges include the quotes, verbatim markers, dollar sign and braces
+ | InterpolatedString of
+ contents: SynInterpolatedStringPart list *
+ range: range
+
/// Gets the syntax range of this construct
member e.Range =
match e with
@@ -1074,7 +1080,8 @@ type SynExpr =
| SynExpr.LetOrUseBang (range=m)
| SynExpr.MatchBang (range=m)
| SynExpr.DoBang (range=m)
- | SynExpr.Fixed (range=m) -> m
+ | SynExpr.Fixed (range=m)
+ | SynExpr.InterpolatedString (range=m) -> m
| SynExpr.Ident id -> id.idRange
/// Get the Range ignoring any (parse error) extra trailing dots
@@ -1111,6 +1118,11 @@ type SynExpr =
| SynExpr.ArbitraryAfterError _ -> true
| _ -> false
+[]
+type SynInterpolatedStringPart =
+ | String of string * range
+ | FillExpr of SynExpr * Ident option
+
/// Represents a syntax tree for an F# indexer expression argument
[]
type SynIndexerArg =
diff --git a/src/fsharp/SyntaxTreeOps.fs b/src/fsharp/SyntaxTreeOps.fs
index 7615bf8e753..a2b1949a3e6 100644
--- a/src/fsharp/SyntaxTreeOps.fs
+++ b/src/fsharp/SyntaxTreeOps.fs
@@ -731,4 +731,10 @@ let rec synExprContainsError inpExpr =
| SynExpr.LetOrUseBang (rhs=e1;body=e2;andBangs=es) ->
walkExpr e1 || walkExprs [ for (_,_,_,_,e,_) in es do yield e ] || walkExpr e2
+ | SynExpr.InterpolatedString (parts, _m) ->
+ walkExprs
+ (parts |> List.choose (function
+ | SynInterpolatedStringPart.String _ -> None
+ | SynInterpolatedStringPart.FillExpr (x, _) -> Some x))
+
walkExpr inpExpr
diff --git a/src/fsharp/TcGlobals.fs b/src/fsharp/TcGlobals.fs
index 0c335fdfff2..fe67f07ade0 100755
--- a/src/fsharp/TcGlobals.fs
+++ b/src/fsharp/TcGlobals.fs
@@ -139,7 +139,7 @@ let tname_Exception = "System.Exception"
[]
let tname_Missing = "System.Reflection.Missing"
[]
-let tname_Activator = "System.Activator"
+let tname_FormattableString = "System.FormattableString"
[]
let tname_SerializationInfo = "System.Runtime.Serialization.SerializationInfo"
[]
@@ -334,6 +334,12 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d
let v_bool_ty = mkNonGenericTy v_bool_tcr
let v_char_ty = mkNonGenericTy v_char_tcr
let v_obj_ty = mkNonGenericTy v_obj_tcr
+ let v_IFormattable_tcref = findSysTyconRef sys "IFormattable"
+ let v_FormattableString_tcref = findSysTyconRef sys "FormattableString"
+ let v_IFormattable_ty = mkNonGenericTy v_IFormattable_tcref
+ let v_FormattableString_ty = mkNonGenericTy v_FormattableString_tcref
+ let v_FormattableStringFactory_tcref = findSysTyconRef sysCompilerServices "FormattableStringFactory"
+ let v_FormattableStringFactory_ty = mkNonGenericTy v_FormattableStringFactory_tcref
let v_string_ty = mkNonGenericTy v_string_tcr
let v_decimal_ty = mkSysNonGenericTy sys "Decimal"
let v_unit_ty = mkNonGenericTy v_unit_tcr_nice
@@ -354,7 +360,7 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d
let mkForallTyIfNeeded d r = match d with [] -> r | tps -> TType_forall(tps, r)
// A table of all intrinsics that the compiler cares about
- let v_knownIntrinsics = Dictionary<(string*string), ValRef>(HashIdentity.Structural)
+ let v_knownIntrinsics = Dictionary<(string * string option * string * int), ValRef>(HashIdentity.Structural)
let makeIntrinsicValRefGeneral isKnown (enclosingEntity, logicalName, memberParentName, compiledNameOpt, typars, (argtys, rty)) =
let ty = mkForallTyIfNeeded typars (mkIteratedFunTy (List.map mkSmallRefTupledTy argtys) rty)
@@ -364,8 +370,11 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d
let key = ValLinkageFullKey({ MemberParentMangledName=memberParentName; MemberIsOverride=false; LogicalName=logicalName; TotalArgCount= argCount }, linkageType)
let vref = IntrinsicValRef(enclosingEntity, logicalName, isMember, ty, key)
let compiledName = defaultArg compiledNameOpt logicalName
- if isKnown then
- v_knownIntrinsics.Add((enclosingEntity.LastItemMangledName, compiledName), ValRefForIntrinsic vref)
+
+ let key = (enclosingEntity.LastItemMangledName, memberParentName, compiledName, argCount)
+ assert not (v_knownIntrinsics.ContainsKey(key))
+ if isKnown && not (v_knownIntrinsics.ContainsKey(key)) then
+ v_knownIntrinsics.Add(key, ValRefForIntrinsic vref)
vref
let makeIntrinsicValRef info = makeIntrinsicValRefGeneral true info
@@ -431,6 +440,7 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d
let fslib_MFQueryRunExtensionsLowPriority_nleref = mkNestedNonLocalEntityRef fslib_MFQueryRunExtensions_nleref "LowPriority"
let fslib_MFQueryRunExtensionsHighPriority_nleref = mkNestedNonLocalEntityRef fslib_MFQueryRunExtensions_nleref "HighPriority"
+ let fslib_MFPrintfModule_nleref = mkNestedNonLocalEntityRef fslib_MFCore_nleref "PrintfModule"
let fslib_MFSeqModule_nleref = mkNestedNonLocalEntityRef fslib_MFCollections_nleref "SeqModule"
let fslib_MFListModule_nleref = mkNestedNonLocalEntityRef fslib_MFCollections_nleref "ListModule"
let fslib_MFArrayModule_nleref = mkNestedNonLocalEntityRef fslib_MFCollections_nleref "ArrayModule"
@@ -495,6 +505,7 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d
fslib_MFQueryRunExtensionsLowPriority_nleref
fslib_MFQueryRunExtensionsHighPriority_nleref
+ fslib_MFPrintfModule_nleref
fslib_MFSeqModule_nleref
fslib_MFListModule_nleref
fslib_MFArrayModule_nleref
@@ -1014,6 +1025,12 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d
member __.bool_ty = v_bool_ty
member __.int_ty = v_int_ty
member __.string_ty = v_string_ty
+ member __.system_IFormattable_tcref = v_IFormattable_tcref
+ member __.system_FormattableString_tcref = v_FormattableString_tcref
+ member __.system_FormattableStringFactory_tcref = v_FormattableStringFactory_tcref
+ member __.system_IFormattable_ty = v_IFormattable_ty
+ member __.system_FormattableString_ty = v_FormattableString_ty
+ member __.system_FormattableStringFactory_ty = v_FormattableStringFactory_ty
member __.unit_ty = v_unit_ty
member __.obj_ty = v_obj_ty
member __.char_ty = v_char_ty
@@ -1394,15 +1411,16 @@ type public TcGlobals(compilingFslib: bool, ilg:ILGlobals, fslibCcu: CcuThunk, d
member __.seq_append_info = v_seq_append_info
member __.seq_generated_info = v_seq_generated_info
member __.seq_finally_info = v_seq_finally_info
- member __.seq_of_functions_info = v_seq_of_functions_info
+ member __.seq_of_functions_info = v_seq_of_functions_info
member __.seq_map_info = v_seq_map_info
member __.seq_singleton_info = v_seq_singleton_info
member __.seq_empty_info = v_seq_empty_info
+ member __.sprintf_info = v_sprintf_info
member __.new_format_info = v_new_format_info
member __.unbox_info = v_unbox_info
- member __.get_generic_comparer_info = v_get_generic_comparer_info
- member __.get_generic_er_equality_comparer_info = v_get_generic_er_equality_comparer_info
- member __.get_generic_per_equality_comparer_info = v_get_generic_per_equality_comparer_info
+ member __.get_generic_comparer_info = v_get_generic_comparer_info
+ member __.get_generic_er_equality_comparer_info = v_get_generic_er_equality_comparer_info
+ member __.get_generic_per_equality_comparer_info = v_get_generic_per_equality_comparer_info
member __.dispose_info = v_dispose_info
member __.getstring_info = v_getstring_info
member __.unbox_fast_info = v_unbox_fast_info
diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs
index 34ba5ba884b..20b88579ea7 100755
--- a/src/fsharp/TypeChecker.fs
+++ b/src/fsharp/TypeChecker.fs
@@ -5938,6 +5938,13 @@ and TcExprUndelayed cenv overallTy env tpenv (synExpr: SynExpr) =
CallExprHasTypeSink cenv.tcSink (m, env.NameEnv, overallTy, env.AccessRights)
TcConstStringExpr cenv overallTy env m tpenv s
+ | SynExpr.InterpolatedString (parts, m) ->
+ tryLanguageFeatureError cenv.g.langVersion LanguageFeature.StringInterpolation m
+
+ CallExprHasTypeSink cenv.tcSink (m, env.NameEnv, overallTy, env.AccessRights)
+
+ TcInterpolatedStringExpr cenv overallTy env m tpenv parts
+
| SynExpr.Const (synConst, m) ->
CallExprHasTypeSink cenv.tcSink (m, env.NameEnv, overallTy, env.AccessRights)
TcConstExpr cenv overallTy env m tpenv synConst
@@ -7119,20 +7126,30 @@ and TcObjectExpr cenv overallTy env tpenv (synObjTy, argopt, binds, extraImpls,
and TcConstStringExpr cenv overallTy env m tpenv s =
if (AddCxTypeEqualsTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy cenv.g.string_ty) then
- mkString cenv.g m s, tpenv
+ mkString cenv.g m s, tpenv
else
- let aty = NewInferenceType ()
- let bty = NewInferenceType ()
- let cty = NewInferenceType ()
- let dty = NewInferenceType ()
- let ety = NewInferenceType ()
- let ty' = mkPrintfFormatTy cenv.g aty bty cty dty ety
- if (not (isObjTy cenv.g overallTy) && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy ty') then
+ TcFormatStringExpr cenv overallTy env m tpenv s
+
+and TcFormatStringExpr cenv overallTy env m tpenv (fmtString: string) =
+ let g = cenv.g
+ let aty = NewInferenceType ()
+ let bty = NewInferenceType ()
+ let cty = NewInferenceType ()
+ let dty = NewInferenceType ()
+ let ety = NewInferenceType ()
+ let formatTy = mkPrintfFormatTy g aty bty cty dty ety
+
+ // This might qualify as a format string - check via a type directed rule
+ let ok = not (isObjTy g overallTy) && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy formatTy
+
+ if ok then
// Parse the format string to work out the phantom types
let formatStringCheckContext = match cenv.tcSink.CurrentSink with None -> None | Some sink -> sink.FormatStringCheckContext
- let normalizedString = (s.Replace("\r\n", "\n").Replace("\r", "\n"))
+ let normalizedString = (fmtString.Replace("\r\n", "\n").Replace("\r", "\n"))
- let (aty', ety'), specifierLocations = (try CheckFormatStrings.ParseFormatString m cenv.g formatStringCheckContext normalizedString bty cty dty with Failure s -> error (Error(FSComp.SR.tcUnableToParseFormatString s, m)))
+ let _argTys, atyRequired, etyRequired, _percentATys, specifierLocations, _dotnetFormatString =
+ try CheckFormatStrings.ParseFormatString m [m] g false false formatStringCheckContext normalizedString bty cty dty
+ with Failure errString -> error (Error(FSComp.SR.tcUnableToParseFormatString errString, m))
match cenv.tcSink.CurrentSink with
| None -> ()
@@ -7140,12 +7157,195 @@ and TcConstStringExpr cenv overallTy env m tpenv s =
for specifierLocation, numArgs in specifierLocations do
sink.NotifyFormatSpecifierLocation(specifierLocation, numArgs)
- UnifyTypes cenv env m aty aty'
- UnifyTypes cenv env m ety ety'
- mkCallNewFormat cenv.g m aty bty cty dty ety (mkString cenv.g m s), tpenv
- else
- UnifyTypes cenv env m overallTy cenv.g.string_ty
- mkString cenv.g m s, tpenv
+ UnifyTypes cenv env m aty atyRequired
+ UnifyTypes cenv env m ety etyRequired
+ let fmtExpr = mkCallNewFormat g m aty bty cty dty ety (mkString g m fmtString)
+ fmtExpr, tpenv
+
+ else
+ UnifyTypes cenv env m overallTy g.string_ty
+ mkString g m fmtString, tpenv
+
+/// Check an interpolated string expression
+and TcInterpolatedStringExpr cenv overallTy env m tpenv (parts: SynInterpolatedStringPart list) =
+ let g = cenv.g
+
+ let synFillExprs =
+ parts
+ |> List.choose (function
+ | SynInterpolatedStringPart.String _ -> None
+ | SynInterpolatedStringPart.FillExpr (fillExpr, _) ->
+ match fillExpr with
+ // Detect "x" part of "...{x,3}..."
+ | SynExpr.Tuple (false, [e; SynExpr.Const (SynConst.Int32 _align, _)], _, _) -> Some e
+ | e -> Some e)
+
+ let stringFragmentRanges =
+ parts
+ |> List.choose (function
+ | SynInterpolatedStringPart.String (_,m) -> Some m
+ | SynInterpolatedStringPart.FillExpr _ -> None)
+
+ let printerTy = NewInferenceType ()
+ let printerArgTy = NewInferenceType ()
+ let printerResidueTy = NewInferenceType ()
+ let printerResultTy = NewInferenceType ()
+ let printerTupleTy = NewInferenceType ()
+ let formatTy = mkPrintfFormatTy g printerTy printerArgTy printerResidueTy printerResultTy printerTupleTy
+
+ // Check the library support is available in the referenced FSharp.Core
+ let newFormatMethod =
+ match GetIntrinsicConstructorInfosOfType cenv.infoReader m formatTy |> List.filter (fun minfo -> minfo.NumArgs = [3]) with
+ | [ctorInfo] -> ctorInfo
+ | _ -> languageFeatureNotSupportedInLibraryError cenv.g.langVersion LanguageFeature.StringInterpolation m
+
+ let stringKind =
+ // If this is an interpolated string then try to force the result to be a string
+ if (AddCxTypeEqualsTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy g.string_ty) then
+
+ // And if that succeeds, the result of printing is a string
+ UnifyTypes cenv env m printerArgTy g.unit_ty
+ UnifyTypes cenv env m printerResidueTy g.string_ty
+ UnifyTypes cenv env m printerResultTy overallTy
+
+ // And if that succeeds, the printerTy and printerResultTy must be the same (there are no curried arguments)
+ UnifyTypes cenv env m printerTy printerResultTy
+
+ Choice1Of2 (true, newFormatMethod)
+
+ // ... or if that fails then may be a FormattableString by a type-directed rule....
+ elif (not (isObjTy g overallTy) &&
+ ((g.system_FormattableString_tcref.CanDeref && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy g.system_FormattableString_ty)
+ || (g.system_IFormattable_tcref.CanDeref && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy g.system_IFormattable_ty))) then
+
+ // And if that succeeds, the result of printing is a string
+ UnifyTypes cenv env m printerArgTy g.unit_ty
+ UnifyTypes cenv env m printerResidueTy g.string_ty
+ UnifyTypes cenv env m printerResultTy overallTy
+
+ // Find the FormattableStringFactor.Create method in the .NET libraries
+ let ad = env.eAccessRights
+ let createMethodOpt =
+ match TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AllResults cenv env m ad "Create" g.system_FormattableStringFactory_ty with
+ | [x] -> Some x
+ | _ -> None
+
+ match createMethodOpt with
+ | Some createMethod -> Choice2Of2 createMethod
+ | None -> languageFeatureNotSupportedInLibraryError cenv.g.langVersion LanguageFeature.StringInterpolation m
+
+ // ... or if that fails then may be a PrintfFormat by a type-directed rule....
+ elif not (isObjTy g overallTy) && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy formatTy then
+
+ // And if that succeeds, the printerTy and printerResultTy must be the same (there are no curried arguments)
+ UnifyTypes cenv env m printerTy printerResultTy
+ Choice1Of2 (false, newFormatMethod)
+
+ else
+ // this should fail and produce an error
+ UnifyTypes cenv env m overallTy g.string_ty
+ Choice1Of2 (true, newFormatMethod)
+
+ let isFormattableString = (match stringKind with Choice2Of2 _ -> true | _ -> false)
+
+ // The format string used for checking in CheckFormatStrings. This replaces interpolation holes with %P
+ let printfFormatString =
+ parts
+ |> List.map (function
+ | SynInterpolatedStringPart.String (s, _) -> s
+ | SynInterpolatedStringPart.FillExpr (fillExpr, format) ->
+ let alignText =
+ match fillExpr with
+ // Validate and detect ",3" part of "...{x,3}..."
+ | SynExpr.Tuple (false, args, _, _) ->
+ match args with
+ | [_; SynExpr.Const (SynConst.Int32 align, _)] -> string align
+ | _ -> errorR(Error(FSComp.SR.tcInvalidAlignmentInInterpolatedString(), m)); ""
+ | _ -> ""
+ let formatText = match format with None -> "()" | Some n -> "(" + n.idText + ")"
+ "%" + alignText + "P" + formatText )
+ |> String.concat ""
+
+ // Parse the format string to work out the phantom types and check for absence of '%' specifiers in FormattableString
+ //
+ // If FormatStringCheckContext is set (i.e. we are doing foreground checking in the IDE)
+ // then we check the string twice, once to collect % positions and once to get errors.
+ // The process of getting % positions doesn't process the string in a semantically accurate way
+ // (but is enough to report % locations correctly), as it fetched the pieces from the
+ // original source and this may include some additional characters,
+ // and also doesn't raise all necessary errors
+ match cenv.tcSink.CurrentSink with
+ | Some sink when sink.FormatStringCheckContext.IsSome ->
+ try
+ let _argTys, _printerTy, _printerTupleTyRequired, _percentATys, specifierLocations, _dotnetFormatString =
+ CheckFormatStrings.ParseFormatString m stringFragmentRanges g true isFormattableString sink.FormatStringCheckContext printfFormatString printerArgTy printerResidueTy printerResultTy
+ for specifierLocation, numArgs in specifierLocations do
+ sink.NotifyFormatSpecifierLocation(specifierLocation, numArgs)
+ with _err->
+ ()
+ | _ -> ()
+
+ let argTys, _printerTy, printerTupleTyRequired, percentATys, _specifierLocations, dotnetFormatString =
+ try
+ CheckFormatStrings.ParseFormatString m stringFragmentRanges g true isFormattableString None printfFormatString printerArgTy printerResidueTy printerResultTy
+ with Failure errString ->
+ error (Error(FSComp.SR.tcUnableToParseInterpolatedString errString, m))
+
+ // Check the expressions filling the holes
+ if argTys.Length <> synFillExprs.Length then
+ error (Error(FSComp.SR.tcInterpolationMixedWithPercent(), m))
+
+ match stringKind with
+
+ // The case for $"..." used as type string and $"...%d{x}..." used as type PrintfFormat - create a PrintfFormat that captures
+ // is arguments
+ | Choice1Of2 (isString, newFormatMethod) ->
+
+ UnifyTypes cenv env m printerTupleTy printerTupleTyRequired
+
+ // Type check the expressions filling the holes
+ let flexes = argTys |> List.map (fun _ -> false)
+ let fillExprs, tpenv = TcExprs cenv env m tpenv flexes argTys synFillExprs
+
+ let fillExprsBoxed = (argTys, fillExprs) ||> List.map2 (mkCallBox g m)
+
+ let argsExpr = mkArray (g.obj_ty, fillExprsBoxed, m)
+ let percentATysExpr =
+ if percentATys.Length = 0 then
+ mkNull m (mkArrayType g g.system_Type_ty)
+ else
+ let tyExprs = percentATys |> Array.map (mkCallTypeOf g m) |> Array.toList
+ mkArray (g.system_Type_ty, tyExprs, m)
+
+ let fmtExpr = MakeMethInfoCall cenv.amap m newFormatMethod [] [mkString g m printfFormatString; argsExpr; percentATysExpr]
+
+ if isString then
+ // Make the call to sprintf
+ mkCall_sprintf g m printerTy fmtExpr [], tpenv
+ else
+ fmtExpr, tpenv
+
+ // The case for $"..." used as type FormattableString or IFormattable
+ | Choice2Of2 createFormattableStringMethod ->
+
+ // Type check the expressions filling the holes
+ let flexes = argTys |> List.map (fun _ -> false)
+ let fillExprs, tpenv = TcExprs cenv env m tpenv flexes argTys synFillExprs
+
+ let fillExprsBoxed = (argTys, fillExprs) ||> List.map2 (mkCallBox g m)
+
+ let dotnetFormatStringExpr = mkString g m dotnetFormatString
+ let argsExpr = mkArray (g.obj_ty, fillExprsBoxed, m)
+
+ // FormattableString are *always* turned into FormattableStringFactory.Create calls, boxing each argument
+ let createExpr, _ = BuildPossiblyConditionalMethodCall cenv env NeverMutates m false createFormattableStringMethod NormalValUse [] [dotnetFormatStringExpr; argsExpr] []
+
+ let resultExpr =
+ if typeEquiv g overallTy g.system_IFormattable_ty then
+ mkCoerceIfNeeded g g.system_IFormattable_ty g.system_FormattableString_ty createExpr
+ else
+ createExpr
+ resultExpr, tpenv
//-------------------------------------------------------------------------
// TcConstExpr
@@ -9795,6 +9995,7 @@ and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) del
| SynExpr.AddressOf (_, synExpr, _, _)
| SynExpr.Quote (_, _, synExpr, _, _) -> isSimpleArgument synExpr
+ | SynExpr.InterpolatedString _
| SynExpr.Null _
| SynExpr.Ident _
| SynExpr.Const _
diff --git a/src/fsharp/TypedTreeOps.fs b/src/fsharp/TypedTreeOps.fs
index 229f75fb32a..5182f06d056 100644
--- a/src/fsharp/TypedTreeOps.fs
+++ b/src/fsharp/TypedTreeOps.fs
@@ -7059,7 +7059,8 @@ let mkCallRaise (g: TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.r
let mkCallNewDecimal (g: TcGlobals) m (e1, e2, e3, e4, e5) = mkApps g (typedExprForIntrinsic g m g.new_decimal_info, [], [ e1;e2;e3;e4;e5 ], m)
-let mkCallNewFormat (g: TcGlobals) m aty bty cty dty ety e1 = mkApps g (typedExprForIntrinsic g m g.new_format_info, [[aty;bty;cty;dty;ety]], [ e1 ], m)
+let mkCallNewFormat (g: TcGlobals) m aty bty cty dty ety e1 =
+ mkApps g (typedExprForIntrinsic g m g.new_format_info, [[aty;bty;cty;dty;ety]], [ e1 ], m)
let tryMkCallBuiltInWitness (g: TcGlobals) traitInfo argExprs m =
let info, tinst = g.MakeBuiltInWitnessInfo traitInfo
@@ -7136,6 +7137,9 @@ let mkCallSeqSingleton g m ty1 arg1 =
let mkCallSeqEmpty g m ty1 =
mkApps g (typedExprForIntrinsic g m g.seq_empty_info, [[ty1]], [ ], m)
+let mkCall_sprintf (g: TcGlobals) m aty fmt es =
+ mkApps g (typedExprForIntrinsic g m g.sprintf_info, [[aty]], fmt::es , m)
+
let mkCallDeserializeQuotationFSharp20Plus g m e1 e2 e3 e4 =
let args = [ e1; e2; e3; e4 ]
mkApps g (typedExprForIntrinsic g m g.deserialize_quoted_FSharp_20_plus_info, [], [ mkRefTupledNoTypes g m args ], m)
diff --git a/src/fsharp/TypedTreeOps.fsi b/src/fsharp/TypedTreeOps.fsi
index 8df899582b8..89fae6625e4 100755
--- a/src/fsharp/TypedTreeOps.fsi
+++ b/src/fsharp/TypedTreeOps.fsi
@@ -1791,7 +1791,7 @@ val mkInvalidCastExnNewobj: TcGlobals -> ILInstr
// Construct calls to some intrinsic functions
//-------------------------------------------------------------------------
-val mkCallNewFormat : TcGlobals -> range -> TType -> TType -> TType -> TType -> TType -> Expr -> Expr
+val mkCallNewFormat: TcGlobals -> range -> TType -> TType -> TType -> TType -> TType -> formatStringExpr: Expr -> Expr
val mkCallUnbox : TcGlobals -> range -> TType -> Expr -> Expr
@@ -1991,6 +1991,9 @@ val mkCallSeqSingleton : TcGlobals -> range -> TType -> Expr -> Expr
val mkCallSeqEmpty : TcGlobals -> range -> TType -> Expr
+/// Make a call to the 'isprintf' function for string interpolation
+val mkCall_sprintf: g: TcGlobals -> m: range -> funcTy: TType -> fmtExpr: Expr -> fillExprs: Expr list -> Expr
+
val mkILAsmCeq : TcGlobals -> range -> Expr -> Expr -> Expr
val mkILAsmClt : TcGlobals -> range -> Expr -> Expr -> Expr
diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs
index 5628483bea2..c0d60ffdbeb 100644
--- a/src/fsharp/fsi/fsi.fs
+++ b/src/fsharp/fsi/fsi.fs
@@ -1969,7 +1969,7 @@ type internal FsiStdinLexerProvider
Lexhelp.resetLexbufPos sourceFileName lexbuf
let skip = true // don't report whitespace from lexer
let defines = "INTERACTIVE"::tcConfigB.conditionalCompilationDefines
- let lexargs = mkLexargs (sourceFileName,defines, interactiveInputLightSyntaxStatus, lexResourceManager, [], errorLogger, PathMap.empty)
+ let lexargs = mkLexargs (defines, interactiveInputLightSyntaxStatus, lexResourceManager, [], errorLogger, PathMap.empty)
let tokenizer = LexFilter.LexFilter(interactiveInputLightSyntaxStatus, tcConfigB.compilingFslib, Lexer.token lexargs skip, lexbuf)
tokenizer
diff --git a/src/fsharp/lex.fsl b/src/fsharp/lex.fsl
index 1c5df82bfbd..f5679b2f585 100644
--- a/src/fsharp/lex.fsl
+++ b/src/fsharp/lex.fsl
@@ -134,19 +134,36 @@ let startString args (lexbuf: UnicodeLexing.Lexbuf) =
let buf = ByteBuffer.Create 100
let m = lexbuf.LexemeRange
let startp = lexbuf.StartPos
- let fin = (fun _m2 b s ->
- // Adjust the start-of-token mark back to the true start of the token
- lexbuf.StartPos <- startp
- if b then
- if Lexhelp.stringBufferIsBytes buf then
- BYTEARRAY (Lexhelp.stringBufferAsBytes buf)
- else (
- fail args lexbuf (FSComp.SR.lexByteArrayCannotEncode()) ()
- BYTEARRAY (Lexhelp.stringBufferAsBytes buf)
- )
- else
- STRING (Lexhelp.stringBufferAsString s))
+ let fin =
+ LexerStringFinisher (fun buf kind isPart cont ->
+ // Adjust the start-of-token mark back to the true start of the token
+ lexbuf.StartPos <- startp
+ if kind.IsByteString then
+ if kind.IsInterpolated then
+ fail args lexbuf (FSComp.SR.lexByteStringMayNotBeInterpolated()) ()
+ BYTEARRAY (Lexhelp.stringBufferAsBytes buf, cont)
+ elif Lexhelp.stringBufferIsBytes buf then
+ BYTEARRAY (Lexhelp.stringBufferAsBytes buf, cont)
+ else
+ fail args lexbuf (FSComp.SR.lexByteArrayCannotEncode()) ()
+ BYTEARRAY (Lexhelp.stringBufferAsBytes buf, cont)
+ elif kind.IsInterpolated then
+ let s = Lexhelp.stringBufferAsString buf
+ if kind.IsInterpolatedFirst then
+ if isPart then
+ INTERP_STRING_BEGIN_PART (s, cont)
+ else
+ INTERP_STRING_BEGIN_END (s, cont)
+ else
+ if isPart then
+ INTERP_STRING_PART (s, cont)
+ else
+ INTERP_STRING_END (s, cont)
+ else
+ let s = Lexhelp.stringBufferAsString buf
+ STRING (s, cont))
buf,fin,m
+
// Utility functions for processing XML documentation
@@ -525,70 +542,137 @@ rule token args skip = parse
| _ -> fail args lexbuf (FSComp.SR.lexThisUnicodeOnlyInStringLiterals()) (CHAR (char 0)) }
| "(*IF-FSHARP"
- { if not skip then (COMMENT (LexCont.Token args.ifdefStack)) else token args skip lexbuf }
+ { 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)) else token args skip lexbuf }
+ { 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)) else token args skip lexbuf }
+ { 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)) else token args skip lexbuf }
+ { 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,1,m))) else comment (1,m,args) skip lexbuf }
+ 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,m))) else mlOnly m args skip lexbuf }
+ 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
- if not skip then (STRING_TEXT (LexCont.String(args.ifdefStack,m))) else string (buf,fin,m,args) skip lexbuf }
+ { let buf, fin, m = startString args lexbuf
+
+ // Single quote in triple quote ok, others disallowed
+ match args.stringNest with
+ | (_, LexerStringStyle.TripleQuote, _) :: _ -> ()
+ | _ :: _ -> errorR(Error(FSComp.SR.lexSingleQuoteInSingleQuote(), m))
+ | [] -> ()
+
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.SingleQuote, LexerStringKind.String, m))
+ else singleQuoteString (buf, fin, m, LexerStringKind.String, args) skip lexbuf }
- | '"' '"' '"'
- { let buf,fin,m = startString args lexbuf
- if not skip then (STRING_TEXT (LexCont.TripleQuoteString(args.ifdefStack,m))) else tripleQuoteString (buf,fin,m,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))
+ | [] -> ()
+
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.TripleQuote, LexerStringKind.InterpolatedStringFirst, m))
+ else tripleQuoteString (buf, fin, m, LexerStringKind.InterpolatedStringFirst, args) skip lexbuf }
| '$' '"'
- { fail args lexbuf (FSComp.SR.lexTokenReserved()) (WHITESPACE (LexCont.Token args.ifdefStack)) }
+ { let buf,fin,m = startString args lexbuf
+
+ // Single quote in triple quote ok, others disallowed
+ match args.stringNest with
+ | (_, LexerStringStyle.TripleQuote, _) :: _ -> ()
+ | _ :: _ -> errorR(Error(FSComp.SR.lexSingleQuoteInSingleQuote(), m))
+ | _ -> ()
+
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.SingleQuote, LexerStringKind.InterpolatedStringFirst, m))
+ else singleQuoteString (buf, fin, m, LexerStringKind.InterpolatedStringFirst, 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))
+ | _ -> ()
+
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.TripleQuote, LexerStringKind.String, m))
+ else tripleQuoteString (buf, fin, m, LexerStringKind.String, args) skip lexbuf }
| '@' '"'
- { let buf,fin,m = startString args lexbuf
- if not skip then (STRING_TEXT (LexCont.VerbatimString(args.ifdefStack,m))) else verbatimString (buf,fin,m,args) skip lexbuf }
+ { let buf, fin, m = startString args lexbuf
+
+ // Single quote in triple quote ok, others disallowed
+ match args.stringNest with
+ | (_, LexerStringStyle.TripleQuote, _) :: _ -> ()
+ | _ :: _ -> errorR(Error(FSComp.SR.lexSingleQuoteInSingleQuote(), m))
+ | _ -> ()
+
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.Verbatim, LexerStringKind.String, 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
+ | (_, LexerStringStyle.TripleQuote, _) :: _ -> ()
+ | _ :: _ -> errorR(Error(FSComp.SR.lexSingleQuoteInSingleQuote(), m))
+ | _ -> ()
+
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.Verbatim, LexerStringKind.InterpolatedStringFirst, 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) }
+ else WHITESPACE (LexCont.Token(args.ifdefStack, args.stringNest)) }
| offwhite+
- { if args.lightSyntaxStatus.Status then errorR(Error(FSComp.SR.lexTabsNotAllowed(),lexbuf.LexemeRange))
- if not skip then (WHITESPACE (LexCont.Token args.ifdefStack)) else token args skip lexbuf }
+ { if args.lightStatus.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
- if not skip then (LINE_COMMENT (LexCont.SingleLineComment(args.ifdefStack,1,m))) else singleLineComment (None,1,m,args) skip lexbuf }
+ if not skip then LINE_COMMENT (LexCont.SingleLineComment(args.ifdefStack, args.stringNest, 1, m))
+ else singleLineComment (None,1,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,1,m))) else singleLineComment (Some sb,1,m,args) skip lexbuf }
+ if not skip then LINE_COMMENT (LexCont.SingleLineComment(args.ifdefStack, args.stringNest, 1, m))
+ else singleLineComment (Some sb,1,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
- if not skip then (LINE_COMMENT (LexCont.SingleLineComment(args.ifdefStack,1,m))) else singleLineComment (None,1,m,args) skip lexbuf }
+ if not skip then LINE_COMMENT (LexCont.SingleLineComment(args.ifdefStack, args.stringNest, 1, m))
+ else singleLineComment (None,1,m,args) skip lexbuf }
| newline
- { newline lexbuf; if not skip then (WHITESPACE (LexCont.Token args.ifdefStack)) else token args skip lexbuf }
+ { 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) }
@@ -613,7 +697,7 @@ rule token args skip = parse
| _ -> let text = (String.sub s start (n-start))
let lineNumber =
try int32 text
- with err -> errorR(Error(FSComp.SR.lexInvalidLineNumber(text),lexbuf.LexemeRange)); 0
+ with err -> errorR(Error(FSComp.SR.lexInvalidLineNumber(text), lexbuf.LexemeRange)); 0
lineNumber, parseWhitespaceBeforeFile n // goto the next state
and parseWhitespaceBeforeFile n =
@@ -640,7 +724,7 @@ rule token args skip = parse
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)) }
+ HASH_LINE (LexCont.Token (args.ifdefStack, args.stringNest)) }
| "<@" { checkExprOp lexbuf; LQUOTE ("<@ @>", false) }
@@ -726,11 +810,48 @@ rule token args skip = parse
| ">]" { GREATER_RBRACK }
- | "{" { LBRACE }
+ | "{"
+ {
+ match args.stringNest with
+ | [] -> ()
+ | (counter, style, 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, 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 }
- | "}" { RBRACE }
+ | "}"
+ {
+ // 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, 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, 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
+
+ | (counter, style, 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, m) :: rest
+ let cont = LexCont.Token(args.ifdefStack, args.stringNest)
+ RBRACE cont
+
+ | _ ->
+ let cont = LexCont.Token(args.ifdefStack, args.stringNest)
+ RBRACE cont
+ }
| "$" { DOLLAR }
@@ -767,21 +888,24 @@ rule token args skip = parse
| "#!" op_char*
{ // Treat shebangs like regular comments, but they are only allowed at the start of a file
let m = lexbuf.LexemeRange
- let tok = shouldStartFile args lexbuf m (0,FSComp.SR.lexHashBangMustBeFirstInFile()) (LINE_COMMENT (LexCont.SingleLineComment(args.ifdefStack,1,m)))
+ 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,args) skip lexbuf }
| "#light" anywhite*
| ("#indent" | "#light") anywhite+ "\"on\""
- { if args.lightSyntaxStatus.ExplicitlySet && args.lightSyntaxStatus.WarnOnMultipleTokens then
- warning(Error((0,"#light should only occur as the first non-comment text in an F# source file"),lexbuf.LexemeRange))
+ { if args.lightStatus.ExplicitlySet && args.lightStatus.WarnOnMultipleTokens then
+ warning(Error((0,"#light should only occur as the first non-comment text in an F# source file"), lexbuf.LexemeRange))
// TODO unreachable error above, I think? - brianmcn
- args.lightSyntaxStatus.Status <- true
- if not skip then (HASH_LIGHT (LexCont.Token args.ifdefStack)) else token args skip lexbuf }
+ args.lightStatus.Status <- true
+ if not skip then HASH_LIGHT (LexCont.Token(args.ifdefStack, args.stringNest))
+ else token args skip lexbuf }
| ("#indent" | "#light") anywhite+ "\"off\""
- { args.lightSyntaxStatus.Status <- false
+ { args.lightStatus.Status <- false
mlCompatWarning (FSComp.SR.lexIndentOffForML()) lexbuf.LexemeRange
- if not skip then (HASH_LIGHT (LexCont.Token args.ifdefStack)) else token args skip lexbuf }
+ 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
@@ -792,8 +916,15 @@ rule token args skip = parse
// Get the token; make sure it starts at zero position & return
let cont, f =
- ( if isTrue then (LexCont.EndLine(LexerEndlineContinuation.Token(args.ifdefStack)), endline (LexerEndlineContinuation.Token args.ifdefStack) args skip)
- else (LexCont.EndLine(LexerEndlineContinuation.Skip(args.ifdefStack,0,m)), endline (LexerEndlineContinuation.Skip(args.ifdefStack,0,m)) args skip) )
+ if isTrue then
+ let cont = LexCont.EndLine(args.ifdefStack, args.stringNest, LexerEndlineContinuation.Token)
+ let f = endline LexerEndlineContinuation.Token args skip
+ cont, f
+ else
+ let cont = LexCont.EndLine(args.ifdefStack, args.stringNest, LexerEndlineContinuation.Skip(0, m))
+ let f = endline (LexerEndlineContinuation.Skip(0, m)) args skip
+ cont, f
+
let tok = shouldStartLine args lexbuf m (FSComp.SR.lexHashIfMustBeFirst()) (HASH_IF(m,lexed,cont))
if not skip then tok else f lexbuf }
@@ -805,9 +936,9 @@ rule token args skip = parse
| (IfDefIf,_) :: rest ->
let m = lexbuf.LexemeRange
args.ifdefStack <- (IfDefElse,m) :: rest
- let tok = HASH_ELSE(m,lexed, LexCont.EndLine(LexerEndlineContinuation.Skip(args.ifdefStack,0,m)))
+ let tok = HASH_ELSE(m, lexed, LexCont.EndLine(args.ifdefStack, args.stringNest, LexerEndlineContinuation.Skip(0, m)))
let tok = shouldStartLine args lexbuf m (FSComp.SR.lexHashElseMustBeFirst()) tok
- if not skip then tok else endline (LexerEndlineContinuation.Skip(args.ifdefStack,0,m)) args skip lexbuf }
+ if not skip then tok else endline (LexerEndlineContinuation.Skip(0, m)) args skip lexbuf }
| anywhite* "#endif" anywhite* ("//" [^'\n''\r']*)?
{ let lexed = (lexeme lexbuf)
@@ -816,12 +947,13 @@ rule token args skip = parse
| []-> LEX_FAILURE (FSComp.SR.lexHashEndingNoMatchingIf())
| _ :: rest ->
args.ifdefStack <- rest
- let tok = HASH_ENDIF(m,lexed,LexCont.EndLine(LexerEndlineContinuation.Token(args.ifdefStack)))
+ let tok = HASH_ENDIF(m,lexed,LexCont.EndLine(args.ifdefStack, args.stringNest, LexerEndlineContinuation.Token))
let tok = shouldStartLine args lexbuf m (FSComp.SR.lexHashEndifMustBeFirst()) tok
- if not skip then tok else endline (LexerEndlineContinuation.Token(args.ifdefStack)) args skip lexbuf }
+ if not skip then tok else endline LexerEndlineContinuation.Token args skip lexbuf }
| "#if"
- { let tok = fail args lexbuf (FSComp.SR.lexHashIfMustHaveIdent()) (WHITESPACE (LexCont.Token args.ifdefStack))
+ { let tok = WHITESPACE (LexCont.Token (args.ifdefStack, args.stringNest))
+ let tok = fail args lexbuf (FSComp.SR.lexHashIfMustHaveIdent()) tok
if not skip then tok else token args skip lexbuf }
| surrogateChar surrogateChar
@@ -830,7 +962,7 @@ rule token args skip = parse
{ unexpectedChar lexbuf }
| eof
- { EOF (LexCont.Token args.ifdefStack) }
+ { EOF (LexCont.Token(args.ifdefStack, args.stringNest)) }
// Skips INACTIVE code until if finds #else / #endif matching with the #if or #else
@@ -840,10 +972,11 @@ and ifdefSkip n m args skip = parse
// If #if is the first thing on the line then increase depth, otherwise skip, because it is invalid (e.g. "(**) #if ...")
if (m.StartColumn <> 0) then
- if not skip then (INACTIVECODE (LexCont.IfDefSkip(args.ifdefStack,n,m))) else ifdefSkip n m args skip lexbuf
+ if not skip then INACTIVECODE (LexCont.IfDefSkip(args.ifdefStack, args.stringNest, n, m))
+ else ifdefSkip n m args skip lexbuf
else
- let tok = INACTIVECODE(LexCont.EndLine(LexerEndlineContinuation.Skip(args.ifdefStack,n+1,m)))
- if not skip then tok else endline (LexerEndlineContinuation.Skip(args.ifdefStack,n+1,m)) args skip lexbuf }
+ let tok = INACTIVECODE(LexCont.EndLine(args.ifdefStack, args.stringNest, LexerEndlineContinuation.Skip(n+1, m)))
+ if not skip then tok else endline (LexerEndlineContinuation.Skip(n+1, m)) args skip lexbuf }
| anywhite* "#else" anywhite* ("//" [^'\n''\r']*)?
{ let lexed = (lexeme lexbuf)
@@ -851,7 +984,8 @@ and ifdefSkip n m args skip = parse
// If #else is the first thing on the line then process it, otherwise ignore, because it is invalid (e.g. "(**) #else ...")
if (m.StartColumn <> 0) then
- if not skip then (INACTIVECODE (LexCont.IfDefSkip(args.ifdefStack,n,m))) else ifdefSkip n m args skip lexbuf
+ if not skip then INACTIVECODE (LexCont.IfDefSkip(args.ifdefStack, args.stringNest, n, m))
+ else ifdefSkip n m args skip lexbuf
elif n = 0 then
match args.ifdefStack with
| []-> LEX_FAILURE (FSComp.SR.lexHashElseNoMatchingIf())
@@ -859,9 +993,11 @@ and ifdefSkip n m args skip = parse
| (IfDefIf,_) :: rest ->
let m = lexbuf.LexemeRange
args.ifdefStack <- (IfDefElse,m) :: rest
- if not skip then (HASH_ELSE(m,lexed,LexCont.EndLine(LexerEndlineContinuation.Token(args.ifdefStack)))) else endline (LexerEndlineContinuation.Token(args.ifdefStack)) args skip lexbuf
+ if not skip then HASH_ELSE(m,lexed,LexCont.EndLine(args.ifdefStack, args.stringNest, LexerEndlineContinuation.Token))
+ else endline LexerEndlineContinuation.Token args skip lexbuf
else
- if not skip then (INACTIVECODE(LexCont.EndLine(LexerEndlineContinuation.Skip(args.ifdefStack,n,m)))) else endline (LexerEndlineContinuation.Skip(args.ifdefStack,n,m)) args skip lexbuf }
+ if not skip then INACTIVECODE(LexCont.EndLine(args.ifdefStack, args.stringNest, LexerEndlineContinuation.Skip(n, m)))
+ else endline (LexerEndlineContinuation.Skip(n, m)) args skip lexbuf }
| anywhite* "#endif" anywhite* ("//" [^'\n''\r']*)?
{ let lexed = lexeme lexbuf
@@ -869,17 +1005,19 @@ and ifdefSkip n m args skip = parse
// If #endif is the first thing on the line then process it, otherwise ignore, because it is invalid (e.g. "(**) #endif ...")
if (m.StartColumn <> 0) then
- if not skip then (INACTIVECODE (LexCont.IfDefSkip(args.ifdefStack,n,m))) else ifdefSkip n m args skip lexbuf
+ if not skip then INACTIVECODE (LexCont.IfDefSkip(args.ifdefStack, args.stringNest, n, m))
+ else ifdefSkip n m args skip lexbuf
elif n = 0 then
match args.ifdefStack with
| [] -> LEX_FAILURE (FSComp.SR.lexHashEndingNoMatchingIf())
| _ :: rest ->
args.ifdefStack <- rest
- if not skip then (HASH_ENDIF(m,lexed,LexCont.EndLine(LexerEndlineContinuation.Token(args.ifdefStack)))) else endline (LexerEndlineContinuation.Token(args.ifdefStack)) args skip lexbuf
+ if not skip then HASH_ENDIF(m,lexed,LexCont.EndLine(args.ifdefStack, args.stringNest, LexerEndlineContinuation.Token))
+ else endline LexerEndlineContinuation.Token args skip lexbuf
else
- let tok = INACTIVECODE(LexCont.EndLine(LexerEndlineContinuation.Skip(args.ifdefStack,n-1,m)))
+ let tok = INACTIVECODE(LexCont.EndLine(args.ifdefStack, args.stringNest, LexerEndlineContinuation.Skip(n-1, m)))
let tok = shouldStartLine args lexbuf m (FSComp.SR.lexWrongNestedHashEndif()) tok
- if not skip then tok else endline (LexerEndlineContinuation.Skip(args.ifdefStack,(n-1),m)) args skip lexbuf }
+ if not skip then tok else endline (LexerEndlineContinuation.Skip(n-1, m)) args skip lexbuf }
| newline
{ newline lexbuf; ifdefSkip n m args skip lexbuf }
@@ -892,10 +1030,11 @@ and ifdefSkip n m args skip = parse
| _
{ // This tries to be nice and get tokens as 'words' because VS uses this when selecting stuff
- if not skip then (INACTIVECODE (LexCont.IfDefSkip(args.ifdefStack,n,m))) else ifdefSkip n m args skip lexbuf }
+ if not skip then INACTIVECODE (LexCont.IfDefSkip(args.ifdefStack, args.stringNest, n, m))
+ else ifdefSkip n m args skip lexbuf }
| eof
- { EOF (LexCont.IfDefSkip(args.ifdefStack,n,m)) }
+ { EOF (LexCont.IfDefSkip(args.ifdefStack, args.stringNest, n, m)) }
// Called after lexing #if IDENT/#else/#endif - this checks whether there is nothing except end of line
// or end of file and then calls the lexing function specified by 'cont' - either token or ifdefSkip
@@ -903,272 +1042,424 @@ and endline cont args skip = parse
| newline
{ newline lexbuf
match cont with
- | LexerEndlineContinuation.Token(ifdefStack) -> if not skip then (WHITESPACE(LexCont.Token ifdefStack)) else token args skip lexbuf
- | LexerEndlineContinuation.Skip(ifdefStack, n, m) -> if not skip then (INACTIVECODE (LexCont.IfDefSkip(ifdefStack,n,m))) else ifdefSkip n m args skip lexbuf
+ | LexerEndlineContinuation.Token ->
+ if not skip then WHITESPACE(LexCont.Token (args.ifdefStack, args.stringNest))
+ else token args skip lexbuf
+
+ | LexerEndlineContinuation.Skip(n, m) ->
+ if not skip then INACTIVECODE (LexCont.IfDefSkip(args.ifdefStack, args.stringNest, n, m))
+ else ifdefSkip n m args skip lexbuf
}
| eof
{ match cont with
- | LexerEndlineContinuation.Token(ifdefStack) -> (EOF(LexCont.Token ifdefStack))
- | LexerEndlineContinuation.Skip(ifdefStack, n, m) -> (EOF(LexCont.IfDefSkip(ifdefStack,n,m)))
+ | LexerEndlineContinuation.Token ->
+ EOF(LexCont.Token(args.ifdefStack, args.stringNest))
+ | LexerEndlineContinuation.Skip(n, m) ->
+ EOF(LexCont.IfDefSkip(args.ifdefStack, args.stringNest, n, m))
}
| [^'\r' '\n']+
| _
- { let tok = fail args lexbuf (FSComp.SR.pplexExpectedSingleLineComment()) (WHITESPACE (LexCont.Token args.ifdefStack))
+ { let tok = WHITESPACE (LexCont.Token (args.ifdefStack, args.stringNest))
+ let tok = fail args lexbuf (FSComp.SR.pplexExpectedSingleLineComment()) tok
if not skip then tok else token args skip lexbuf }
-and string sargs skip = parse
+and singleQuoteString sargs skip = parse
| '\\' newline anywhite*
- { let (_buf,_fin,m,args) = sargs
+ { let (_buf, _fin, m, kind, args) = sargs
newline lexbuf
- if not skip then (STRING_TEXT (LexCont.String(args.ifdefStack,m))) else string sargs skip lexbuf }
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.SingleQuote, kind, m))
+ else singleQuoteString sargs skip lexbuf }
| escape_char
- { let (buf,_fin,m,args) = sargs
+ { let (buf, _fin, m, kind, args) = sargs
addByteChar buf (escape (lexeme lexbuf).[1])
- if not skip then (STRING_TEXT (LexCont.String(args.ifdefStack,m))) else string sargs skip lexbuf }
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.SingleQuote, kind, m))
+ else singleQuoteString sargs skip lexbuf }
| trigraph
- { let (buf,_fin,m,args) = sargs
+ { let (buf, _fin, m, kind, args) = sargs
let s = lexeme lexbuf
addByteChar buf (trigraph s.[1] s.[2] s.[3])
- if not skip then (STRING_TEXT (LexCont.String(args.ifdefStack,m))) else string sargs skip lexbuf }
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.SingleQuote, kind, m))
+ else singleQuoteString sargs skip lexbuf }
| hexGraphShort
- { let (buf,_fin,m,args) = sargs
+ { let (buf, _fin, m, kind, args) = sargs
addUnicodeChar buf (int (hexGraphShort (lexemeTrimLeft lexbuf 2)))
- if not skip then (STRING_TEXT (LexCont.String(args.ifdefStack,m))) else string sargs skip lexbuf }
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.SingleQuote, kind, m))
+ else singleQuoteString sargs skip lexbuf }
| unicodeGraphShort
- { let (buf,_fin,m,args) = sargs
+ { let (buf, _fin, m, kind, args) = sargs
addUnicodeChar buf (int (unicodeGraphShort (lexemeTrimLeft lexbuf 2)))
- if not skip then (STRING_TEXT (LexCont.String(args.ifdefStack,m))) else string sargs skip lexbuf }
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.SingleQuote, kind, m))
+ else singleQuoteString sargs skip lexbuf }
| unicodeGraphLong
- { let (buf,_fin,m,args) = sargs
+ { let (buf, _fin, m, kind, args) = sargs
let hexChars = lexemeTrimLeft lexbuf 2
- let result () = if not skip then (STRING_TEXT (LexCont.String(args.ifdefStack,m))) else string sargs skip lexbuf
+ let result() =
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.SingleQuote, kind, m))
+ else singleQuoteString sargs skip lexbuf
match unicodeGraphLong hexChars with
| Invalid ->
- fail args lexbuf (FSComp.SR.lexInvalidUnicodeLiteral hexChars) (result ())
+ fail args lexbuf (FSComp.SR.lexInvalidUnicodeLiteral hexChars) (result())
| SingleChar(c) ->
addUnicodeChar buf (int c)
- result ()
+ result()
| SurrogatePair(hi, lo) ->
addUnicodeChar buf (int hi)
addUnicodeChar buf (int lo)
- result () }
+ result() }
| '"'
- { let (buf,fin,_m,_args) = sargs
- let m2 = lexbuf.LexemeRange
- callStringFinisher fin buf m2 false }
+ { let (buf, fin, _m, kind, args) = sargs
+ let cont = LexCont.Token(args.ifdefStack, args.stringNest)
+ fin.Finish buf kind false cont
+ }
| '"''B'
- { let (buf,fin,_m,_args) = sargs
- let m2 = lexbuf.LexemeRange
- callStringFinisher fin buf m2 true }
+ { let (buf, fin, _m, kind, args) = sargs
+ let cont = LexCont.Token(args.ifdefStack, args.stringNest)
+ fin.Finish buf { kind with IsByteString = true } false cont
+ }
+
+ | ("{{" | "}}")
+ { let (buf, _fin, m, kind, args) = sargs
+ let s = lexeme lexbuf
+ addUnicodeString buf (if kind.IsInterpolated then s.[0..0] else s)
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.SingleQuote, kind, m))
+ else singleQuoteString sargs skip lexbuf }
+
+ | "{"
+ { let (buf, fin, m, kind, args) = sargs
+ if kind.IsInterpolated then
+ // get a new range for where the fill starts
+ let m2 = lexbuf.LexemeRange
+ args.stringNest <- (1, LexerStringStyle.SingleQuote, m2) :: args.stringNest
+ let cont = LexCont.Token(args.ifdefStack, args.stringNest)
+ fin.Finish buf kind true cont
+ else
+ addUnicodeString buf (lexeme lexbuf)
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.SingleQuote, kind, m))
+ else singleQuoteString sargs skip lexbuf
+ }
+
+ | "}"
+ { let (buf, _fin, m, kind, args) = sargs
+ let result() =
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.SingleQuote, kind, m))
+ else singleQuoteString sargs skip lexbuf
+ if kind.IsInterpolated then
+ fail args lexbuf (FSComp.SR.lexRBraceInInterpolatedString()) (result())
+ else
+ addUnicodeString buf (lexeme lexbuf)
+ (result())
+ }
| newline
- { let (buf,_fin,m,args) = sargs
+ { let (buf, _fin, m, kind, args) = sargs
newline lexbuf
addUnicodeString buf (lexeme lexbuf)
- if not skip then (STRING_TEXT (LexCont.String(args.ifdefStack,m))) else string sargs skip lexbuf }
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.SingleQuote, kind, m))
+ else singleQuoteString sargs skip lexbuf }
| ident
- { let (buf,_fin,m,args) = sargs
+ { let (buf, _fin, m, kind, args) = sargs
addUnicodeString buf (lexeme lexbuf)
- if not skip then (STRING_TEXT (LexCont.String(args.ifdefStack,m))) else string sargs skip lexbuf }
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.SingleQuote, kind, m))
+ else singleQuoteString sargs skip lexbuf }
| integer
| xinteger
- { let (buf,_fin,m,args) = sargs
+ { let (buf, _fin, m, kind, args) = sargs
addUnicodeString buf (lexeme lexbuf)
- if not skip then (STRING_TEXT (LexCont.String(args.ifdefStack,m))) else string sargs skip lexbuf }
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.SingleQuote, kind, m))
+ else singleQuoteString sargs skip lexbuf }
| anywhite +
- { let (buf,_fin,m,args) = sargs
+ { let (buf, _fin, m, kind, args) = sargs
addUnicodeString buf (lexeme lexbuf)
- if not skip then (STRING_TEXT (LexCont.String(args.ifdefStack,m))) else string sargs skip lexbuf }
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.SingleQuote, kind, m))
+ else singleQuoteString sargs skip lexbuf }
| eof
- { let (_buf,_fin,m,args) = sargs
- EOF (LexCont.String(args.ifdefStack,m)) }
+ { let (_buf, _fin, m, kind, args) = sargs
+ EOF (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.SingleQuote, kind, m)) }
| surrogateChar surrogateChar // surrogate code points always come in pairs
| _
- { let (buf,_fin,m,args) = sargs
+ { let (buf, _fin, m, kind, args) = sargs
addUnicodeString buf (lexeme lexbuf)
- if not skip then (STRING_TEXT (LexCont.String(args.ifdefStack,m))) else string sargs skip lexbuf }
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.SingleQuote, kind, m))
+ else singleQuoteString sargs skip lexbuf }
and verbatimString sargs skip = parse
| '"' '"'
- { let (buf,_fin,m,args) = sargs
+ { let (buf, _fin, m, kind, args) = sargs
addByteChar buf '\"'
- if not skip then (STRING_TEXT (LexCont.VerbatimString(args.ifdefStack,m))) else verbatimString sargs skip lexbuf }
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.Verbatim, kind, m))
+ else verbatimString sargs skip lexbuf }
| '"'
- { let (buf,fin,_m,_args) = sargs
- let m2 = lexbuf.LexemeRange
- callStringFinisher fin buf m2 false }
+ { let (buf, fin, _m, kind, args) = sargs
+ let cont = LexCont.Token(args.ifdefStack, args.stringNest)
+ fin.Finish buf kind false cont
+ }
| '"''B'
- { let (buf,fin,_m,_args) = sargs
- let m2 = lexbuf.LexemeRange
- callStringFinisher fin buf m2 true }
+ { let (buf, fin, _m, kind, args) = sargs
+ let cont = LexCont.Token(args.ifdefStack, args.stringNest)
+ fin.Finish buf { kind with IsByteString = true } false cont
+ }
| newline
- { let (buf,_fin,m,args) = sargs
+ { let (buf, _fin, m, kind, args) = sargs
newline lexbuf
addUnicodeString buf (lexeme lexbuf)
- if not skip then (STRING_TEXT (LexCont.VerbatimString(args.ifdefStack,m))) else verbatimString sargs skip lexbuf }
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.Verbatim, kind, m))
+ else verbatimString sargs skip lexbuf }
+
+ | ("{{" | "}}")
+ { let (buf, _fin, m, kind, args) = sargs
+ let s = lexeme lexbuf
+ addUnicodeString buf (if kind.IsInterpolated then s.[0..0] else s)
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.Verbatim, kind, m))
+ else verbatimString sargs skip lexbuf }
+
+ | "{"
+ { let (buf, fin, m, kind, args) = sargs
+ if kind.IsInterpolated then
+ // get a new range for where the fill starts
+ let m2 = lexbuf.LexemeRange
+ args.stringNest <- (1, LexerStringStyle.Verbatim, m2) :: args.stringNest
+ let cont = LexCont.Token(args.ifdefStack, args.stringNest)
+ fin.Finish buf kind true cont
+ else
+ addUnicodeString buf (lexeme lexbuf)
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.Verbatim, kind, m))
+ else verbatimString sargs skip lexbuf
+ }
+
+ | "}"
+ { let (buf, _fin, m, kind, args) = sargs
+ let result() =
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.Verbatim, kind, m))
+ else verbatimString sargs skip lexbuf
+ if kind.IsInterpolated then
+ fail args lexbuf (FSComp.SR.lexRBraceInInterpolatedString()) (result())
+ else
+ addUnicodeString buf (lexeme lexbuf)
+ (result())
+ }
| ident
- { let (buf,_fin,m,args) = sargs
+ { let (buf, _fin, m, kind, args) = sargs
addUnicodeString buf (lexeme lexbuf)
- if not skip then (STRING_TEXT (LexCont.VerbatimString(args.ifdefStack,m))) else verbatimString sargs skip lexbuf }
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.Verbatim, kind, m))
+ else verbatimString sargs skip lexbuf }
| integer
| xinteger
- { let (buf,_fin,m,args) = sargs
+ { let (buf, _fin, m, kind, args) = sargs
addUnicodeString buf (lexeme lexbuf)
- if not skip then (STRING_TEXT (LexCont.VerbatimString(args.ifdefStack,m))) else verbatimString sargs skip lexbuf }
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.Verbatim, kind, m))
+ else verbatimString sargs skip lexbuf }
| anywhite +
- { let (buf,_fin,m,args) = sargs
+ { let (buf, _fin, m, kind, args) = sargs
addUnicodeString buf (lexeme lexbuf)
- if not skip then (STRING_TEXT (LexCont.VerbatimString(args.ifdefStack,m))) else verbatimString sargs skip lexbuf }
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.Verbatim, kind, m))
+ else verbatimString sargs skip lexbuf }
| eof
- { let (_buf,_fin,m,args) = sargs
- EOF (LexCont.VerbatimString(args.ifdefStack,m)) }
+ { let (_buf, _fin, m, kind, args) = sargs
+ EOF (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.Verbatim, kind, m)) }
+
| surrogateChar surrogateChar // surrogate code points always come in pairs
| _
- { let (buf,_fin,m,args) = sargs
+ { let (buf, _fin, m, kind, args) = sargs
addUnicodeString buf (lexeme lexbuf)
- if not skip then (STRING_TEXT (LexCont.VerbatimString(args.ifdefStack,m))) else verbatimString sargs skip lexbuf }
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.Verbatim, kind, m))
+ else verbatimString sargs skip lexbuf }
and tripleQuoteString sargs skip = parse
| '"' '"' '"'
- { let (buf,fin,_m,_args) = sargs
- let m2 = lexbuf.LexemeRange
- callStringFinisher fin buf m2 false }
+ { let (buf, fin, _m, kind, args) = sargs
+ let cont = LexCont.Token(args.ifdefStack, args.stringNest)
+ fin.Finish buf kind false cont }
| newline
- { let (buf,_fin,m,args) = sargs
+ { let (buf, _fin, m, kind, args) = sargs
newline lexbuf
addUnicodeString buf (lexeme lexbuf)
- if not skip then (STRING_TEXT (LexCont.TripleQuoteString(args.ifdefStack,m))) else tripleQuoteString sargs skip lexbuf }
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.TripleQuote, kind, m))
+ else tripleQuoteString sargs skip lexbuf }
// The rest is to break into pieces to allow double-click-on-word and other such things
| ident
- { let (buf,_fin,m,args) = sargs
+ { let (buf, _fin, m, kind, args) = sargs
addUnicodeString buf (lexeme lexbuf)
- if not skip then (STRING_TEXT (LexCont.TripleQuoteString(args.ifdefStack,m))) else tripleQuoteString sargs skip lexbuf }
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.TripleQuote, kind, m))
+ else tripleQuoteString sargs skip lexbuf }
| integer
| xinteger
- { let (buf,_fin,m,args) = sargs
+ { let (buf, _fin, m, kind, args) = sargs
addUnicodeString buf (lexeme lexbuf)
- if not skip then (STRING_TEXT (LexCont.TripleQuoteString(args.ifdefStack,m))) else tripleQuoteString sargs skip lexbuf }
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.TripleQuote, kind, m))
+ else tripleQuoteString sargs skip lexbuf }
| anywhite +
- { let (buf,_fin,m,args) = sargs
+ { let (buf, _fin, m, kind, args) = sargs
addUnicodeString buf (lexeme lexbuf)
- if not skip then (STRING_TEXT (LexCont.TripleQuoteString(args.ifdefStack,m))) else tripleQuoteString sargs skip lexbuf }
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.TripleQuote, kind, m))
+ else tripleQuoteString sargs skip lexbuf }
+
+ | ("{{" | "}}")
+ { let (buf, _fin, m, kind, args) = sargs
+ let s = lexeme lexbuf
+ addUnicodeString buf (if kind.IsInterpolated then s.[0..0] else s)
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.TripleQuote, kind, m))
+ else tripleQuoteString sargs skip lexbuf }
+
+ | "{"
+ { let (buf, fin, m, kind, args) = sargs
+ if kind.IsInterpolated then
+ // get a new range for where the fill starts
+ let m2 = lexbuf.LexemeRange
+ args.stringNest <- (1, LexerStringStyle.TripleQuote, m2) :: args.stringNest
+ let cont = LexCont.Token(args.ifdefStack, args.stringNest)
+ fin.Finish buf kind true cont
+ else
+ addUnicodeString buf (lexeme lexbuf)
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.TripleQuote, kind, m))
+ else tripleQuoteString sargs skip lexbuf
+ }
+
+ | "}"
+ { let (buf, _fin, m, kind, args) = sargs
+ let result() =
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.TripleQuote, kind, m))
+ else tripleQuoteString sargs skip lexbuf
+ if kind.IsInterpolated then
+ fail args lexbuf (FSComp.SR.lexRBraceInInterpolatedString()) (result())
+ else
+ addUnicodeString buf (lexeme lexbuf)
+ (result())
+ }
| eof
- { let (_buf,_fin,m,args) = sargs
- EOF (LexCont.TripleQuoteString(args.ifdefStack,m)) }
+ { let (_buf, _fin, m, kind, args) = sargs
+ EOF (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.TripleQuote, kind, m)) }
| surrogateChar surrogateChar // surrogate code points always come in pairs
| _
- { let (buf,_fin,m,args) = sargs
+ { let (buf, _fin, m, kind, args) = sargs
addUnicodeString buf (lexeme lexbuf)
- if not skip then (STRING_TEXT (LexCont.TripleQuoteString(args.ifdefStack,m))) else tripleQuoteString sargs skip lexbuf }
+ if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, LexerStringStyle.TripleQuote, kind, m))
+ else tripleQuoteString sargs skip lexbuf }
// Parsing single-line comment - we need to split it into words for Visual Studio IDE
and singleLineComment cargs skip = parse
| newline
- { let buff,_n,_m,args = cargs
+ { let buff,_n, _m, args = cargs
trySaveXmlDoc lexbuf buff
newline lexbuf
// Saves the documentation (if we're collecting any) into a buffer-local variable.
- if not skip then (LINE_COMMENT (LexCont.Token args.ifdefStack)) else token args skip lexbuf }
+ if not skip then LINE_COMMENT (LexCont.Token(args.ifdefStack, args.stringNest))
+ else token args skip lexbuf }
| eof
- { let _, _n,_m,args = cargs
+ { let _, _n, _m, args = cargs
// NOTE: it is legal to end a file with this comment, so we'll return EOF as a token
- EOF (LexCont.Token args.ifdefStack) }
+ EOF (LexCont.Token(args.ifdefStack, args.stringNest)) }
| [^ ' ' '\n' '\r' ]+
| anywhite+
- { let buff,n,m,args = cargs
+ { let buff, n, m, args = cargs
// Append the current token to the XML documentation if we're collecting it
tryAppendXmlDoc buff (lexeme lexbuf)
- if not skip then (LINE_COMMENT (LexCont.SingleLineComment(args.ifdefStack,n,m))) else singleLineComment (buff,n,m,args) skip lexbuf }
+ if not skip then LINE_COMMENT (LexCont.SingleLineComment(args.ifdefStack, args.stringNest, n, m))
+ else singleLineComment (buff, n, m, args) skip lexbuf }
| surrogateChar surrogateChar
- | _ { let _, _n,_m,args = cargs
- if not skip then (LINE_COMMENT (LexCont.Token args.ifdefStack)) else token args skip lexbuf }
+ | _ { let _, _n, _m, args = cargs
+ if not skip then LINE_COMMENT (LexCont.Token(args.ifdefStack, args.stringNest))
+ else token args skip lexbuf }
and comment cargs skip = parse
| char
- { let n,m,args = cargs
- if not skip then (COMMENT (LexCont.Comment(args.ifdefStack,n,m))) else comment (n,m,args) skip lexbuf }
+ { let n, m, args = cargs
+ if not skip then COMMENT (LexCont.Comment(args.ifdefStack, args.stringNest, n, m))
+ else comment (n, m, args) skip lexbuf }
| '"'
- { let n,m,args = cargs
- if not skip then (COMMENT (LexCont.StringInComment(args.ifdefStack,n,m))) else stringInComment n m args skip lexbuf }
+ { let n, m, args = cargs
+ if not skip then COMMENT (LexCont.StringInComment(args.ifdefStack, args.stringNest, LexerStringStyle.SingleQuote, n, m))
+ else stringInComment n m args skip lexbuf }
| '"' '"' '"'
- { let n,m,args = cargs
- if not skip then (COMMENT (LexCont.TripleQuoteStringInComment(args.ifdefStack,n,m))) else tripleQuoteStringInComment n m args skip lexbuf }
+ { let n, m, args = cargs
+ if not skip then COMMENT (LexCont.StringInComment(args.ifdefStack, args.stringNest, LexerStringStyle.TripleQuote, n, m))
+ else tripleQuoteStringInComment n m args skip lexbuf }
| '@' '"'
- { let n,m,args = cargs
- if not skip then (COMMENT (LexCont.VerbatimStringInComment(args.ifdefStack,n,m))) else verbatimStringInComment n m args skip lexbuf }
+ { let n, m, args = cargs
+ if not skip then COMMENT (LexCont.StringInComment(args.ifdefStack, args.stringNest, LexerStringStyle.Verbatim, n, m))
+ else verbatimStringInComment n m args skip lexbuf }
| "(*)"
- { let n,m,args = cargs
- if not skip then (COMMENT (LexCont.Comment(args.ifdefStack,n,m))) else comment cargs skip lexbuf }
+ { let n, m, args = cargs
+ if not skip then COMMENT (LexCont.Comment(args.ifdefStack, args.stringNest, n, m))
+ else comment cargs skip lexbuf }
| '(' '*'
- { let n,m,args = cargs
- if not skip then (COMMENT (LexCont.Comment(args.ifdefStack,n+1,m))) else comment (n+1,m,args) skip lexbuf }
+ { let n, m, args = cargs
+ if not skip then COMMENT (LexCont.Comment(args.ifdefStack, args.stringNest, n+1, m))
+ else comment (n+1,m,args) skip lexbuf }
| newline
- { let n,m,args = cargs
+ { let n, m, args = cargs
newline lexbuf
- if not skip then (COMMENT (LexCont.Comment(args.ifdefStack,n,m))) else comment cargs skip lexbuf }
+ if not skip then COMMENT (LexCont.Comment(args.ifdefStack, args.stringNest, n, m))
+ else comment cargs skip lexbuf }
| "*)"
{
- let n,m,args = cargs
- if n > 1 then if not skip then (COMMENT (LexCont.Comment(args.ifdefStack,n-1,m))) else comment (n-1,m,args) skip lexbuf
- else if not skip then (COMMENT (LexCont.Token args.ifdefStack)) else token args skip lexbuf }
+ let n, m, args = cargs
+ if n > 1 then
+ if not skip then COMMENT (LexCont.Comment(args.ifdefStack, args.stringNest, n-1, m))
+ else comment (n-1,m,args) skip lexbuf
+ else
+ if not skip then COMMENT (LexCont.Token(args.ifdefStack, args.stringNest))
+ else token args skip lexbuf }
| anywhite+
| [^ '\'' '(' '*' '\n' '\r' '"' ')' '@' ' ' '\t' ]+
- { let n,m,args = cargs
- if not skip then (COMMENT (LexCont.Comment(args.ifdefStack,n,m))) else comment cargs skip lexbuf }
+ { let n, m, args = cargs
+ if not skip then COMMENT (LexCont.Comment(args.ifdefStack, args.stringNest, n, m))
+ else comment cargs skip lexbuf }
| eof
- { let n,m,args = cargs
- EOF (LexCont.Comment(args.ifdefStack,n,m)) }
+ { let n, m, args = cargs
+ EOF (LexCont.Comment(args.ifdefStack, args.stringNest, n, m)) }
| surrogateChar surrogateChar
- | _ { let n,m,args = cargs
- if not skip then (COMMENT (LexCont.Comment(args.ifdefStack,n,m))) else comment (n,m,args) skip lexbuf }
+ | _ { let n, m, args = cargs
+ if not skip then COMMENT (LexCont.Comment(args.ifdefStack, args.stringNest, n, m))
+ else comment (n, m, args) skip lexbuf }
and stringInComment n m args skip = parse
// Follow string lexing, skipping tokens until it finishes
| '\\' newline anywhite*
{ newline lexbuf
- if not skip then (COMMENT (LexCont.StringInComment(args.ifdefStack,n,m))) else stringInComment n m args skip lexbuf }
+ if not skip then COMMENT (LexCont.StringInComment(args.ifdefStack, args.stringNest, LexerStringStyle.SingleQuote, n, m))
+ else stringInComment n m args skip lexbuf }
| escape_char
| trigraph
@@ -1179,93 +1470,113 @@ and stringInComment n m args skip = parse
| integer
| xinteger
| anywhite +
- { if not skip then (COMMENT (LexCont.StringInComment(args.ifdefStack,n,m))) else stringInComment n m args skip lexbuf }
+ { if not skip then COMMENT (LexCont.StringInComment(args.ifdefStack, args.stringNest, LexerStringStyle.SingleQuote, n, m))
+ else stringInComment n m args skip lexbuf }
| '"'
- { if not skip then (COMMENT (LexCont.Comment(args.ifdefStack,n,m))) else comment (n,m,args) skip lexbuf }
+ { if not skip then COMMENT (LexCont.Comment(args.ifdefStack, args.stringNest, n, m))
+ else comment (n, m, args) skip lexbuf }
| newline
{ newline lexbuf
- if not skip then (COMMENT (LexCont.StringInComment(args.ifdefStack,n,m))) else stringInComment n m args skip lexbuf }
+ if not skip then COMMENT (LexCont.StringInComment(args.ifdefStack, args.stringNest, LexerStringStyle.SingleQuote, n, m))
+ else stringInComment n m args skip lexbuf }
| eof
- { EOF (LexCont.StringInComment(args.ifdefStack,n,m)) }
+ { EOF (LexCont.StringInComment(args.ifdefStack, args.stringNest, LexerStringStyle.SingleQuote, n, m)) }
| surrogateChar surrogateChar
| _
- { if not skip then (COMMENT (LexCont.StringInComment(args.ifdefStack,n,m))) else stringInComment n m args skip lexbuf }
+ { if not skip then COMMENT (LexCont.StringInComment(args.ifdefStack, args.stringNest, LexerStringStyle.SingleQuote, n, m))
+ else stringInComment n m args skip lexbuf }
and verbatimStringInComment n m args skip = parse
// Follow verbatimString lexing, in short, skip double-quotes and other chars until we hit a single quote
| '"' '"'
- { if not skip then (COMMENT (LexCont.VerbatimStringInComment(args.ifdefStack,n,m))) else verbatimStringInComment n m args skip lexbuf }
+ { if not skip then COMMENT (LexCont.StringInComment(args.ifdefStack, args.stringNest, LexerStringStyle.Verbatim, n, m))
+ else verbatimStringInComment n m args skip lexbuf }
| '"'
- { if not skip then (COMMENT (LexCont.Comment(args.ifdefStack,n,m))) else comment (n,m,args) skip lexbuf }
+ { if not skip then COMMENT (LexCont.Comment(args.ifdefStack, args.stringNest, n, m))
+ else comment (n, m, args) skip lexbuf }
| ident
| integer
| xinteger
| anywhite +
- { if not skip then (COMMENT (LexCont.VerbatimStringInComment(args.ifdefStack,n,m))) else verbatimStringInComment n m args skip lexbuf }
+ { if not skip then COMMENT (LexCont.StringInComment(args.ifdefStack, args.stringNest, LexerStringStyle.Verbatim, n, m))
+ else verbatimStringInComment n m args skip lexbuf }
| newline
{ newline lexbuf
- if not skip then (COMMENT (LexCont.VerbatimStringInComment(args.ifdefStack,n,m))) else verbatimStringInComment n m args skip lexbuf }
+ if not skip then COMMENT (LexCont.StringInComment(args.ifdefStack, args.stringNest, LexerStringStyle.Verbatim, n, m))
+ else verbatimStringInComment n m args skip lexbuf }
| eof
- { EOF (LexCont.VerbatimStringInComment(args.ifdefStack,n,m)) }
+ { EOF (LexCont.StringInComment(args.ifdefStack, args.stringNest, LexerStringStyle.Verbatim, n, m)) }
| surrogateChar surrogateChar
| _
- { if not skip then (COMMENT (LexCont.VerbatimStringInComment(args.ifdefStack,n,m))) else verbatimStringInComment n m args skip lexbuf }
+ { if not skip then COMMENT (LexCont.StringInComment(args.ifdefStack, args.stringNest, LexerStringStyle.Verbatim, n, m))
+ else verbatimStringInComment n m args skip lexbuf }
and tripleQuoteStringInComment n m args skip = parse
// Follow tripleQuoteString lexing
| '"' '"' '"'
- { if not skip then (COMMENT (LexCont.Comment(args.ifdefStack,n,m))) else comment (n,m,args) skip lexbuf }
+ { if not skip then COMMENT (LexCont.Comment(args.ifdefStack, args.stringNest, n, m))
+ else comment (n, m, args) skip lexbuf }
| ident
| integer
| xinteger
| anywhite +
- { if not skip then (COMMENT (LexCont.TripleQuoteStringInComment(args.ifdefStack,n,m))) else tripleQuoteStringInComment n m args skip lexbuf }
+ { if not skip then COMMENT (LexCont.StringInComment(args.ifdefStack, args.stringNest, LexerStringStyle.TripleQuote, n, m))
+ else tripleQuoteStringInComment n m args skip lexbuf }
| newline
{ newline lexbuf
- if not skip then (COMMENT (LexCont.TripleQuoteStringInComment(args.ifdefStack,n,m))) else tripleQuoteStringInComment n m args skip lexbuf }
+ if not skip then COMMENT (LexCont.StringInComment(args.ifdefStack, args.stringNest, LexerStringStyle.TripleQuote, n, m))
+ else tripleQuoteStringInComment n m args skip lexbuf }
| eof
- { EOF (LexCont.TripleQuoteStringInComment(args.ifdefStack,n,m)) }
+ { EOF (LexCont.StringInComment(args.ifdefStack, args.stringNest, LexerStringStyle.TripleQuote, n, m)) }
| surrogateChar surrogateChar
| _
- { if not skip then (COMMENT (LexCont.TripleQuoteStringInComment(args.ifdefStack,n,m))) else tripleQuoteStringInComment n m args skip lexbuf }
+ { if not skip then COMMENT (LexCont.StringInComment(args.ifdefStack, args.stringNest, LexerStringStyle.TripleQuote, n, m))
+ else tripleQuoteStringInComment n m args skip lexbuf }
and mlOnly m args skip = parse
| "\""
{ let buf = ByteBuffer.Create 100
let m2 = lexbuf.LexemeRange
- let _ = string (buf,defaultStringFinisher,m2,args) skip lexbuf
- if not skip then (COMMENT (LexCont.MLOnly(args.ifdefStack,m))) else mlOnly m args skip lexbuf }
+ let _ = singleQuoteString (buf, LexerStringFinisher.Default, m2, LexerStringKind.String, args) skip lexbuf
+ if not skip then COMMENT (LexCont.MLOnly(args.ifdefStack, args.stringNest, m))
+ else mlOnly m args skip lexbuf }
| newline
- { newline lexbuf; if not skip then (COMMENT (LexCont.MLOnly(args.ifdefStack,m))) else mlOnly m args skip lexbuf }
+ { newline lexbuf
+ if not skip then COMMENT (LexCont.MLOnly(args.ifdefStack, args.stringNest, m))
+ else mlOnly m args skip lexbuf }
| "(*ENDIF-CAML*)"
- { if not skip then (COMMENT (LexCont.Token args.ifdefStack)) else token args skip lexbuf }
+ { if not skip then COMMENT (LexCont.Token(args.ifdefStack, args.stringNest))
+ else token args skip lexbuf }
| "(*ENDIF-OCAML*)"
- { if not skip then (COMMENT (LexCont.Token args.ifdefStack)) else token args skip lexbuf }
+ { if not skip then COMMENT (LexCont.Token(args.ifdefStack, args.stringNest))
+ else token args skip lexbuf }
| [^ '(' '"' '\n' '\r' ]+
- { if not skip then (COMMENT (LexCont.MLOnly(args.ifdefStack,m))) else mlOnly m args skip lexbuf }
+ { if not skip then COMMENT (LexCont.MLOnly(args.ifdefStack, args.stringNest, m))
+ else mlOnly m args skip lexbuf }
| eof
- { EOF (LexCont.MLOnly(args.ifdefStack,m)) }
+ { EOF (LexCont.MLOnly(args.ifdefStack, args.stringNest, m)) }
| surrogateChar surrogateChar
| _
- { if not skip then (COMMENT (LexCont.MLOnly(args.ifdefStack,m))) else mlOnly m args skip lexbuf }
+ { if not skip then COMMENT (LexCont.MLOnly(args.ifdefStack, args.stringNest, m))
+ else mlOnly m args skip lexbuf }
diff --git a/src/fsharp/lexhelp.fs b/src/fsharp/lexhelp.fs
index 707d7f0b499..0600da601cf 100644
--- a/src/fsharp/lexhelp.fs
+++ b/src/fsharp/lexhelp.fs
@@ -49,14 +49,17 @@ type LexResourceManager(?capacity: int) =
res
/// Lexer parameters
-type lexargs =
- { defines: string list
- mutable ifdefStack: LexerIfdefStack
+type LexArgs =
+ {
+ defines: string list
resourceManager: LexResourceManager
- lightSyntaxStatus : LightSyntaxStatus
errorLogger: ErrorLogger
applyLineDirectives: bool
- pathMap: PathMap }
+ pathMap: PathMap
+ mutable ifdefStack: LexerIfdefStack
+ mutable lightStatus : LightSyntaxStatus
+ mutable stringNest: LexerInterpolatedStringNesting
+ }
/// possible results of lexing a long Unicode escape sequence in a string literal, e.g. "\U0001F47D",
/// "\U000000E7", or "\UDEADBEEF" returning SurrogatePair, SingleChar, or Invalid, respectively
@@ -65,14 +68,17 @@ type LongUnicodeLexResult =
| SingleChar of uint16
| Invalid
-let mkLexargs (_filename, defines, lightSyntaxStatus, resourceManager, ifdefStack, errorLogger, pathMap:PathMap) =
- { defines = defines
+let mkLexargs (defines, lightStatus, resourceManager, ifdefStack, errorLogger, pathMap:PathMap) =
+ {
+ defines = defines
ifdefStack= ifdefStack
- lightSyntaxStatus=lightSyntaxStatus
+ lightStatus=lightStatus
resourceManager=resourceManager
errorLogger=errorLogger
applyLineDirectives=true
- pathMap=pathMap }
+ stringNest = []
+ pathMap=pathMap
+ }
/// Register the lexbuf and call the given function
let reusingLexbufForParsing lexbuf f =
@@ -95,20 +101,8 @@ let usingLexbufForParsing (lexbuf:UnicodeLexing.Lexbuf, filename) f =
// Functions to manipulate lexer transient state
//-----------------------------------------------------------------------
-let defaultStringFinisher = (fun _endm _b s -> STRING (Encoding.Unicode.GetString(s, 0, s.Length)))
-
-let callStringFinisher fin (buf: ByteBuffer) endm b = fin endm b (buf.Close())
-
-let addUnicodeString (buf: ByteBuffer) (x:string) = buf.EmitBytes (Encoding.Unicode.GetBytes x)
-
-let addIntChar (buf: ByteBuffer) c =
- buf.EmitIntAsByte (c % 256)
- buf.EmitIntAsByte (c / 256)
-
-let addUnicodeChar buf c = addIntChar buf (int c)
-let addByteChar buf (c:char) = addIntChar buf (int32 c % 256)
-
-let stringBufferAsString (buf: byte[]) =
+let stringBufferAsString (buf: ByteBuffer) =
+ let buf = buf.Close()
if buf.Length % 2 <> 0 then failwith "Expected even number of bytes"
let chars : char[] = Array.zeroCreate (buf.Length/2)
for i = 0 to (buf.Length/2) - 1 do
@@ -127,6 +121,44 @@ let stringBufferAsBytes (buf: ByteBuffer) =
let bytes = buf.Close()
Array.init (bytes.Length / 2) (fun i -> bytes.[i*2])
+type LexerStringFinisher =
+ | LexerStringFinisher of (ByteBuffer -> LexerStringKind -> bool -> LexerContinuation -> token)
+
+ member fin.Finish (buf: ByteBuffer) kind isPart cont =
+ let (LexerStringFinisher f) = fin
+ f buf kind isPart cont
+
+ static member Default =
+ LexerStringFinisher (fun buf kind isPart cont ->
+ if kind.IsInterpolated then
+ let s = stringBufferAsString buf
+ if kind.IsInterpolatedFirst then
+ if isPart then
+ INTERP_STRING_BEGIN_PART (s, cont)
+ else
+ INTERP_STRING_BEGIN_END (s, cont)
+ else
+ if isPart then
+ INTERP_STRING_PART (s, cont)
+ else
+ INTERP_STRING_END (s, cont)
+ elif kind.IsByteString then
+ BYTEARRAY (stringBufferAsBytes buf, cont)
+ else
+ STRING (stringBufferAsString buf, cont)
+ )
+
+let addUnicodeString (buf: ByteBuffer) (x:string) =
+ buf.EmitBytes (Encoding.Unicode.GetBytes x)
+
+let addIntChar (buf: ByteBuffer) c =
+ buf.EmitIntAsByte (c % 256)
+ buf.EmitIntAsByte (c / 256)
+
+let addUnicodeChar buf c = addIntChar buf (int c)
+
+let addByteChar buf (c:char) = addIntChar buf (int32 c % 256)
+
/// Sanity check that high bytes are zeros. Further check each low byte <= 127
let stringBufferIsBytes (buf: ByteBuffer) =
let bytes = buf.Close()
diff --git a/src/fsharp/lexhelp.fsi b/src/fsharp/lexhelp.fsi
index 2bed4e89c60..c6de1a90395 100644
--- a/src/fsharp/lexhelp.fsi
+++ b/src/fsharp/lexhelp.fsi
@@ -8,11 +8,14 @@ open Internal.Utilities.Text
open FSharp.Compiler
open FSharp.Compiler.AbstractIL.Internal
open FSharp.Compiler.ErrorLogger
+open FSharp.Compiler.Parser
open FSharp.Compiler.ParseHelpers
open FSharp.Compiler.Range
val stdinMockFilename: string
+/// Lexer args: status of #light processing. Mutated when a #light
+/// directive is processed. This alters the behaviour of the lexfilter.
[]
type LightSyntaxStatus =
new: initial:bool * warn: bool -> LightSyntaxStatus
@@ -25,14 +28,18 @@ type LightSyntaxStatus =
type LexResourceManager =
new: ?capacity: int -> LexResourceManager
-type lexargs =
- { defines: string list
- mutable ifdefStack: LexerIfdefStack
+/// The context applicable to all lexing functions (tokens, strings etc.)
+type LexArgs =
+ {
+ defines: string list
resourceManager: LexResourceManager
- lightSyntaxStatus: LightSyntaxStatus
errorLogger: ErrorLogger
applyLineDirectives: bool
- pathMap: PathMap }
+ pathMap: PathMap
+ mutable ifdefStack: LexerIfdefStack
+ mutable lightStatus : LightSyntaxStatus
+ mutable stringNest: LexerInterpolatedStringNesting
+ }
type LongUnicodeLexResult =
| SurrogatePair of uint16 * uint16
@@ -41,15 +48,18 @@ type LongUnicodeLexResult =
val resetLexbufPos: string -> UnicodeLexing.Lexbuf -> unit
-val mkLexargs: 'a * string list * LightSyntaxStatus * LexResourceManager * LexerIfdefStack * ErrorLogger * PathMap -> lexargs
+val mkLexargs: string list * LightSyntaxStatus * LexResourceManager * LexerIfdefStack * ErrorLogger * PathMap -> LexArgs
val reusingLexbufForParsing: UnicodeLexing.Lexbuf -> (unit -> 'a) -> 'a
val usingLexbufForParsing: UnicodeLexing.Lexbuf * string -> (UnicodeLexing.Lexbuf -> 'a) -> 'a
-val defaultStringFinisher: 'a -> 'b -> byte[] -> Parser.token
+type LexerStringFinisher =
+ | LexerStringFinisher of (ByteBuffer -> LexerStringKind -> bool -> LexerContinuation -> token)
+
+ member Finish: buf: ByteBuffer -> kind: LexerStringKind -> isInterpolatedStringPart: bool -> cont: LexerContinuation -> token
-val callStringFinisher: ('a -> 'b -> byte[] -> 'c) -> ByteBuffer -> 'a -> 'b -> 'c
+ static member Default: LexerStringFinisher
val addUnicodeString: ByteBuffer -> string -> unit
@@ -57,7 +67,7 @@ val addUnicodeChar: ByteBuffer -> int -> unit
val addByteChar: ByteBuffer -> char -> unit
-val stringBufferAsString: byte[] -> string
+val stringBufferAsString: ByteBuffer -> string
val stringBufferAsBytes: ByteBuffer -> byte[]
@@ -85,9 +95,9 @@ exception IndentationProblem of string * Range.range
module Keywords =
- val KeywordOrIdentifierToken: lexargs -> UnicodeLexing.Lexbuf -> string -> Parser.token
+ val KeywordOrIdentifierToken: LexArgs -> UnicodeLexing.Lexbuf -> string -> token
- val IdentifierToken: lexargs -> UnicodeLexing.Lexbuf -> string -> Parser.token
+ val IdentifierToken: LexArgs -> UnicodeLexing.Lexbuf -> string -> token
val DoesIdentifierNeedQuotation: string -> bool
diff --git a/src/fsharp/pars.fsy b/src/fsharp/pars.fsy
index 5bb5446a8d0..1d757e4789d 100644
--- a/src/fsharp/pars.fsy
+++ b/src/fsharp/pars.fsy
@@ -91,24 +91,59 @@ let raiseParseErrorAt m s =
// This initiates error recovery
raise RecoverableParseError
+/// Report a good error at the end of file, e.g. for non-terminated strings
let checkEndOfFileError t =
match t with
- | LexCont.IfDefSkip(_, _, m) -> reportParseErrorAt m (FSComp.SR.parsEofInHashIf())
- | LexCont.String (_, m) -> reportParseErrorAt m (FSComp.SR.parsEofInString())
- | LexCont.TripleQuoteString (_, m) -> reportParseErrorAt m (FSComp.SR.parsEofInTripleQuoteString())
- | LexCont.VerbatimString (_, m) -> reportParseErrorAt m (FSComp.SR.parsEofInVerbatimString())
- | LexCont.Comment (_, _, m) -> reportParseErrorAt m (FSComp.SR.parsEofInComment())
- | LexCont.SingleLineComment (_, _, m) -> reportParseErrorAt m (FSComp.SR.parsEofInComment())
- | LexCont.StringInComment (_, _, m) -> reportParseErrorAt m (FSComp.SR.parsEofInStringInComment())
- | LexCont.VerbatimStringInComment (_, _, m) -> reportParseErrorAt m (FSComp.SR.parsEofInVerbatimStringInComment())
- | LexCont.TripleQuoteStringInComment (_, _, m) -> reportParseErrorAt m (FSComp.SR.parsEofInTripleQuoteStringInComment())
- | LexCont.MLOnly (_, m) -> reportParseErrorAt m (FSComp.SR.parsEofInIfOcaml())
- | LexCont.EndLine(LexerEndlineContinuation.Skip(_, _, m)) -> reportParseErrorAt m (FSComp.SR.parsEofInDirective())
- | LexCont.EndLine(LexerEndlineContinuation.Token(stack))
- | LexCont.Token(stack) ->
- match stack with
+ | LexCont.IfDefSkip(_, _, _, m) ->
+ reportParseErrorAt m (FSComp.SR.parsEofInHashIf())
+
+ | LexCont.String (_, _, LexerStringStyle.SingleQuote, kind, m) ->
+ if kind.IsInterpolated then
+ reportParseErrorAt m (FSComp.SR.parsEofInInterpolatedString())
+ else
+ reportParseErrorAt m (FSComp.SR.parsEofInString())
+
+ | LexCont.String (_, _, LexerStringStyle.TripleQuote, kind, m) ->
+ if kind.IsInterpolated then
+ reportParseErrorAt m (FSComp.SR.parsEofInInterpolatedTripleQuoteString())
+ else
+ reportParseErrorAt m (FSComp.SR.parsEofInTripleQuoteString())
+
+ | LexCont.String (_, _, LexerStringStyle.Verbatim, kind, m) ->
+ if kind.IsInterpolated then
+ reportParseErrorAt m (FSComp.SR.parsEofInInterpolatedVerbatimString())
+ else
+ reportParseErrorAt m (FSComp.SR.parsEofInVerbatimString())
+
+ | LexCont.Comment (_, _, _, m) ->
+ reportParseErrorAt m (FSComp.SR.parsEofInComment())
+
+ | LexCont.SingleLineComment (_, _, _, m) ->
+ reportParseErrorAt m (FSComp.SR.parsEofInComment())
+
+ | LexCont.StringInComment (_, _, LexerStringStyle.SingleQuote, _, m) ->
+ reportParseErrorAt m (FSComp.SR.parsEofInStringInComment())
+
+ | LexCont.StringInComment (_, _, LexerStringStyle.Verbatim, _, m) ->
+ reportParseErrorAt m (FSComp.SR.parsEofInVerbatimStringInComment())
+
+ | LexCont.StringInComment (_, _, LexerStringStyle.TripleQuote, _, m) ->
+ reportParseErrorAt m (FSComp.SR.parsEofInTripleQuoteStringInComment())
+
+ | LexCont.MLOnly (_, _, m) ->
+ reportParseErrorAt m (FSComp.SR.parsEofInIfOcaml())
+
+ | LexCont.EndLine(_, _, LexerEndlineContinuation.Skip(_, m)) ->
+ reportParseErrorAt m (FSComp.SR.parsEofInDirective())
+
+ | LexCont.EndLine(endifs, nesting, LexerEndlineContinuation.Token)
+ | LexCont.Token(endifs, nesting) ->
+ match endifs with
| [] -> ()
| (_, m) :: _ -> reportParseErrorAt m (FSComp.SR.parsNoHashEndIfFound())
+ match nesting with
+ | [] -> ()
+ | (_, _, m) :: _ -> reportParseErrorAt m (FSComp.SR.parsEofInInterpolatedStringFill())
type BindingSet = BindingSetPreAttrs of range * bool * bool * (SynAttributes -> SynAccess option -> SynAttributes * SynBinding list) * range
@@ -155,8 +190,15 @@ let rangeOfLongIdent(lid:LongIdent) =
%}
-%token BYTEARRAY
-%token STRING
+// Producing these changes the lex state, e.g. string --> token, or nesting level of braces in interpolated strings
+%token BYTEARRAY
+%token STRING
+%token INTERP_STRING_BEGIN_END
+%token INTERP_STRING_BEGIN_PART
+%token INTERP_STRING_PART
+%token INTERP_STRING_END
+%token LBRACE RBRACE
+
%token KEYWORD_STRING // Like __SOURCE_DIRECTORY__
%token IDENT
%token INFIX_STAR_STAR_OP
@@ -198,9 +240,9 @@ let rangeOfLongIdent(lid:LongIdent) =
%token OPEN OR REC THEN TO TRUE TRY TYPE VAL INLINE INTERFACE INSTANCE CONST
%token WHEN WHILE WITH HASH AMP AMP_AMP QUOTE LPAREN RPAREN RPAREN_COMING_SOON RPAREN_IS_HERE STAR COMMA RARROW GREATER_BAR_RBRACK LPAREN_STAR_RPAREN
%token QMARK QMARK_QMARK DOT COLON COLON_COLON COLON_GREATER COLON_QMARK_GREATER COLON_QMARK COLON_EQUALS SEMICOLON
-%token SEMICOLON_SEMICOLON LARROW EQUALS LBRACK LBRACK_BAR LBRACE_BAR LBRACK_LESS LBRACE
+%token SEMICOLON_SEMICOLON LARROW EQUALS LBRACK LBRACK_BAR LBRACE_BAR LBRACK_LESS
%token BAR_RBRACK BAR_RBRACE UNDERSCORE
-%token BAR RBRACK RBRACE RBRACE_COMING_SOON RBRACE_IS_HERE MINUS DOLLAR
+%token BAR RBRACK RBRACE_COMING_SOON RBRACE_IS_HERE MINUS DOLLAR
%token GREATER_RBRACK STRUCT SIG
%token STATIC MEMBER CLASS ABSTRACT OVERRIDE DEFAULT CONSTRUCTOR INHERIT
%token EXTERN VOID PUBLIC PRIVATE INTERNAL GLOBAL
@@ -261,8 +303,8 @@ let rangeOfLongIdent(lid:LongIdent) =
/* These are artificial */
%token LEX_FAILURE
-%token COMMENT WHITESPACE HASH_LINE HASH_LIGHT INACTIVECODE LINE_COMMENT STRING_TEXT EOF
-%token HASH_IF HASH_ELSE HASH_ENDIF
+%token COMMENT WHITESPACE HASH_LINE HASH_LIGHT INACTIVECODE LINE_COMMENT STRING_TEXT EOF
+%token HASH_IF HASH_ELSE HASH_ENDIF
%start signatureFile implementationFile interaction typedSeqExprEOF typEOF
%type typedSeqExprEOF
@@ -382,6 +424,7 @@ let rangeOfLongIdent(lid:LongIdent) =
*/
%nonassoc prec_atompat_pathop
%nonassoc INT8 UINT8 INT16 UINT16 INT32 UINT32 INT64 UINT64 NATIVEINT UNATIVEINT IEEE32 IEEE64 CHAR KEYWORD_STRING STRING BYTEARRAY BIGNUM DECIMAL
+%nonassoc INTERP_STRING_BEGIN INTERP_STRING_PART INTERP_STRING_END
%nonassoc LPAREN LBRACE LBRACK_BAR
%nonassoc TRUE FALSE UNDERSCORE NULL
@@ -446,7 +489,8 @@ let rangeOfLongIdent(lid:LongIdent) =
%right COLON_EQUALS
%nonassoc pat_tuple expr_tuple
%left COMMA
-%nonassoc slice_expr /* matrix.[e COMMA e] has higher precedence than "e COMMA e" */
+%nonassoc slice_expr /* matrix.[e COMMA e] has higher precedence than "e COMMA e" */
+%nonassoc interpolation_fill /* "...{3,N4}..." .NET style fill has higher precedence than "e COMMA e" */
%nonassoc DOT_DOT /* for matrix.[1..2, 3..4] the ".." has higher precedence than expression "2 COMMA 3" */
%nonassoc slice_comma /* for matrix.[1..2, 3..4] the ", " has higher precedence than ".." */
%nonassoc paren_pat_colon
@@ -2833,7 +2877,7 @@ rawConstant:
{ SynConst.String ($1, lhs parseState) }
| BYTEARRAY
- { SynConst.Bytes ($1, lhs parseState) }
+ { SynConst.Bytes (fst $1, lhs parseState) }
rationalConstant:
| INT32 INFIX_STAR_DIV_MOD_OP INT32
@@ -4152,7 +4196,7 @@ rangeDeclExpr:
if $1 <> "^" then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsInvalidPrefixOperator())
$2, true }
-/* the start et of atomicExprAfterType must not overlap with the valid postfix tokens of the type syntax, e.g. new List(...) */
+/* the start of atomicExprAfterType must not overlap with the valid postfix tokens of the type syntax, e.g. new List(...) */
atomicExprAfterType:
| constant
{ SynExpr.Const ($1, $1.Range (lhs parseState)) }
@@ -4166,6 +4210,9 @@ atomicExprAfterType:
| braceBarExpr
{ $1 }
+ | interpolatedString
+ { SynExpr.InterpolatedString($1, rhs parseState 1) }
+
| NULL
{ SynExpr.Null (lhs parseState) }
@@ -5438,11 +5485,35 @@ colonOrEquals:
| COLON { mlCompatWarning (FSComp.SR.parsSyntaxModuleSigEndDeprecated()) (lhs parseState); }
| EQUALS { }
-/* A literal string or a string fromm a keyword like __SOURCE_FILE__ */
+/* A literal string or a string from a keyword like __SOURCE_FILE__ */
stringOrKeywordString:
- | STRING { $1 }
+ | STRING { fst $1 }
| KEYWORD_STRING { $1 }
+interpolatedStringFill:
+ | declExpr
+ { ($1, None) }
+
+ | declExpr COLON ident %prec interpolation_fill
+ { ($1, Some $3) }
+
+interpolatedStringParts:
+ | INTERP_STRING_END
+ { [ SynInterpolatedStringPart.String (fst $1, rhs parseState 1) ] }
+
+ | INTERP_STRING_PART interpolatedStringFill interpolatedStringParts
+ { SynInterpolatedStringPart.String (fst $1, rhs parseState 1) :: SynInterpolatedStringPart.FillExpr $2 :: $3 }
+
+/* INTERP_STRING_BEGIN_END */
+/* INTERP_STRING_BEGIN_PART int32 INTERP_STRING_END */
+/* INTERP_STRING_BEGIN_PART int32 INTERP_STRING_PART int32 INTERP_STRING_END */
+interpolatedString:
+ | INTERP_STRING_BEGIN_PART interpolatedStringFill interpolatedStringParts
+ { SynInterpolatedStringPart.String (fst $1, rhs parseState 1) :: SynInterpolatedStringPart.FillExpr $2 :: $3 }
+
+ | INTERP_STRING_BEGIN_END
+ { [ SynInterpolatedStringPart.String (fst $1, rhs parseState 1) ] }
+
opt_HIGH_PRECEDENCE_APP:
| HIGH_PRECEDENCE_BRACK_APP { }
| HIGH_PRECEDENCE_PAREN_APP { }
diff --git a/src/fsharp/pplex.fsl b/src/fsharp/pplex.fsl
index fd984c41b45..d4227d28733 100644
--- a/src/fsharp/pplex.fsl
+++ b/src/fsharp/pplex.fsl
@@ -15,7 +15,7 @@ open Internal.Utilities.Text.Lexing
let lexeme (lexbuf : UnicodeLexing.Lexbuf) = UnicodeLexing.Lexbuf.LexemeString lexbuf
-let fail (args : lexargs) (lexbuf:UnicodeLexing.Lexbuf) e =
+let fail (args : LexArgs) (lexbuf:UnicodeLexing.Lexbuf) e =
let m = lexbuf.LexemeRange
args.errorLogger.ErrorR(Error(e,m))
PPParser.EOF
diff --git a/src/fsharp/service/FSharpCheckerResults.fs b/src/fsharp/service/FSharpCheckerResults.fs
index 31263f4e282..8de2a871d52 100644
--- a/src/fsharp/service/FSharpCheckerResults.fs
+++ b/src/fsharp/service/FSharpCheckerResults.fs
@@ -1431,11 +1431,11 @@ module internal ParseAndCheckFile =
let getLightSyntaxStatus fileName options =
let lower = String.lowercase fileName
let lightOnByDefault = List.exists (Filename.checkSuffix lower) FSharpLightSyntaxFileSuffixes
- let lightSyntaxStatus = if lightOnByDefault then (options.LightSyntax <> Some false) else (options.LightSyntax = Some true)
- LightSyntaxStatus(lightSyntaxStatus, true)
+ let lightStatus = if lightOnByDefault then (options.LightSyntax <> Some false) else (options.LightSyntax = Some true)
+ LightSyntaxStatus(lightStatus, true)
let createLexerFunction fileName options lexbuf (errHandler: ErrorHandler) =
- let lightSyntaxStatus = getLightSyntaxStatus fileName options
+ let lightStatus = getLightSyntaxStatus fileName options
// If we're editing a script then we define INTERACTIVE otherwise COMPILED.
// Since this parsing for intellisense we always define EDITING.
@@ -1446,10 +1446,10 @@ module internal ParseAndCheckFile =
// When analyzing files using ParseOneFile, i.e. for the use of editing clients, we do not apply line directives.
// TODO(pathmap): expose PathMap on the service API, and thread it through here
- let lexargs = mkLexargs(fileName, defines, lightSyntaxStatus, lexResourceManager, [], errHandler.ErrorLogger, PathMap.empty)
+ let lexargs = mkLexargs(defines, lightStatus, lexResourceManager, [], errHandler.ErrorLogger, PathMap.empty)
let lexargs = { lexargs with applyLineDirectives = false }
- let tokenizer = LexFilter.LexFilter(lightSyntaxStatus, options.CompilingFsLib, Lexer.token lexargs true, lexbuf)
+ let tokenizer = LexFilter.LexFilter(lightStatus, options.CompilingFsLib, Lexer.token lexargs true, lexbuf)
tokenizer.Lexer
// Public callers are unable to answer LanguageVersion feature support questions.
@@ -1479,8 +1479,13 @@ module internal ParseAndCheckFile =
match t1, t2 with
| (LPAREN, RPAREN)
| (LPAREN, RPAREN_IS_HERE)
- | (LBRACE, RBRACE)
- | (LBRACE, RBRACE_IS_HERE)
+ | (LBRACE _, RBRACE _)
+ | (LBRACE_BAR, BAR_RBRACE)
+ | (LBRACE _, RBRACE_IS_HERE)
+ | (INTERP_STRING_BEGIN_PART _, INTERP_STRING_END _)
+ | (INTERP_STRING_BEGIN_PART _, INTERP_STRING_PART _)
+ | (INTERP_STRING_PART _, INTERP_STRING_PART _)
+ | (INTERP_STRING_PART _, INTERP_STRING_END _)
| (SIG, END)
| (STRUCT, END)
| (LBRACK_BAR, BAR_RBRACK)
@@ -1489,13 +1494,49 @@ module internal ParseAndCheckFile =
| (BEGIN, END) -> true
| (LQUOTE q1, RQUOTE q2) -> q1 = q2
| _ -> false
+
let rec matchBraces stack =
match lexfun lexbuf, stack with
- | tok2, ((tok1, m1) :: stack') when parenTokensBalance tok1 tok2 ->
- matchingBraces.Add(m1, lexbuf.LexemeRange)
- matchBraces stack'
- | ((LPAREN | LBRACE | LBRACK | LBRACK_BAR | LQUOTE _ | LBRACK_LESS) as tok), _ ->
+ | tok2, ((tok1, m1) :: stackAfterMatch) when parenTokensBalance tok1 tok2 ->
+ let m2 = lexbuf.LexemeRange
+
+ // For INTERP_STRING_PART and INTERP_STRING_END grab the one character
+ // range that corresponds to the "}" at the start of the token
+ let m2Start =
+ match tok2 with
+ | INTERP_STRING_PART _
+ | INTERP_STRING_END _ ->
+ Range.mkFileIndexRange m2.FileIndex m2.Start (mkPos m2.Start.Line (m2.Start.Column+1))
+ | _ -> m2
+
+ matchingBraces.Add(m1, m2Start)
+
+ // INTERP_STRING_PART corresponds to both "} ... {" i.e. both the completion
+ // of a match and the start of a potential new one.
+ let stackAfterMatch =
+ match tok2 with
+ | INTERP_STRING_PART _ ->
+ let m2End = Range.mkFileIndexRange m2.FileIndex (mkPos m2.End.Line (max (m2.End.Column-1) 0)) m2.End
+ (tok2, m2End) :: stackAfterMatch
+ | _ -> stackAfterMatch
+
+ matchBraces stackAfterMatch
+
+ | ((LPAREN | LBRACE _ | LBRACK | LBRACE_BAR | LBRACK_BAR | LQUOTE _ | LBRACK_LESS) as tok), _ ->
matchBraces ((tok, lexbuf.LexemeRange) :: stack)
+
+ // INTERP_STRING_BEGIN_PART corresponds to $"... {" at the start of an interpolated string
+ //
+ // INTERP_STRING_PART corresponds to "} ... {" in the middle of an interpolated string (in
+ // this case it msut not have matched something on the stack, e.g. an incomplete '[' in the
+ // interpolation expression)
+ //
+ // Either way we start a new potential match at the last character
+ | ((INTERP_STRING_BEGIN_PART _ | INTERP_STRING_PART _) as tok), _ ->
+ let m = lexbuf.LexemeRange
+ let m2 = Range.mkFileIndexRange m.FileIndex (mkPos m.End.Line (max (m.End.Column-1) 0)) m.End
+ matchBraces ((tok, m2) :: stack)
+
| (EOF _ | LEX_FAILURE _), _ -> ()
| _ -> matchBraces stack
matchBraces [])
diff --git a/src/fsharp/service/ServiceLexing.fs b/src/fsharp/service/ServiceLexing.fs
index 8e93e37205c..20f05760f33 100755
--- a/src/fsharp/service/ServiceLexing.fs
+++ b/src/fsharp/service/ServiceLexing.fs
@@ -27,17 +27,22 @@ type Position = int * int
type Range = Position * Position
module FSharpTokenTag =
+
let Identifier = tagOfToken (IDENT "a")
- let String = tagOfToken (STRING "a")
+ let String = tagOfToken (STRING ("a", LexCont.Default))
let IDENT = tagOfToken (IDENT "a")
- let STRING = tagOfToken (STRING "a")
+ let STRING = String
+ let INTERP_STRING_BEGIN_END = tagOfToken (INTERP_STRING_BEGIN_END ("a", LexCont.Default))
+ let INTERP_STRING_BEGIN_PART = tagOfToken (INTERP_STRING_BEGIN_PART ("a", LexCont.Default))
+ let INTERP_STRING_PART = tagOfToken (INTERP_STRING_PART ("a", LexCont.Default))
+ let INTERP_STRING_END = tagOfToken (INTERP_STRING_END ("a", LexCont.Default))
let LPAREN = tagOfToken LPAREN
let RPAREN = tagOfToken RPAREN
let LBRACK = tagOfToken LBRACK
let RBRACK = tagOfToken RBRACK
- let LBRACE = tagOfToken LBRACE
- let RBRACE = tagOfToken RBRACE
+ let LBRACE = tagOfToken (LBRACE LexCont.Default)
+ let RBRACE = tagOfToken (RBRACE LexCont.Default)
let LBRACK_LESS = tagOfToken LBRACK_LESS
let GREATER_RBRACK = tagOfToken GREATER_RBRACK
let LESS = tagOfToken (LESS true)
@@ -250,13 +255,13 @@ module internal TokenClassifications =
| LBRACK_LESS ->
(FSharpTokenColorKind.Punctuation, FSharpTokenCharKind.Delimiter, FSharpTokenTriggerClass.None )
- | LQUOTE _ | LBRACK | LBRACE | LBRACK_BAR | LBRACE_BAR ->
+ | LQUOTE _ | LBRACK | LBRACE _ | LBRACK_BAR | LBRACE_BAR ->
(FSharpTokenColorKind.Punctuation, FSharpTokenCharKind.Delimiter, FSharpTokenTriggerClass.MatchBraces )
| GREATER_RBRACK | GREATER_BAR_RBRACK ->
(FSharpTokenColorKind.Punctuation, FSharpTokenCharKind.Delimiter, FSharpTokenTriggerClass.None )
- | RQUOTE _ | RBRACK | RBRACE | RBRACE_COMING_SOON | RBRACE_IS_HERE | BAR_RBRACK | BAR_RBRACE ->
+ | RQUOTE _ | RBRACK | RBRACE _ | RBRACE_COMING_SOON | RBRACE_IS_HERE | BAR_RBRACK | BAR_RBRACE ->
(FSharpTokenColorKind.Punctuation, FSharpTokenCharKind.Delimiter, FSharpTokenTriggerClass.MatchBraces )
| PUBLIC | PRIVATE | INTERNAL | BASE | GLOBAL
@@ -304,12 +309,14 @@ module internal TokenClassifications =
| LINE_COMMENT _ ->
(FSharpTokenColorKind.Comment, FSharpTokenCharKind.LineComment, FSharpTokenTriggerClass.None)
- | STRING_TEXT _ ->
- (FSharpTokenColorKind.String, FSharpTokenCharKind.String, FSharpTokenTriggerClass.None)
-
| KEYWORD_STRING _ ->
(FSharpTokenColorKind.Keyword, FSharpTokenCharKind.Keyword, FSharpTokenTriggerClass.None)
+ | STRING_TEXT _
+ | INTERP_STRING_BEGIN_END _
+ | INTERP_STRING_BEGIN_PART _
+ | INTERP_STRING_PART _
+ | INTERP_STRING_END _
| BYTEARRAY _ | STRING _
| CHAR _ ->
(FSharpTokenColorKind.String, FSharpTokenCharKind.String, FSharpTokenTriggerClass.None)
@@ -319,9 +326,13 @@ module internal TokenClassifications =
module internal TestExpose =
let TokenInfo tok = TokenClassifications.tokenInfo tok
- //----------------------------------------------------------------------------
- // Lexer states encoded to/from integers
- //--------------------------------------------------------------------------
+/// Lexer states are encoded to/from integers. Typically one lexer state is
+/// keep at the end of each line in an IDE service. IDE services are sometimes highly limited in the
+/// memory they can use and this per-line state can be a significant cost if it associates with
+/// many allocated objects.
+///
+/// The encoding is lossy so some incremental lexing scenarios such as deeply nested #if
+/// or accurate error messages from lexing for mismtached #if are not supported.
[]
type FSharpTokenizerLexState =
{ PosBits: int64
@@ -350,73 +361,125 @@ type FSharpTokenizerColorState =
module internal LexerStateEncoding =
- let computeNextLexState token (prevLexcont: LexerWhitespaceContinuation) =
+ let computeNextLexState token (prevLexcont: LexerContinuation) =
match token with
- | HASH_LINE s
- | HASH_LIGHT s
- | HASH_IF(_, _, s)
- | HASH_ELSE(_, _, s)
- | HASH_ENDIF(_, _, s)
- | INACTIVECODE s
- | WHITESPACE s
- | COMMENT s
- | LINE_COMMENT s
- | STRING_TEXT s
- | EOF s -> s
- | BYTEARRAY _ | STRING _ -> LexCont.Token(prevLexcont.LexerIfdefStack)
+ | HASH_LINE cont
+ | HASH_LIGHT cont
+ | HASH_IF(_, _, cont)
+ | HASH_ELSE(_, _, cont)
+ | HASH_ENDIF(_, _, cont)
+ | INACTIVECODE cont
+ | WHITESPACE cont
+ | COMMENT cont
+ | LINE_COMMENT cont
+ | STRING_TEXT cont
+ | EOF cont
+ | INTERP_STRING_BEGIN_PART (_, cont)
+ | INTERP_STRING_PART (_, cont)
+ | INTERP_STRING_BEGIN_END (_, cont)
+ | INTERP_STRING_END (_, cont)
+ | LBRACE cont
+ | RBRACE cont
+ | BYTEARRAY (_, cont)
+ | STRING (_, cont) -> cont
| _ -> prevLexcont
// Note that this will discard all lexcont state, including the ifdefStack.
- let revertToDefaultLexCont = LexCont.Token []
+ let revertToDefaultLexCont = LexCont.Default
let lexstateNumBits = 4
let ncommentsNumBits = 4
let hardwhiteNumBits = 1
let ifdefstackCountNumBits = 8
let ifdefstackNumBits = 24 // 0 means if, 1 means else
+ let stringKindBits = 3
+ let nestingBits = 12
let _ = assert (lexstateNumBits
+ ncommentsNumBits
+ hardwhiteNumBits
+ ifdefstackCountNumBits
- + ifdefstackNumBits <= 64)
+ + ifdefstackNumBits
+ + stringKindBits
+ + nestingBits <= 64)
let lexstateStart = 0
let ncommentsStart = lexstateNumBits
let hardwhitePosStart = lexstateNumBits+ncommentsNumBits
let ifdefstackCountStart = lexstateNumBits+ncommentsNumBits+hardwhiteNumBits
let ifdefstackStart = lexstateNumBits+ncommentsNumBits+hardwhiteNumBits+ifdefstackCountNumBits
+ let stringKindStart = lexstateNumBits+ncommentsNumBits+hardwhiteNumBits+ifdefstackCountNumBits+ifdefstackNumBits
+ let nestingStart = lexstateNumBits+ncommentsNumBits+hardwhiteNumBits+ifdefstackCountNumBits+ifdefstackNumBits+stringKindBits
let lexstateMask = Bits.mask64 lexstateStart lexstateNumBits
let ncommentsMask = Bits.mask64 ncommentsStart ncommentsNumBits
let hardwhitePosMask = Bits.mask64 hardwhitePosStart hardwhiteNumBits
let ifdefstackCountMask = Bits.mask64 ifdefstackCountStart ifdefstackCountNumBits
let ifdefstackMask = Bits.mask64 ifdefstackStart ifdefstackNumBits
+ let stringKindMask = Bits.mask64 stringKindStart stringKindBits
+ let nestingMask = Bits.mask64 nestingStart nestingBits
let bitOfBool b = if b then 1 else 0
let boolOfBit n = (n = 1L)
- let inline colorStateOfLexState (state: FSharpTokenizerLexState) =
+ let colorStateOfLexState (state: FSharpTokenizerLexState) =
enum (int32 ((state.OtherBits &&& lexstateMask) >>> lexstateStart))
- let inline lexStateOfColorState (state: FSharpTokenizerColorState) =
+ let lexStateOfColorState (state: FSharpTokenizerColorState) =
(int64 state <<< lexstateStart) &&& lexstateMask
- let encodeLexCont (colorState: FSharpTokenizerColorState) ncomments (b: pos) ifdefStack light =
+ let encodeStringStyle kind =
+ match kind with
+ | LexerStringStyle.SingleQuote -> 0
+ | LexerStringStyle.Verbatim -> 1
+ | LexerStringStyle.TripleQuote -> 2
+
+ let decodeStringStyle kind =
+ match kind with
+ | 0 -> LexerStringStyle.SingleQuote
+ | 1 -> LexerStringStyle.Verbatim
+ | 2 -> LexerStringStyle.TripleQuote
+ | _ -> assert false; LexerStringStyle.SingleQuote
+
+ let encodeLexCont (colorState: FSharpTokenizerColorState, numComments, b: pos, ifdefStack, light, stringKind: LexerStringKind, stringNest) =
let mutable ifdefStackCount = 0
let mutable ifdefStackBits = 0
for ifOrElse in ifdefStack do
match ifOrElse with
- | (IfDefIf, _) -> ()
- | (IfDefElse, _) ->
- ifdefStackBits <- (ifdefStackBits ||| (1 <<< ifdefStackCount))
+ | (IfDefIf, _) -> ()
+ | (IfDefElse, _) ->
+ ifdefStackBits <- (ifdefStackBits ||| (1 <<< ifdefStackCount))
ifdefStackCount <- ifdefStackCount + 1
+ let stringKindValue =
+ (if stringKind.IsByteString then 0b100 else 0) |||
+ (if stringKind.IsInterpolated then 0b010 else 0) |||
+ (if stringKind.IsInterpolatedFirst then 0b001 else 0)
+
+ let nestingValue =
+ let tag1, i1, kind1, rest =
+ match stringNest with
+ | [] -> false, 0, 0, []
+ | (i1, kind1, _)::rest -> true, i1, encodeStringStyle kind1, rest
+ let tag2, i2, kind2 =
+ match rest with
+ | [] -> false, 0, 0
+ | (i2, kind2, _)::_ -> true, i2, encodeStringStyle kind2
+ (if tag1 then 0b100000000000 else 0) |||
+ (if tag2 then 0b010000000000 else 0) |||
+ ((i1 <<< 7) &&& 0b001110000000) |||
+ ((i2 <<< 4) &&& 0b000001110000) |||
+ ((kind1 <<< 2) &&& 0b000000001100) |||
+ ((kind2 <<< 0) &&& 0b000000000011)
+
let bits =
lexStateOfColorState colorState
- ||| ((ncomments <<< ncommentsStart) &&& ncommentsMask)
+ ||| ((numComments <<< ncommentsStart) &&& ncommentsMask)
||| ((int64 (bitOfBool light) <<< hardwhitePosStart) &&& hardwhitePosMask)
||| ((int64 ifdefStackCount <<< ifdefstackCountStart) &&& ifdefstackCountMask)
||| ((int64 ifdefStackBits <<< ifdefstackStart) &&& ifdefstackMask)
+ ||| ((int64 stringKindValue <<< stringKindStart) &&& stringKindMask)
+ ||| ((int64 nestingValue <<< nestingStart) &&& nestingMask)
+
{ PosBits = b.Encoding
OtherBits = bits }
@@ -424,6 +487,11 @@ module internal LexerStateEncoding =
let decodeLexCont (state: FSharpTokenizerLexState) =
let mutable ifDefs = []
let bits = state.OtherBits
+
+ let colorState = colorStateOfLexState state
+ let ncomments = int32 ((bits &&& ncommentsMask) >>> ncommentsStart)
+ let pos = pos.Decode state.PosBits
+
let ifdefStackCount = int32 ((bits &&& ifdefstackCountMask) >>> ifdefstackCountStart)
if ifdefStackCount>0 then
let ifdefStack = int32 ((bits &&& ifdefstackMask) >>> ifdefstackStart)
@@ -432,73 +500,97 @@ module internal LexerStateEncoding =
let mask = 1 <<< bit
let ifDef = (if ifdefStack &&& mask = 0 then IfDefIf else IfDefElse)
ifDefs <- (ifDef, range0) :: ifDefs
- colorStateOfLexState state,
- int32 ((bits &&& ncommentsMask) >>> ncommentsStart),
- pos.Decode state.PosBits,
- ifDefs,
- boolOfBit ((bits &&& hardwhitePosMask) >>> hardwhitePosStart)
-
- let encodeLexInt lightSyntaxStatus (lexcont: LexerWhitespaceContinuation) =
- let tag, n1, p1, ifd =
- match lexcont with
- | LexCont.Token ifd -> FSharpTokenizerColorState.Token, 0L, pos0, ifd
- | LexCont.IfDefSkip (ifd, n, m) -> FSharpTokenizerColorState.IfDefSkip, int64 n, m.Start, ifd
- | LexCont.EndLine(LexerEndlineContinuation.Skip(ifd, n, m)) -> FSharpTokenizerColorState.EndLineThenSkip, int64 n, m.Start, ifd
- | LexCont.EndLine(LexerEndlineContinuation.Token ifd) -> FSharpTokenizerColorState.EndLineThenToken, 0L, pos0, ifd
- | LexCont.String (ifd, m) -> FSharpTokenizerColorState.String, 0L, m.Start, ifd
- | LexCont.Comment (ifd, n, m) -> FSharpTokenizerColorState.Comment, int64 n, m.Start, ifd
- | LexCont.SingleLineComment (ifd, n, m) -> FSharpTokenizerColorState.SingleLineComment, int64 n, m.Start, ifd
- | LexCont.StringInComment (ifd, n, m) -> FSharpTokenizerColorState.StringInComment, int64 n, m.Start, ifd
- | LexCont.VerbatimStringInComment (ifd, n, m) -> FSharpTokenizerColorState.VerbatimStringInComment, int64 n, m.Start, ifd
- | LexCont.TripleQuoteStringInComment (ifd, n, m) -> FSharpTokenizerColorState.TripleQuoteStringInComment, int64 n, m.Start, ifd
- | LexCont.MLOnly (ifd, m) -> FSharpTokenizerColorState.CamlOnly, 0L, m.Start, ifd
- | LexCont.VerbatimString (ifd, m) -> FSharpTokenizerColorState.VerbatimString, 0L, m.Start, ifd
- | LexCont.TripleQuoteString (ifd, m) -> FSharpTokenizerColorState.TripleQuoteString, 0L, m.Start, ifd
- encodeLexCont tag n1 p1 ifd lightSyntaxStatus
-
+ let stringKindValue = int32 ((bits &&& stringKindMask) >>> stringKindStart)
+ let stringKind : LexerStringKind =
+ { IsByteString = ((stringKindValue &&& 0b100) = 0b100)
+ IsInterpolated = ((stringKindValue &&& 0b010) = 0b010)
+ IsInterpolatedFirst = ((stringKindValue &&& 0b001) = 0b001) }
+
+ let hardwhite = boolOfBit ((bits &&& hardwhitePosMask) >>> hardwhitePosStart)
+
+ let nestingValue = int32 ((bits &&& nestingMask) >>> nestingStart)
+ let stringNest : LexerInterpolatedStringNesting =
+ let tag1 = ((nestingValue &&& 0b100000000000) = 0b100000000000)
+ let tag2 = ((nestingValue &&& 0b010000000000) = 0b010000000000)
+ let i1 = ((nestingValue &&& 0b001110000000) >>> 7)
+ let i2 = ((nestingValue &&& 0b000001110000) >>> 4)
+ let kind1 = ((nestingValue &&& 0b000000001100) >>> 2)
+ let kind2 = ((nestingValue &&& 0b000000000011) >>> 0)
+ [ if tag1 then
+ i1, decodeStringStyle kind1, range0
+ if tag2 then
+ i2, decodeStringStyle kind2, range0
+ ]
+
+ (colorState, ncomments, pos, ifDefs, hardwhite, stringKind, stringNest)
+
+ let encodeLexInt lightStatus (lexcont: LexerContinuation) =
+ match lexcont with
+ | LexCont.Token (ifdefs, stringNest) ->
+ encodeLexCont (FSharpTokenizerColorState.Token, 0L, pos0, ifdefs, lightStatus, LexerStringKind.String, stringNest)
+ | LexCont.IfDefSkip (ifdefs, stringNest, n, m) ->
+ encodeLexCont (FSharpTokenizerColorState.IfDefSkip, int64 n, m.Start, ifdefs, lightStatus, LexerStringKind.String, stringNest)
+ | LexCont.EndLine(ifdefs, stringNest, econt) ->
+ match econt with
+ | LexerEndlineContinuation.Skip(n, m) ->
+ encodeLexCont (FSharpTokenizerColorState.EndLineThenSkip, int64 n, m.Start, ifdefs, lightStatus, LexerStringKind.String, stringNest)
+ | LexerEndlineContinuation.Token ->
+ encodeLexCont (FSharpTokenizerColorState.EndLineThenToken, 0L, pos0, ifdefs, lightStatus, LexerStringKind.String, stringNest)
+ | LexCont.String (ifdefs, stringNest, style, kind, m) ->
+ let state =
+ match style with
+ | LexerStringStyle.SingleQuote -> FSharpTokenizerColorState.String
+ | LexerStringStyle.Verbatim -> FSharpTokenizerColorState.VerbatimString
+ | LexerStringStyle.TripleQuote -> FSharpTokenizerColorState.TripleQuoteString
+ encodeLexCont (state, 0L, m.Start, ifdefs, lightStatus, kind, stringNest)
+ | LexCont.Comment (ifdefs, stringNest, n, m) ->
+ encodeLexCont (FSharpTokenizerColorState.Comment, int64 n, m.Start, ifdefs, lightStatus, LexerStringKind.String, stringNest)
+ | LexCont.SingleLineComment (ifdefs, stringNest, n, m) ->
+ encodeLexCont (FSharpTokenizerColorState.SingleLineComment, int64 n, m.Start, ifdefs, lightStatus, LexerStringKind.String, stringNest)
+ | LexCont.StringInComment (ifdefs, stringNest, style, n, m) ->
+ let state =
+ match style with
+ | LexerStringStyle.SingleQuote -> FSharpTokenizerColorState.StringInComment
+ | LexerStringStyle.Verbatim -> FSharpTokenizerColorState.VerbatimStringInComment
+ | LexerStringStyle.TripleQuote -> FSharpTokenizerColorState.TripleQuoteStringInComment
+ encodeLexCont (state, int64 n, m.Start, ifdefs, lightStatus, LexerStringKind.String, stringNest)
+ | LexCont.MLOnly (ifdefs, stringNest, m) ->
+ encodeLexCont (FSharpTokenizerColorState.CamlOnly, 0L, m.Start, ifdefs, lightStatus, LexerStringKind.String, stringNest)
+
let decodeLexInt (state: FSharpTokenizerLexState) =
- let tag, n1, p1, ifd, lightSyntaxStatusInitial = decodeLexCont state
+ let tag, n1, p1, ifdefs, lightSyntaxStatusInitial, stringKind, stringNest = decodeLexCont state
let lexcont =
match tag with
- | FSharpTokenizerColorState.Token -> LexCont.Token ifd
- | FSharpTokenizerColorState.IfDefSkip -> LexCont.IfDefSkip (ifd, n1, mkRange "file" p1 p1)
- | FSharpTokenizerColorState.String -> LexCont.String (ifd, mkRange "file" p1 p1)
- | FSharpTokenizerColorState.Comment -> LexCont.Comment (ifd, n1, mkRange "file" p1 p1)
- | FSharpTokenizerColorState.SingleLineComment -> LexCont.SingleLineComment (ifd, n1, mkRange "file" p1 p1)
- | FSharpTokenizerColorState.StringInComment -> LexCont.StringInComment (ifd, n1, mkRange "file" p1 p1)
- | FSharpTokenizerColorState.VerbatimStringInComment -> LexCont.VerbatimStringInComment (ifd, n1, mkRange "file" p1 p1)
- | FSharpTokenizerColorState.TripleQuoteStringInComment -> LexCont.TripleQuoteStringInComment (ifd, n1, mkRange "file" p1 p1)
- | FSharpTokenizerColorState.CamlOnly -> LexCont.MLOnly (ifd, mkRange "file" p1 p1)
- | FSharpTokenizerColorState.VerbatimString -> LexCont.VerbatimString (ifd, mkRange "file" p1 p1)
- | FSharpTokenizerColorState.TripleQuoteString -> LexCont.TripleQuoteString (ifd, mkRange "file" p1 p1)
- | FSharpTokenizerColorState.EndLineThenSkip -> LexCont.EndLine(LexerEndlineContinuation.Skip(ifd, n1, mkRange "file" p1 p1))
- | FSharpTokenizerColorState.EndLineThenToken -> LexCont.EndLine(LexerEndlineContinuation.Token ifd)
- | _ -> LexCont.Token []
+ | FSharpTokenizerColorState.Token ->
+ LexCont.Token (ifdefs, stringNest)
+ | FSharpTokenizerColorState.IfDefSkip ->
+ LexCont.IfDefSkip (ifdefs, stringNest, n1, mkRange "file" p1 p1)
+ | FSharpTokenizerColorState.String ->
+ LexCont.String (ifdefs, stringNest, LexerStringStyle.SingleQuote, stringKind, mkRange "file" p1 p1)
+ | FSharpTokenizerColorState.Comment ->
+ LexCont.Comment (ifdefs, stringNest, n1, mkRange "file" p1 p1)
+ | FSharpTokenizerColorState.SingleLineComment ->
+ LexCont.SingleLineComment (ifdefs, stringNest, n1, mkRange "file" p1 p1)
+ | FSharpTokenizerColorState.StringInComment ->
+ LexCont.StringInComment (ifdefs, stringNest, LexerStringStyle.SingleQuote, n1, mkRange "file" p1 p1)
+ | FSharpTokenizerColorState.VerbatimStringInComment ->
+ LexCont.StringInComment (ifdefs, stringNest, LexerStringStyle.Verbatim, n1, mkRange "file" p1 p1)
+ | FSharpTokenizerColorState.TripleQuoteStringInComment ->
+ LexCont.StringInComment (ifdefs, stringNest, LexerStringStyle.TripleQuote, n1, mkRange "file" p1 p1)
+ | FSharpTokenizerColorState.CamlOnly ->
+ LexCont.MLOnly (ifdefs, stringNest, mkRange "file" p1 p1)
+ | FSharpTokenizerColorState.VerbatimString ->
+ LexCont.String (ifdefs, stringNest, LexerStringStyle.Verbatim, stringKind, mkRange "file" p1 p1)
+ | FSharpTokenizerColorState.TripleQuoteString ->
+ LexCont.String (ifdefs, stringNest, LexerStringStyle.TripleQuote, stringKind, mkRange "file" p1 p1)
+ | FSharpTokenizerColorState.EndLineThenSkip ->
+ LexCont.EndLine(ifdefs, stringNest, LexerEndlineContinuation.Skip(n1, mkRange "file" p1 p1))
+ | FSharpTokenizerColorState.EndLineThenToken ->
+ LexCont.EndLine(ifdefs, stringNest, LexerEndlineContinuation.Token)
+ | _ -> LexCont.Token ([], stringNest)
lightSyntaxStatusInitial, lexcont
- let callLexCont lexcont args skip lexbuf =
- let argsWithIfDefs ifd =
- if args.ifdefStack = ifd then
- args
- else
- {args with ifdefStack = ifd}
- match lexcont with
- | LexCont.EndLine cont -> Lexer.endline cont args skip lexbuf
- | LexCont.Token ifd -> Lexer.token (argsWithIfDefs ifd) skip lexbuf
- | LexCont.IfDefSkip (ifd, n, m) -> Lexer.ifdefSkip n m (argsWithIfDefs ifd) skip lexbuf
- // Q: What's this magic 100 number for? Q: it's just an initial buffer size.
- | LexCont.String (ifd, m) -> Lexer.string (ByteBuffer.Create 100, defaultStringFinisher, m, (argsWithIfDefs ifd)) skip lexbuf
- | LexCont.Comment (ifd, n, m) -> Lexer.comment (n, m, (argsWithIfDefs ifd)) skip lexbuf
- // The first argument is 'None' because we don't need XML comments when called from VS
- | LexCont.SingleLineComment (ifd, n, m) -> Lexer.singleLineComment (None, n, m, (argsWithIfDefs ifd)) skip lexbuf
- | LexCont.StringInComment (ifd, n, m) -> Lexer.stringInComment n m (argsWithIfDefs ifd) skip lexbuf
- | LexCont.VerbatimStringInComment (ifd, n, m) -> Lexer.verbatimStringInComment n m (argsWithIfDefs ifd) skip lexbuf
- | LexCont.TripleQuoteStringInComment (ifd, n, m) -> Lexer.tripleQuoteStringInComment n m (argsWithIfDefs ifd) skip lexbuf
- | LexCont.MLOnly (ifd, m) -> Lexer.mlOnly m (argsWithIfDefs ifd) skip lexbuf
- | LexCont.VerbatimString (ifd, m) -> Lexer.verbatimString (ByteBuffer.Create 100, defaultStringFinisher, m, (argsWithIfDefs ifd)) skip lexbuf
- | LexCont.TripleQuoteString (ifd, m) -> Lexer.tripleQuoteString (ByteBuffer.Create 100, defaultStringFinisher, m, (argsWithIfDefs ifd)) skip lexbuf
-
//----------------------------------------------------------------------------
// Colorization
//----------------------------------------------------------------------------
@@ -514,16 +606,16 @@ type SingleLineTokenState =
[]
type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf,
maxLength: int option,
- filename: Option,
- lexArgsLightOn: lexargs,
- lexArgsLightOff: lexargs) =
+ filename: string option,
+ lexargs: LexArgs) =
let skip = false // don't skip whitespace in the lexer
let mutable singleLineTokenState = SingleLineTokenState.BeforeHash
- let fsx = match filename with
- | None -> false
- | Some value -> CompileOps.IsScript value
+ let fsx =
+ match filename with
+ | None -> false
+ | Some value -> CompileOps.IsScript value
// ----------------------------------------------------------------------------------
// This implements post-processing of #directive tokens - not very elegant, but it works...
@@ -586,104 +678,157 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf,
let offset = beforeIdent + identLength
processWhiteAndComment str offset delay cont )
- // ----------------------------------------------------------------------------------
-
-
-
+ // Set up the initial file position
do match filename with
| None -> lexbuf.EndPos <- Internal.Utilities.Text.Lexing.Position.Empty
| Some value -> resetLexbufPos value lexbuf
- member x.ScanToken lexintInitial: FSharpTokenInfo option * FSharpTokenizerLexState =
+ // Call the given continuation, reusing the same 'lexargs' each time but adjust
+ // its mutable entries to set up the right state
+ let callLexCont lexcont lightStatus skip =
+
+ // Set up the arguments to lexing
+ lexargs.lightStatus <- lightStatus
+
+ match lexcont with
+ | LexCont.EndLine (ifdefs, stringNest, cont) ->
+ lexargs.ifdefStack <- ifdefs
+ lexargs.stringNest <- stringNest
+ Lexer.endline cont lexargs skip lexbuf
+
+ | LexCont.Token (ifdefs, stringNest) ->
+ lexargs.ifdefStack <- ifdefs
+ lexargs.stringNest <- stringNest
+ Lexer.token lexargs skip lexbuf
+
+ | LexCont.IfDefSkip (ifdefs, stringNest, n, m) ->
+ lexargs.ifdefStack <- ifdefs
+ lexargs.stringNest <- stringNest
+ Lexer.ifdefSkip n m lexargs skip lexbuf
+
+ | LexCont.String (ifdefs, stringNest, style, kind, m) ->
+ lexargs.ifdefStack <- ifdefs
+ lexargs.stringNest <- stringNest
+ let buf = ByteBuffer.Create 100
+ let args = (buf, LexerStringFinisher.Default, m, kind, lexargs)
+ match style with
+ | LexerStringStyle.SingleQuote -> Lexer.singleQuoteString args skip lexbuf
+ | LexerStringStyle.Verbatim -> Lexer.verbatimString args skip lexbuf
+ | LexerStringStyle.TripleQuote -> Lexer.tripleQuoteString args skip lexbuf
+
+ | LexCont.Comment (ifdefs, stringNest, n, m) ->
+ lexargs.ifdefStack <- ifdefs
+ lexargs.stringNest <- stringNest
+ Lexer.comment (n, m, lexargs) skip lexbuf
+
+ | LexCont.SingleLineComment (ifdefs, stringNest, n, m) ->
+ lexargs.ifdefStack <- ifdefs
+ lexargs.stringNest <- stringNest
+ // The first argument is 'None' because we don't need XML comments when called from VS tokenizer
+ Lexer.singleLineComment (None, n, m, lexargs) skip lexbuf
+
+ | LexCont.StringInComment (ifdefs, stringNest, style, n, m) ->
+ lexargs.ifdefStack <- ifdefs
+ lexargs.stringNest <- stringNest
+ match style with
+ | LexerStringStyle.SingleQuote -> Lexer.stringInComment n m lexargs skip lexbuf
+ | LexerStringStyle.Verbatim -> Lexer.verbatimStringInComment n m lexargs skip lexbuf
+ | LexerStringStyle.TripleQuote -> Lexer.tripleQuoteStringInComment n m lexargs skip lexbuf
+
+ | LexCont.MLOnly (ifdefs, stringNest, m) ->
+ lexargs.ifdefStack <- ifdefs
+ lexargs.stringNest <- stringNest
+ Lexer.mlOnly m lexargs skip lexbuf
+
+ let columnsOfCurrentToken() =
+ let leftp = lexbuf.StartPos
+ let rightp = lexbuf.EndPos
+ let leftc = leftp.Column
+ let rightc =
+ match maxLength with
+ | Some mx when rightp.Line > leftp.Line -> mx
+ | _ -> rightp.Column
+ let rightc = rightc - 1
+ struct (leftc, rightc)
+
+ let getTokenWithPosition lexcont lightStatus =
+ // Column of token
+ // Get the token & position - either from a stack or from the lexer
+ try
+ if (tokenStack.Count > 0) then
+ true, tokenStack.Pop()
+ else
+ // Choose which lexer entry point to call and call it
+ let token = callLexCont lexcont lightStatus skip
+ let struct (leftc, rightc) = columnsOfCurrentToken()
+
+ // Splits tokens like ">." into multiple tokens - this duplicates behavior from the 'lexfilter'
+ // which cannot be (easily) used from the language service. The rules here are not always valid,
+ // because sometimes token shouldn't be split. However it is just for colorization &
+ // for VS (which needs to recognize when user types ".").
+ match token with
+ | HASH_IF (m, lineStr, cont) when lineStr <> "" ->
+ false, processHashIfLine m.StartColumn lineStr cont
+ | HASH_ELSE (m, lineStr, cont) when lineStr <> "" ->
+ false, processHashEndElse m.StartColumn lineStr 4 cont
+ | HASH_ENDIF (m, lineStr, cont) when lineStr <> "" ->
+ false, processHashEndElse m.StartColumn lineStr 5 cont
+ | RQUOTE_DOT (s, raw) ->
+ delayToken(DOT, rightc, rightc)
+ false, (RQUOTE (s, raw), leftc, rightc - 1)
+ | INFIX_COMPARE_OP (LexFilter.TyparsCloseOp(greaters, afterOp) as opstr) ->
+ match afterOp with
+ | None -> ()
+ | Some tok -> delayToken(tok, leftc + greaters.Length, rightc)
+ for i = greaters.Length - 1 downto 1 do
+ delayToken(greaters.[i] false, leftc + i, rightc - opstr.Length + i + 1)
+ false, (greaters.[0] false, leftc, rightc - opstr.Length + 1)
+ // break up any operators that start with '.' so that we can get auto-popup-completion for e.g. "x.+1" when typing the dot
+ | INFIX_STAR_STAR_OP opstr when opstr.StartsWithOrdinal(".") ->
+ delayToken(INFIX_STAR_STAR_OP(opstr.Substring 1), leftc+1, rightc)
+ false, (DOT, leftc, leftc)
+ | PLUS_MINUS_OP opstr when opstr.StartsWithOrdinal(".") ->
+ delayToken(PLUS_MINUS_OP(opstr.Substring 1), leftc+1, rightc)
+ false, (DOT, leftc, leftc)
+ | INFIX_COMPARE_OP opstr when opstr.StartsWithOrdinal(".") ->
+ delayToken(INFIX_COMPARE_OP(opstr.Substring 1), leftc+1, rightc)
+ false, (DOT, leftc, leftc)
+ | INFIX_AT_HAT_OP opstr when opstr.StartsWithOrdinal(".") ->
+ delayToken(INFIX_AT_HAT_OP(opstr.Substring 1), leftc+1, rightc)
+ false, (DOT, leftc, leftc)
+ | INFIX_BAR_OP opstr when opstr.StartsWithOrdinal(".") ->
+ delayToken(INFIX_BAR_OP(opstr.Substring 1), leftc+1, rightc)
+ false, (DOT, leftc, leftc)
+ | PREFIX_OP opstr when opstr.StartsWithOrdinal(".") ->
+ delayToken(PREFIX_OP(opstr.Substring 1), leftc+1, rightc)
+ false, (DOT, leftc, leftc)
+ | INFIX_STAR_DIV_MOD_OP opstr when opstr.StartsWithOrdinal(".") ->
+ delayToken(INFIX_STAR_DIV_MOD_OP(opstr.Substring 1), leftc+1, rightc)
+ false, (DOT, leftc, leftc)
+ | INFIX_AMP_OP opstr when opstr.StartsWithOrdinal(".") ->
+ delayToken(INFIX_AMP_OP(opstr.Substring 1), leftc+1, rightc)
+ false, (DOT, leftc, leftc)
+ | ADJACENT_PREFIX_OP opstr when opstr.StartsWithOrdinal(".") ->
+ delayToken(ADJACENT_PREFIX_OP(opstr.Substring 1), leftc+1, rightc)
+ false, (DOT, leftc, leftc)
+ | FUNKY_OPERATOR_NAME opstr when opstr.StartsWithOrdinal(".") ->
+ delayToken(FUNKY_OPERATOR_NAME(opstr.Substring 1), leftc+1, rightc)
+ false, (DOT, leftc, leftc)
+ | _ -> false, (token, leftc, rightc)
+ with _ ->
+ false, (EOF LexerStateEncoding.revertToDefaultLexCont, 0, 0)
+
+ // Scan a token starting with the given lexer state
+ member x.ScanToken (lexState: FSharpTokenizerLexState) : FSharpTokenInfo option * FSharpTokenizerLexState =
use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse
use unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> DiscardErrorsLogger)
- let lightSyntaxStatusInitial, lexcontInitial = LexerStateEncoding.decodeLexInt lexintInitial
- let lightSyntaxStatus = LightSyntaxStatus(lightSyntaxStatusInitial, false)
-
- // Build the arguments to the lexer function
- let lexargs = if lightSyntaxStatusInitial then lexArgsLightOn else lexArgsLightOff
-
- let GetTokenWithPosition lexcontInitial =
- // Column of token
- let ColumnsOfCurrentToken() =
- let leftp = lexbuf.StartPos
- let rightp = lexbuf.EndPos
- let leftc = leftp.Column
- let rightc =
- match maxLength with
- | Some mx when rightp.Line > leftp.Line -> mx
- | _ -> rightp.Column
- let rightc = rightc - 1
- struct (leftc, rightc)
-
- // Get the token & position - either from a stack or from the lexer
- try
- if (tokenStack.Count > 0) then true, tokenStack.Pop()
- else
- // Choose which lexer entry point to call and call it
- let token = LexerStateEncoding.callLexCont lexcontInitial lexargs skip lexbuf
- let struct (leftc, rightc) = ColumnsOfCurrentToken()
-
- // Splits tokens like ">." into multiple tokens - this duplicates behavior from the 'lexfilter'
- // which cannot be (easily) used from the language service. The rules here are not always valid,
- // because sometimes token shouldn't be split. However it is just for colorization &
- // for VS (which needs to recognize when user types ".").
- match token with
- | HASH_IF (m, lineStr, cont) when lineStr <> "" ->
- false, processHashIfLine m.StartColumn lineStr cont
- | HASH_ELSE (m, lineStr, cont) when lineStr <> "" ->
- false, processHashEndElse m.StartColumn lineStr 4 cont
- | HASH_ENDIF (m, lineStr, cont) when lineStr <> "" ->
- false, processHashEndElse m.StartColumn lineStr 5 cont
- | RQUOTE_DOT (s, raw) ->
- delayToken(DOT, rightc, rightc)
- false, (RQUOTE (s, raw), leftc, rightc - 1)
- | INFIX_COMPARE_OP (LexFilter.TyparsCloseOp(greaters, afterOp) as opstr) ->
- match afterOp with
- | None -> ()
- | Some tok -> delayToken(tok, leftc + greaters.Length, rightc)
- for i = greaters.Length - 1 downto 1 do
- delayToken(greaters.[i] false, leftc + i, rightc - opstr.Length + i + 1)
- false, (greaters.[0] false, leftc, rightc - opstr.Length + 1)
- // break up any operators that start with '.' so that we can get auto-popup-completion for e.g. "x.+1" when typing the dot
- | INFIX_STAR_STAR_OP opstr when opstr.StartsWithOrdinal(".") ->
- delayToken(INFIX_STAR_STAR_OP(opstr.Substring 1), leftc+1, rightc)
- false, (DOT, leftc, leftc)
- | PLUS_MINUS_OP opstr when opstr.StartsWithOrdinal(".") ->
- delayToken(PLUS_MINUS_OP(opstr.Substring 1), leftc+1, rightc)
- false, (DOT, leftc, leftc)
- | INFIX_COMPARE_OP opstr when opstr.StartsWithOrdinal(".") ->
- delayToken(INFIX_COMPARE_OP(opstr.Substring 1), leftc+1, rightc)
- false, (DOT, leftc, leftc)
- | INFIX_AT_HAT_OP opstr when opstr.StartsWithOrdinal(".") ->
- delayToken(INFIX_AT_HAT_OP(opstr.Substring 1), leftc+1, rightc)
- false, (DOT, leftc, leftc)
- | INFIX_BAR_OP opstr when opstr.StartsWithOrdinal(".") ->
- delayToken(INFIX_BAR_OP(opstr.Substring 1), leftc+1, rightc)
- false, (DOT, leftc, leftc)
- | PREFIX_OP opstr when opstr.StartsWithOrdinal(".") ->
- delayToken(PREFIX_OP(opstr.Substring 1), leftc+1, rightc)
- false, (DOT, leftc, leftc)
- | INFIX_STAR_DIV_MOD_OP opstr when opstr.StartsWithOrdinal(".") ->
- delayToken(INFIX_STAR_DIV_MOD_OP(opstr.Substring 1), leftc+1, rightc)
- false, (DOT, leftc, leftc)
- | INFIX_AMP_OP opstr when opstr.StartsWithOrdinal(".") ->
- delayToken(INFIX_AMP_OP(opstr.Substring 1), leftc+1, rightc)
- false, (DOT, leftc, leftc)
- | ADJACENT_PREFIX_OP opstr when opstr.StartsWithOrdinal(".") ->
- delayToken(ADJACENT_PREFIX_OP(opstr.Substring 1), leftc+1, rightc)
- false, (DOT, leftc, leftc)
- | FUNKY_OPERATOR_NAME opstr when opstr.StartsWithOrdinal(".") ->
- delayToken(FUNKY_OPERATOR_NAME(opstr.Substring 1), leftc+1, rightc)
- false, (DOT, leftc, leftc)
- | _ -> false, (token, leftc, rightc)
- with
- | e -> false, (EOF LexerStateEncoding.revertToDefaultLexCont, 0, 0) // REVIEW: report lex failure here
+ let lightStatus, lexcont = LexerStateEncoding.decodeLexInt lexState
+ let lightStatus = LightSyntaxStatus(lightStatus, false)
// Grab a token
- let isCached, (token, leftc, rightc) = GetTokenWithPosition lexcontInitial
+ let isCached, (token, leftc, rightc) = getTokenWithPosition lexcont lightStatus
// Check for end-of-string and failure
let tokenDataOption, lexcontFinal, tokenTag =
@@ -696,13 +841,20 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf,
| _ ->
// Get the information about the token
let (colorClass, charClass, triggerClass) = TokenClassifications.tokenInfo token
+
let lexcontFinal =
// If we're using token from cache, we don't move forward with lexing
- if isCached then lexcontInitial else LexerStateEncoding.computeNextLexState token lexcontInitial
+ if isCached then lexcont
+ else LexerStateEncoding.computeNextLexState token lexcont
+
let tokenTag = tagOfToken token
+
+ let tokenName = token_to_string token
+
let fullMatchedLength = lexbuf.EndPos.AbsoluteOffset - lexbuf.StartPos.AbsoluteOffset
+
let tokenData =
- { TokenName = token_to_string token
+ { TokenName = tokenName
LeftColumn=leftc
RightColumn=rightc
ColorClass=colorClass
@@ -712,19 +864,15 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf,
FullMatchedLength=fullMatchedLength}
Some tokenData, lexcontFinal, tokenTag
- // Get the final lex int and color state
- let FinalState lexcontFinal =
- LexerStateEncoding.encodeLexInt lightSyntaxStatus.Status lexcontFinal
-
// Check for patterns like #-IDENT and see if they look like meta commands for .fsx files. If they do then merge them into a single token.
let tokenDataOption, lexintFinal =
- let lexintFinal = FinalState lexcontFinal
+ let lexintFinal = LexerStateEncoding.encodeLexInt lightStatus.Status lexcontFinal
match tokenDataOption, singleLineTokenState, tokenTagToTokenId tokenTag with
| Some tokenData, SingleLineTokenState.BeforeHash, TOKEN_HASH ->
// Don't allow further matches.
singleLineTokenState <- SingleLineTokenState.NoFurtherMatchPossible
// Peek at the next token
- let isCached, (nextToken, _, rightc) = GetTokenWithPosition lexcontInitial
+ let isCached, (nextToken, _, rightc) = getTokenWithPosition lexcont lightStatus
match nextToken with
| IDENT possibleMetaCommand ->
match fsx, possibleMetaCommand with
@@ -749,9 +897,9 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf,
// These are for script and non-script
| _, "nowarn" ->
// Merge both tokens into one.
- let lexcontFinal = if isCached then lexcontInitial else LexerStateEncoding.computeNextLexState token lexcontInitial
+ let lexcontFinal = if isCached then lexcont else LexerStateEncoding.computeNextLexState token lexcont
let tokenData = {tokenData with RightColumn=rightc;ColorClass=FSharpTokenColorKind.PreprocessorKeyword;CharClass=FSharpTokenCharKind.Keyword;FSharpTokenTriggerClass=FSharpTokenTriggerClass.None}
- let lexintFinal = FinalState lexcontFinal
+ let lexintFinal = LexerStateEncoding.encodeLexInt lightStatus.Status lexcontFinal
Some tokenData, lexintFinal
| _ -> tokenDataOption, lexintFinal
| _ -> tokenDataOption, lexintFinal
@@ -779,16 +927,15 @@ type FSharpSourceTokenizer(defineConstants: string list, filename: string option
let lexResourceManager = new Lexhelp.LexResourceManager()
- let lexArgsLightOn = mkLexargs(filename, defineConstants, LightSyntaxStatus(true, false), lexResourceManager, [], DiscardErrorsLogger, PathMap.empty)
- let lexArgsLightOff = mkLexargs(filename, defineConstants, LightSyntaxStatus(false, false), lexResourceManager, [], DiscardErrorsLogger, PathMap.empty)
+ let lexargs = mkLexargs(defineConstants, LightSyntaxStatus(true, false), lexResourceManager, [], DiscardErrorsLogger, PathMap.empty)
- member this.CreateLineTokenizer(lineText: string) =
+ member _.CreateLineTokenizer(lineText: string) =
let lexbuf = UnicodeLexing.StringAsLexbuf(isFeatureSupported, lineText)
- FSharpLineTokenizer(lexbuf, Some lineText.Length, filename, lexArgsLightOn, lexArgsLightOff)
+ FSharpLineTokenizer(lexbuf, Some lineText.Length, filename, lexargs)
- member this.CreateBufferTokenizer bufferFiller =
+ member _.CreateBufferTokenizer bufferFiller =
let lexbuf = UnicodeLexing.FunctionAsLexbuf(isFeatureSupported, bufferFiller)
- FSharpLineTokenizer(lexbuf, None, filename, lexArgsLightOn, lexArgsLightOff)
+ FSharpLineTokenizer(lexbuf, None, filename, lexargs)
module Keywords =
open FSharp.Compiler.Lexhelp.Keywords
@@ -801,14 +948,7 @@ module Keywords =
module Lexer =
open System.Threading
- open FSharp.Compiler.Features
- open FSharp.Compiler.Lexhelp
- open FSharp.Compiler.Parser
- open FSharp.Compiler.Range
- open FSharp.Compiler.SyntaxTree
open FSharp.Compiler.Text
- open FSharp.Compiler.UnicodeLexing
- open Internal.Utilities
[]
type FSharpLexerFlags =
@@ -1082,7 +1222,7 @@ module Lexer =
| SIG -> FSharpSyntaxTokenKind.Sig
| BAR -> FSharpSyntaxTokenKind.Bar
| RBRACK -> FSharpSyntaxTokenKind.RightBracket
- | RBRACE -> FSharpSyntaxTokenKind.RightBrace
+ | RBRACE _ -> FSharpSyntaxTokenKind.RightBrace
| MINUS -> FSharpSyntaxTokenKind.Minus
| DOLLAR -> FSharpSyntaxTokenKind.Dollar
| BAR_RBRACK -> FSharpSyntaxTokenKind.BarRightBracket
@@ -1095,7 +1235,7 @@ module Lexer =
| LBRACK_BAR -> FSharpSyntaxTokenKind.LeftBracketBar
| LBRACE_BAR -> FSharpSyntaxTokenKind.LeftBraceBar
| LBRACK_LESS -> FSharpSyntaxTokenKind.LeftBracketLess
- | LBRACE -> FSharpSyntaxTokenKind.LeftBrace
+ | LBRACE _ -> FSharpSyntaxTokenKind.LeftBrace
| QMARK -> FSharpSyntaxTokenKind.QuestionMark
| QMARK_QMARK -> FSharpSyntaxTokenKind.QuestionMarkQuestionMark
| DOT -> FSharpSyntaxTokenKind.Dot
@@ -1211,6 +1351,10 @@ module Lexer =
| INFIX_STAR_STAR_OP _ -> FSharpSyntaxTokenKind.InfixStarStarOperator
| IDENT _ -> FSharpSyntaxTokenKind.Identifier
| KEYWORD_STRING _ -> FSharpSyntaxTokenKind.KeywordString
+ | INTERP_STRING_BEGIN_END _
+ | INTERP_STRING_BEGIN_PART _
+ | INTERP_STRING_PART _
+ | INTERP_STRING_END _
| STRING _ -> FSharpSyntaxTokenKind.String
| BYTEARRAY _ -> FSharpSyntaxTokenKind.ByteArray
| _ -> FSharpSyntaxTokenKind.None
@@ -1367,7 +1511,7 @@ module Lexer =
| FSharpSyntaxTokenKind.LineCommentTrivia -> true
| _ -> false
- let lexWithErrorLogger (text: ISourceText) (filePath: string) conditionalCompilationDefines (flags: FSharpLexerFlags) supportsFeature errorLogger onToken pathMap (ct: CancellationToken) =
+ let lexWithErrorLogger (text: ISourceText) conditionalCompilationDefines (flags: FSharpLexerFlags) supportsFeature errorLogger onToken pathMap (ct: CancellationToken) =
let canSkipTrivia = (flags &&& FSharpLexerFlags.SkipTrivia) = FSharpLexerFlags.SkipTrivia
let isLightSyntaxOn = (flags &&& FSharpLexerFlags.LightSyntaxOn) = FSharpLexerFlags.LightSyntaxOn
let isCompiling = (flags &&& FSharpLexerFlags.Compiling) = FSharpLexerFlags.Compiling
@@ -1375,15 +1519,15 @@ module Lexer =
let canUseLexFilter = (flags &&& FSharpLexerFlags.UseLexFilter) = FSharpLexerFlags.UseLexFilter
let lexbuf = UnicodeLexing.SourceTextAsLexbuf(supportsFeature, text)
- let lightSyntaxStatus = LightSyntaxStatus(isLightSyntaxOn, true)
- let lexargs = mkLexargs (filePath, conditionalCompilationDefines, lightSyntaxStatus, Lexhelp.LexResourceManager(0), [], errorLogger, pathMap)
+ let lightStatus = LightSyntaxStatus(isLightSyntaxOn, true)
+ let lexargs = mkLexargs (conditionalCompilationDefines, lightStatus, Lexhelp.LexResourceManager(0), [], errorLogger, pathMap)
let lexargs = { lexargs with applyLineDirectives = isCompiling }
let getNextToken =
let lexer = Lexer.token lexargs canSkipTrivia
if canUseLexFilter then
- LexFilter.LexFilter(lexargs.lightSyntaxStatus, isCompilingFSharpCore, lexer, lexbuf).Lexer
+ LexFilter.LexFilter(lexargs.lightStatus, isCompilingFSharpCore, lexer, lexbuf).Lexer
else
lexer
@@ -1394,17 +1538,17 @@ module Lexer =
ct.ThrowIfCancellationRequested ()
onToken (getNextToken lexbuf) lexbuf.LexemeRange
- let lex text filePath conditionalCompilationDefines flags supportsFeature lexCallback pathMap ct =
+ let lex text conditionalCompilationDefines flags supportsFeature lexCallback pathMap ct =
let errorLogger = CompilationErrorLogger("Lexer", ErrorLogger.FSharpErrorSeverityOptions.Default)
- lexWithErrorLogger text filePath conditionalCompilationDefines flags supportsFeature errorLogger lexCallback pathMap ct
+ lexWithErrorLogger text conditionalCompilationDefines flags supportsFeature errorLogger lexCallback pathMap ct
[]
type FSharpLexer =
- static member Lex(text: ISourceText, tokenCallback, ?langVersion, ?filePath, ?conditionalCompilationDefines, ?flags, ?pathMap, ?ct) =
+ static member Lex(text: ISourceText, tokenCallback, ?langVersion, ?filePath: string, ?conditionalCompilationDefines, ?flags, ?pathMap, ?ct) =
let langVersion = defaultArg langVersion "latestmajor"
let flags = defaultArg flags FSharpLexerFlags.Default
- let filePath = defaultArg filePath String.Empty
+ ignore filePath // can be removed at later point
let conditionalCompilationDefines = defaultArg conditionalCompilationDefines []
let pathMap = defaultArg pathMap Map.Empty
let ct = defaultArg ct CancellationToken.None
@@ -1422,4 +1566,4 @@ module Lexer =
| FSharpSyntaxTokenKind.None -> ()
| _ -> tokenCallback fsTok
- lex text filePath conditionalCompilationDefines flags supportsFeature onToken pathMap ct
\ No newline at end of file
+ lex text conditionalCompilationDefines flags supportsFeature onToken pathMap ct
\ No newline at end of file
diff --git a/src/fsharp/service/ServiceLexing.fsi b/src/fsharp/service/ServiceLexing.fsi
index 5bd784e9e42..9e05df2732d 100755
--- a/src/fsharp/service/ServiceLexing.fsi
+++ b/src/fsharp/service/ServiceLexing.fsi
@@ -86,8 +86,16 @@ module FSharpTokenTag =
val String : int
/// Indicates the token is an identifier (synonym for FSharpTokenTag.Identifier)
val IDENT : int
- /// Indicates the token is an string (synonym for FSharpTokenTag.String)
+ /// Indicates the token is a string (synonym for FSharpTokenTag.String)
val STRING : int
+ /// Indicates the token is a part of an interpolated string
+ val INTERP_STRING_BEGIN_END : int
+ /// Indicates the token is a part of an interpolated string
+ val INTERP_STRING_BEGIN_PART : int
+ /// Indicates the token is a part of an interpolated string
+ val INTERP_STRING_PART : int
+ /// Indicates the token is a part of an interpolated string
+ val INTERP_STRING_END : int
/// Indicates the token is a `(`
val LPAREN : int
/// Indicates the token is a `)`
@@ -236,15 +244,29 @@ type FSharpTokenInfo =
[]
type FSharpLineTokenizer =
/// Scan one token from the line
- member ScanToken : lexState:FSharpTokenizerLexState -> FSharpTokenInfo option * FSharpTokenizerLexState
- static member ColorStateOfLexState : FSharpTokenizerLexState -> FSharpTokenizerColorState
- static member LexStateOfColorState : FSharpTokenizerColorState -> FSharpTokenizerLexState
+ member ScanToken: lexState:FSharpTokenizerLexState -> FSharpTokenInfo option * FSharpTokenizerLexState
+
+ /// Get the color state from the lexer state
+ static member ColorStateOfLexState: FSharpTokenizerLexState -> FSharpTokenizerColorState
+
+ /// Get a default lexer state for a color state.
+ ///
+ /// NOTE: This may result in an inaccurate lexer state
+ /// not taking into account things such as the #if/#endif and string interpolation context
+ /// within the file
+ static member LexStateOfColorState: FSharpTokenizerColorState -> FSharpTokenizerLexState
/// Tokenizer for a source file. Holds some expensive-to-compute resources at the scope of the file.
[]
type FSharpSourceTokenizer =
+
+ /// Create a tokenizer for a source file.
new : conditionalDefines:string list * fileName:string option -> FSharpSourceTokenizer
- member CreateLineTokenizer : lineText:string -> FSharpLineTokenizer
+
+ /// Create a tokenizer for a line of this source file
+ member CreateLineTokenizer: lineText:string -> FSharpLineTokenizer
+
+ /// Create a tokenizer for a line of this source file using a buffer filler
member CreateBufferTokenizer : bufferFiller:(char[] * int * int -> int) -> FSharpLineTokenizer
module internal TestExpose =
diff --git a/src/fsharp/service/ServiceParseTreeWalk.fs b/src/fsharp/service/ServiceParseTreeWalk.fs
index 698776bc014..2d5d1729d97 100755
--- a/src/fsharp/service/ServiceParseTreeWalk.fs
+++ b/src/fsharp/service/ServiceParseTreeWalk.fs
@@ -201,15 +201,30 @@ module public AstTraversal =
let path = TraverseStep.Expr e :: path
let traverseSynExpr = traverseSynExpr path
match e with
+
| SynExpr.Paren (synExpr, _, _, _parenRange) -> traverseSynExpr synExpr
+
| SynExpr.Quote (_synExpr, _, synExpr2, _, _range) ->
[//dive synExpr synExpr.Range traverseSynExpr // TODO, what is this?
dive synExpr2 synExpr2.Range traverseSynExpr]
|> pick expr
+
| SynExpr.Const (_synConst, _range) -> None
- | SynExpr.Typed (synExpr, synType, _range) -> [ traverseSynExpr synExpr; traverseSynType synType ] |> List.tryPick id
+
+ | SynExpr.InterpolatedString (parts, _) ->
+ [ for part in parts do
+ match part with
+ | SynInterpolatedStringPart.String _ -> ()
+ | SynInterpolatedStringPart.FillExpr (fillExpr, _) ->
+ yield dive fillExpr fillExpr.Range traverseSynExpr ]
+ |> pick expr
+
+ | SynExpr.Typed (synExpr, synType, _range) ->
+ [ traverseSynExpr synExpr; traverseSynType synType ] |> List.tryPick id
+
| SynExpr.Tuple (_, synExprList, _, _range)
- | SynExpr.ArrayOrList (_, synExprList, _range) -> synExprList |> List.map (fun x -> dive x x.Range traverseSynExpr) |> pick expr
+ | SynExpr.ArrayOrList (_, synExprList, _range) ->
+ synExprList |> List.map (fun x -> dive x x.Range traverseSynExpr) |> pick expr
| SynExpr.AnonRecd (_isStruct, copyOpt, synExprList, _range) ->
[ match copyOpt with
@@ -227,6 +242,7 @@ module public AstTraversal =
for (_,x) in synExprList do
yield dive x x.Range traverseSynExpr
] |> pick expr
+
| SynExpr.Record (inheritOpt,copyOpt,fields, _range) ->
[
let diveIntoSeparator offsideColumn scPosOpt copyOpt =
@@ -313,6 +329,7 @@ module public AstTraversal =
| _ -> ()
] |> pick expr
+
| SynExpr.New (_, _synType, synExpr, _range) -> traverseSynExpr synExpr
| SynExpr.ObjExpr (ty,baseCallOpt,binds,ifaces,_range1,_range2) ->
let result =
@@ -336,21 +353,26 @@ module public AstTraversal =
for b in binds do
yield dive b b.RangeOfBindingAndRhs (traverseSynBinding path)
] |> pick expr
+
| SynExpr.While (_sequencePointInfoForWhileLoop, synExpr, synExpr2, _range) ->
[dive synExpr synExpr.Range traverseSynExpr
dive synExpr2 synExpr2.Range traverseSynExpr]
|> pick expr
+
| SynExpr.For (_sequencePointInfoForForLoop, _ident, synExpr, _, synExpr2, synExpr3, _range) ->
[dive synExpr synExpr.Range traverseSynExpr
dive synExpr2 synExpr2.Range traverseSynExpr
dive synExpr3 synExpr3.Range traverseSynExpr]
|> pick expr
+
| SynExpr.ForEach (_sequencePointInfoForForLoop, _seqExprOnly, _isFromSource, synPat, synExpr, synExpr2, _range) ->
[dive synPat synPat.Range traversePat
dive synExpr synExpr.Range traverseSynExpr
dive synExpr2 synExpr2.Range traverseSynExpr]
|> pick expr
+
| SynExpr.ArrayOrListOfSeqExpr (_, synExpr, _range) -> traverseSynExpr synExpr
+
| SynExpr.CompExpr (_, _, synExpr, _range) ->
// now parser treats this syntactic expression as computation expression
// { identifier }
@@ -368,6 +390,7 @@ module public AstTraversal =
if ok.IsSome then ok
else
traverseSynExpr synExpr
+
| SynExpr.Lambda (_, _, synSimplePats, synExpr, _range) ->
match synSimplePats with
| SynSimplePats.SimplePats(pats,_) ->
@@ -375,17 +398,23 @@ module public AstTraversal =
| Some x -> Some x
| None -> traverseSynExpr synExpr
| _ -> traverseSynExpr synExpr
+
| SynExpr.MatchLambda (_isExnMatch,_argm,synMatchClauseList,_spBind,_wholem) ->
synMatchClauseList
|> List.map (fun x -> dive x x.Range (traverseSynMatchClause path))
|> pick expr
+
| SynExpr.Match (_sequencePointInfoForBinding, synExpr, synMatchClauseList, _range) ->
[yield dive synExpr synExpr.Range traverseSynExpr
yield! synMatchClauseList |> List.map (fun x -> dive x x.RangeOfGuardAndRhs (traverseSynMatchClause path))]
|> pick expr
+
| SynExpr.Do (synExpr, _range) -> traverseSynExpr synExpr
+
| SynExpr.Assert (synExpr, _range) -> traverseSynExpr synExpr
+
| SynExpr.Fixed (synExpr, _range) -> traverseSynExpr synExpr
+
| SynExpr.App (_exprAtomicFlag, isInfix, synExpr, synExpr2, _range) ->
if isInfix then
[dive synExpr2 synExpr2.Range traverseSynExpr
@@ -395,7 +424,9 @@ module public AstTraversal =
[dive synExpr synExpr.Range traverseSynExpr
dive synExpr2 synExpr2.Range traverseSynExpr]
|> pick expr
+
| SynExpr.TypeApp (synExpr, _, _synTypeList, _commas, _, _, _range) -> traverseSynExpr synExpr
+
| SynExpr.LetOrUse (_, _, synBindingList, synExpr, range) ->
match visitor.VisitLetOrUse(path, traverseSynBinding path, synBindingList, range) with
| Some x -> Some x
@@ -403,20 +434,26 @@ module public AstTraversal =
[yield! synBindingList |> List.map (fun x -> dive x x.RangeOfBindingAndRhs (traverseSynBinding path))
yield dive synExpr synExpr.Range traverseSynExpr]
|> pick expr
+
| SynExpr.TryWith (synExpr, _range, synMatchClauseList, _range2, _range3, _sequencePointInfoForTry, _sequencePointInfoForWith) ->
[yield dive synExpr synExpr.Range traverseSynExpr
yield! synMatchClauseList |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path))]
|> pick expr
+
| SynExpr.TryFinally (synExpr, synExpr2, _range, _sequencePointInfoForTry, _sequencePointInfoForFinally) ->
[dive synExpr synExpr.Range traverseSynExpr
dive synExpr2 synExpr2.Range traverseSynExpr]
|> pick expr
+
| SynExpr.Lazy (synExpr, _range) -> traverseSynExpr synExpr
+
| SynExpr.SequentialOrImplicitYield (_sequencePointInfoForSequential, synExpr, synExpr2, _, _range)
+
| SynExpr.Sequential (_sequencePointInfoForSequential, _, synExpr, synExpr2, _range) ->
[dive synExpr synExpr.Range traverseSynExpr
dive synExpr2 synExpr2.Range traverseSynExpr]
|> pick expr
+
| SynExpr.IfThenElse (synExpr, synExpr2, synExprOpt, _sequencePointInfoForBinding, _isRecovery, _range, _range2) ->
[yield dive synExpr synExpr.Range traverseSynExpr
yield dive synExpr2 synExpr2.Range traverseSynExpr
@@ -424,21 +461,29 @@ module public AstTraversal =
| None -> ()
| Some(x) -> yield dive x x.Range traverseSynExpr]
|> pick expr
+
| SynExpr.Ident (_ident) -> None
+
| SynExpr.LongIdent (_, _longIdent, _altNameRefCell, _range) -> None
+
| SynExpr.LongIdentSet (_longIdent, synExpr, _range) -> traverseSynExpr synExpr
+
| SynExpr.DotGet (synExpr, _dotm, _longIdent, _range) -> traverseSynExpr synExpr
+
| SynExpr.Set (synExpr, synExpr2, _)
+
| SynExpr.DotSet (synExpr, _, synExpr2, _) ->
[dive synExpr synExpr.Range traverseSynExpr
dive synExpr2 synExpr2.Range traverseSynExpr]
|> pick expr
+
| SynExpr.DotIndexedGet (synExpr, synExprList, _range, _range2) ->
[yield dive synExpr synExpr.Range traverseSynExpr
for synExpr in synExprList do
for x in synExpr.Exprs do
yield dive x x.Range traverseSynExpr]
|> pick expr
+
| SynExpr.DotIndexedSet (synExpr, synExprList, synExpr2, _, _range, _range2) ->
[yield dive synExpr synExpr.Range traverseSynExpr
for synExpr in synExprList do
@@ -446,33 +491,48 @@ module public AstTraversal =
yield dive x x.Range traverseSynExpr
yield dive synExpr2 synExpr2.Range traverseSynExpr]
|> pick expr
+
| SynExpr.JoinIn (synExpr1, _range, synExpr2, _range2) ->
[dive synExpr1 synExpr1.Range traverseSynExpr
dive synExpr2 synExpr2.Range traverseSynExpr]
|> pick expr
+
| SynExpr.NamedIndexedPropertySet (_longIdent, synExpr, synExpr2, _range) ->
[dive synExpr synExpr.Range traverseSynExpr
dive synExpr2 synExpr2.Range traverseSynExpr]
|> pick expr
+
| SynExpr.DotNamedIndexedPropertySet (synExpr, _longIdent, synExpr2, synExpr3, _range) ->
[dive synExpr synExpr.Range traverseSynExpr
dive synExpr2 synExpr2.Range traverseSynExpr
dive synExpr3 synExpr3.Range traverseSynExpr]
|> pick expr
+
| SynExpr.TypeTest (synExpr, synType, _range)
+
| SynExpr.Upcast (synExpr, synType, _range)
+
| SynExpr.Downcast (synExpr, synType, _range) ->
[dive synExpr synExpr.Range traverseSynExpr
dive synType synType.Range traverseSynType]
|> pick expr
+
| SynExpr.InferredUpcast (synExpr, _range) -> traverseSynExpr synExpr
+
| SynExpr.InferredDowncast (synExpr, _range) -> traverseSynExpr synExpr
+
| SynExpr.Null (_range) -> None
+
| SynExpr.AddressOf (_, synExpr, _range, _range2) -> traverseSynExpr synExpr
+
| SynExpr.TraitCall (_synTyparList, _synMemberSig, synExpr, _range) -> traverseSynExpr synExpr
+
| SynExpr.ImplicitZero (_range) -> None
+
| SynExpr.YieldOrReturn (_, synExpr, _range) -> traverseSynExpr synExpr
+
| SynExpr.YieldOrReturnFrom (_, synExpr, _range) -> traverseSynExpr synExpr
+
| SynExpr.LetOrUseBang(_sequencePointInfoForBinding, _, _, synPat, synExpr, andBangSynExprs, synExpr2, _range) ->
[
yield dive synPat synPat.Range traversePat
@@ -484,17 +544,26 @@ module public AstTraversal =
yield dive synExpr2 synExpr2.Range traverseSynExpr
]
|> pick expr
+
| SynExpr.MatchBang (_sequencePointInfoForBinding, synExpr, synMatchClauseList, _range) ->
[yield dive synExpr synExpr.Range traverseSynExpr
yield! synMatchClauseList |> List.map (fun x -> dive x x.RangeOfGuardAndRhs (traverseSynMatchClause path))]
|> pick expr
+
| SynExpr.DoBang (synExpr, _range) -> traverseSynExpr synExpr
+
| SynExpr.LibraryOnlyILAssembly _ -> None
+
| SynExpr.LibraryOnlyStaticOptimization _ -> None
+
| SynExpr.LibraryOnlyUnionCaseFieldGet _ -> None
+
| SynExpr.LibraryOnlyUnionCaseFieldSet _ -> None
+
| SynExpr.ArbitraryAfterError (_debugStr, _range) -> None
+
| SynExpr.FromParseError (synExpr, _range) -> traverseSynExpr synExpr
+
| SynExpr.DiscardAfterMissingQualificationAfterDot (synExpr, _range) -> traverseSynExpr synExpr
visitor.VisitExpr(path, traverseSynExpr path, defaultTraverse, expr)
diff --git a/src/fsharp/service/ServiceUntypedParse.fs b/src/fsharp/service/ServiceUntypedParse.fs
index b9902e67f46..02054ef540a 100755
--- a/src/fsharp/service/ServiceUntypedParse.fs
+++ b/src/fsharp/service/ServiceUntypedParse.fs
@@ -209,6 +209,12 @@ type FSharpParseFileResults(errors: FSharpErrorInfo[], input: ParsedInput option
| SynExpr.Paren (e, _, _, _) ->
yield! walkExpr false e
+ | SynExpr.InterpolatedString (parts, _) ->
+ yield! walkExprs [ for part in parts do
+ match part with
+ | SynInterpolatedStringPart.String _ -> ()
+ | SynInterpolatedStringPart.FillExpr (fillExpr, _) -> yield fillExpr ]
+
| SynExpr.YieldOrReturn (_, e, _)
| SynExpr.YieldOrReturnFrom (_, e, _)
| SynExpr.DoBang (e, _) ->
diff --git a/tests/FSharp.Compiler.UnitTests/FSharp.Compiler.UnitTests.fsproj b/tests/FSharp.Compiler.UnitTests/FSharp.Compiler.UnitTests.fsproj
index eac6510990d..27f0a5f4cf1 100644
--- a/tests/FSharp.Compiler.UnitTests/FSharp.Compiler.UnitTests.fsproj
+++ b/tests/FSharp.Compiler.UnitTests/FSharp.Compiler.UnitTests.fsproj
@@ -7,6 +7,7 @@
netcoreapp3.1
Library
true
+ $(DefineConstants);ASSUME_PREVIEW_FSHARP_CORE
xunit
$(NoWarn);3186;1104
@@ -21,12 +22,64 @@
+
+ CompilerService\FsUnit.fs
+
+
+ CompilerService\Common.fs
+
+
+ CompilerService\Symbols.fs
+
+
+ CompilerService\EditorTests.fs
+
+
+ CompilerService\FileSystemTests.fs
+
+
+ CompilerService\ProjectAnalysisTests.fs
+
+
+ CompilerService\TokenizerTests.fs
+
+
+
+ CompilerService\PerfTests.fs
+
+
+ CompilerService\InteractiveCheckerTests.fs
+
+
+ CompilerService\ExprTests.fs
+
+
+ CompilerService\CSharpProjectAnalysis.fs
+
+
+ CompilerService\StructureTests.fs
+
+
+ CompilerService\AssemblyContentProviderTests.fs
+
+
+ CompilerService\ServiceUntypedParseTests.fs
+
+
+ CompilerService\TreeVisitorTests.fs
+
+
+
diff --git a/tests/FSharp.Compiler.UnitTests/HashIfExpression.fs b/tests/FSharp.Compiler.UnitTests/HashIfExpression.fs
index 6481801adb3..705ce465b1d 100644
--- a/tests/FSharp.Compiler.UnitTests/HashIfExpression.fs
+++ b/tests/FSharp.Compiler.UnitTests/HashIfExpression.fs
@@ -49,21 +49,21 @@ type public HashIfExpression() =
sb.ToString ()
let createParser () =
- let errors = ResizeArray()
- let warnings = ResizeArray()
+ let errors = ResizeArray()
+ let warnings = ResizeArray()
- let errorLogger =
+ let errorLogger =
{
new ErrorLogger("TestErrorLogger") with
member x.DiagnosticSink(e, isError) = if isError then errors.Add e else warnings.Add e
member x.ErrorCount = errors.Count
}
- let lightSyntax = LightSyntaxStatus(true, false)
+ let lightSyntax = LightSyntaxStatus(true, false)
let resourceManager = LexResourceManager ()
- let defines = []
- let startPos = Position.Empty
- let args = mkLexargs ("dummy", defines, lightSyntax, resourceManager, [], errorLogger, PathMap.empty)
+ let defines= []
+ let startPos = Position.Empty
+ let args = mkLexargs (defines, lightSyntax, resourceManager, [], errorLogger, PathMap.empty)
CompileThreadStatic.ErrorLogger <- errorLogger
diff --git a/tests/FSharp.Core.UnitTests/SurfaceArea.fs b/tests/FSharp.Core.UnitTests/SurfaceArea.fs
index 5f6fa5cc7f0..75e66bbb0a6 100644
--- a/tests/FSharp.Core.UnitTests/SurfaceArea.fs
+++ b/tests/FSharp.Core.UnitTests/SurfaceArea.fs
@@ -2235,10 +2235,20 @@ Microsoft.FSharp.Core.PrintfFormat`4[TPrinter,TState,TResidue,TResult]: System.S
Microsoft.FSharp.Core.PrintfFormat`4[TPrinter,TState,TResidue,TResult]: System.String Value
Microsoft.FSharp.Core.PrintfFormat`4[TPrinter,TState,TResidue,TResult]: System.String get_Value()
Microsoft.FSharp.Core.PrintfFormat`4[TPrinter,TState,TResidue,TResult]: Void .ctor(System.String)
+Microsoft.FSharp.Core.PrintfFormat`4[TPrinter,TState,TResidue,TResult]: Void .ctor(System.String, System.Object[], System.Type[])
+Microsoft.FSharp.Core.PrintfFormat`4[TPrinter,TState,TResidue,TResult]: System.Object[] Captures
+Microsoft.FSharp.Core.PrintfFormat`4[TPrinter,TState,TResidue,TResult]: System.Object[] get_Captures()
+Microsoft.FSharp.Core.PrintfFormat`4[TPrinter,TState,TResidue,TResult]: System.Type[] CaptureTypes
+Microsoft.FSharp.Core.PrintfFormat`4[TPrinter,TState,TResidue,TResult]: System.Type[] get_CaptureTypes()
Microsoft.FSharp.Core.PrintfFormat`5[TPrinter,TState,TResidue,TResult,TTuple]: System.String ToString()
Microsoft.FSharp.Core.PrintfFormat`5[TPrinter,TState,TResidue,TResult,TTuple]: System.String Value
Microsoft.FSharp.Core.PrintfFormat`5[TPrinter,TState,TResidue,TResult,TTuple]: System.String get_Value()
Microsoft.FSharp.Core.PrintfFormat`5[TPrinter,TState,TResidue,TResult,TTuple]: Void .ctor(System.String)
+Microsoft.FSharp.Core.PrintfFormat`5[TPrinter,TState,TResidue,TResult,TTuple]: Void .ctor(System.String, System.Object[], System.Type[])
+Microsoft.FSharp.Core.PrintfFormat`5[TPrinter,TState,TResidue,TResult,TTuple]: System.Object[] Captures
+Microsoft.FSharp.Core.PrintfFormat`5[TPrinter,TState,TResidue,TResult,TTuple]: System.Object[] get_Captures()
+Microsoft.FSharp.Core.PrintfFormat`5[TPrinter,TState,TResidue,TResult,TTuple]: System.Type[] CaptureTypes
+Microsoft.FSharp.Core.PrintfFormat`5[TPrinter,TState,TResidue,TResult,TTuple]: System.Type[] get_CaptureTypes()
Microsoft.FSharp.Core.PrintfModule: T PrintFormatLineToError[T](Microsoft.FSharp.Core.PrintfFormat`4[T,System.IO.TextWriter,Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit])
Microsoft.FSharp.Core.PrintfModule: T PrintFormatLineToTextWriter[T](System.IO.TextWriter, Microsoft.FSharp.Core.PrintfFormat`4[T,System.IO.TextWriter,Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit])
Microsoft.FSharp.Core.PrintfModule: T PrintFormatLine[T](Microsoft.FSharp.Core.PrintfFormat`4[T,System.IO.TextWriter,Microsoft.FSharp.Core.Unit,Microsoft.FSharp.Core.Unit])
diff --git a/tests/FSharp.Test.Utilities/CompilerAssert.fs b/tests/FSharp.Test.Utilities/CompilerAssert.fs
index bd8f545a3c9..13659792003 100644
--- a/tests/FSharp.Test.Utilities/CompilerAssert.fs
+++ b/tests/FSharp.Test.Utilities/CompilerAssert.fs
@@ -276,8 +276,10 @@ let main argv = 0"""
Array.zip errors expectedErrors
|> Array.iter (fun (actualError, expectedError) ->
- let (expectedSeverity, expectedErrorNumber, expectedErrorRange, expectedErrorMsg) = expectedError
- let (actualSeverity, actualErrorNumber, actualErrorRange, actualErrorMsg) = actualError
+ let (expectedSeverity, expectedErrorNumber, expectedErrorRange, expectedErrorMsg: string) = expectedError
+ let (actualSeverity, actualErrorNumber, actualErrorRange, actualErrorMsg: string) = actualError
+ let expectedErrorMsg = expectedErrorMsg.Replace("\r\n", "\n")
+ let actualErrorMsg = actualErrorMsg.Replace("\r\n", "\n")
checkEqual "Severity" expectedSeverity actualSeverity
checkEqual "ErrorNumber" expectedErrorNumber actualErrorNumber
checkEqual "ErrorRange" expectedErrorRange actualErrorRange
diff --git a/tests/fsharp/Compiler/Language/StringInterpolation.fs b/tests/fsharp/Compiler/Language/StringInterpolation.fs
new file mode 100644
index 00000000000..83ea5c14078
--- /dev/null
+++ b/tests/fsharp/Compiler/Language/StringInterpolation.fs
@@ -0,0 +1,846 @@
+// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.
+
+namespace FSharp.Compiler.UnitTests
+
+open NUnit.Framework
+open FSharp.Compiler.SourceCodeServices
+open FSharp.Test.Utilities
+
+[]
+module StringInterpolationTests =
+
+ let SimpleCheckTest text =
+ CompilerAssert.CompileExeAndRunWithOptions [| "--langversion:preview" |] ("""
+let check msg a b =
+ if a = b then printfn "test case '%s' succeeded" msg else failwithf "test case '%s' failed, expected %A, got %A" msg b a
+
+""" + text)
+
+ []
+ let ``Basic string interpolation`` () =
+ SimpleCheckTest
+ """
+check "basic-string-interp1" $"this is 2" "this is 2"
+
+check "basic-string-interp2" $"this is {1} + 1 = 2" "this is 1 + 1 = 2"
+
+check "basic-string-interp3" $"this is {1} + {1+1} = 3" "this is 1 + 2 = 3"
+
+check "basic-string-interp4" $"this is {1} + {1+1}" "this is 1 + 2"
+
+check "basic-string-interp5" $"this is {1}" "this is 1"
+
+check "basic-string-interp6" $"123{456}789{012}345" "12345678912345"
+
+check "basic-string-interp7" $"this is {1} {2} {3} {4} {5} {6} {7}" "this is 1 2 3 4 5 6 7"
+
+check "basic-string-interp8" $"this is {7} {6} {5} {4} {3} {2} {1}" "this is 7 6 5 4 3 2 1"
+
+check "basic-string-interp9" $"{1}
+{2}" "1
+2"
+ """
+
+ []
+ let ``Neighbouring specifiers for string interpolation`` () =
+ SimpleCheckTest
+ """
+check "nbr-interp71" $"this is {1} {2} {3} {4} {5} {6} {7}" "this is 1 2 3 4 5 6 7"
+check "nbr-interp7b2" $"this is {1}{2}{3}{4}{5}{6}{7}" "this is 1234567"
+check "nbr-interp7c3" $"this is {1}{2}{3}{4}{5}{6}" "this is 123456"
+check "nbr-interp7c4" $"this is {1}{2}{3}{4}{5}" "this is 12345"
+check "nbr-interp7c5" $"this is {1}{2}{3}{4}" "this is 1234"
+check "nbr-interp7c6" $"this is {1}{2}{3} {4}" "this is 123 4"
+check "nbr-interp7c7" $"this is {1}{2} {3} {4}" "this is 12 3 4"
+check "nbr-interp7c8" $"this is {1}{2} {3}{4}" "this is 12 34"
+check "nbr-interp7c9" $"this is {1}{2}{3}" "this is 123"
+check "nbr-interp7cq" $"this is {1} {2}{3}" "this is 1 23"
+check "nbr-interp7cw" $"this is {1}{2} {3}" "this is 12 3"
+check "nbr-interp7ce" $"this is {1}{2}" "this is 12"
+
+check "nbr-interp7r" $"this is %d{1} {2} {3} {4} {5} {6} {7}" "this is 1 2 3 4 5 6 7"
+check "nbr-interp7bt" $"this is %d{1}{2}{3}{4}{5}{6}{7}" "this is 1234567"
+check "nbr-interp7cy" $"this is %d{1}{2}{3}{4}{5}{6}" "this is 123456"
+check "nbr-interp7cu" $"this is %d{1}{2}{3}{4}{5}" "this is 12345"
+check "nbr-interp7ci" $"this is %d{1}{2}{3}{4}" "this is 1234"
+check "nbr-interp7co" $"this is %d{1}{2}{3} {4}" "this is 123 4"
+check "nbr-interp7cp" $"this is %d{1}{2} {3} {4}" "this is 12 3 4"
+check "nbr-interp7ca" $"this is %d{1}{2} {3}{4}" "this is 12 34"
+check "nbr-interp7cs" $"this is %d{1}{2}{3}" "this is 123"
+check "nbr-interp7cd" $"this is %d{1} {2}{3}" "this is 1 23"
+check "nbr-interp7cf" $"this is %d{1}{2} {3}" "this is 12 3"
+check "nbr-interp7cg" $"this is %d{1}{2}" "this is 12"
+
+check "nbr-interp7h" $"this is %d{1} %d{2} {3} {4} {5} {6} {7}" "this is 1 2 3 4 5 6 7"
+check "nbr-interp7bj" $"this is %d{1}%d{2}{3}{4}{5}{6}{7}" "this is 1234567"
+check "nbr-interp7ck" $"this is %d{1}%d{2}{3}{4}{5}{6}" "this is 123456"
+check "nbr-interp7cl" $"this is %d{1}%d{2}{3}{4}{5}" "this is 12345"
+check "nbr-interp7cz" $"this is %d{1}%d{2}{3}{4}" "this is 1234"
+check "nbr-interp7cx" $"this is %d{1}%d{2}{3} {4}" "this is 123 4"
+check "nbr-interp7cc" $"this is %d{1}%d{2} {3} {4}" "this is 12 3 4"
+check "nbr-interp7cv" $"this is %d{1}%d{2} {3}{4}" "this is 12 34"
+check "nbr-interp7cb" $"this is %d{1}%d{2}{3}" "this is 123"
+check "nbr-interp7cn" $"this is %d{1} %d{2}{3}" "this is 1 23"
+check "nbr-interp7cm" $"this is %d{1}%d{2} {3}" "this is 12 3"
+check "nbr-interp7cp" $"this is %d{1}%d{2}" "this is 12"
+
+check "nbr-interp7" $"this is %d{1} %d{2} %d{3} {4} {5} {6} {7}" "this is 1 2 3 4 5 6 7"
+check "nbr-interp7b" $"this is %d{1}%d{2}%d{3}{4}{5}{6}{7}" "this is 1234567"
+check "nbr-interp7c" $"this is %d{1}%d{2}%d{3}{4}{5}{6}" "this is 123456"
+check "nbr-interp7c" $"this is %d{1}%d{2}%d{3}{4}{5}" "this is 12345"
+check "nbr-interp7c" $"this is %d{1}%d{2}%d{3}{4}" "this is 1234"
+check "nbr-interp7c" $"this is %d{1}%d{2}%d{3} {4}" "this is 123 4"
+check "nbr-interp7c" $"this is %d{1}%d{2} %d{3} {4}" "this is 12 3 4"
+check "nbr-interp7c" $"this is %d{1}%d{2} %d{3}{4}" "this is 12 34"
+check "nbr-interp7c" $"this is %d{1}%d{2}%d{3}" "this is 123"
+check "nbr-interp7c" $"this is %d{1} %d{2}%d{3}" "this is 1 23"
+check "nbr-interp7c" $"this is %d{1}%d{2} %d{3}" "this is 12 3"
+check "nbr-interp7c" $"this is %d{1}%d{2}" "this is 12"
+ """
+
+ []
+ let ``Basic string interpolation verbatim strings`` () =
+ SimpleCheckTest
+ """
+check "basic-string-interp-triple1" @$"this is 2" "this is 2"
+
+check "basic-string-interp-verbatim2" @$"this is {1} + 1 = 2" "this is 1 + 1 = 2"
+
+check "basic-string-interp-verbatim3" @$"this is {1} + {1+1} = 3" "this is 1 + 2 = 3"
+
+check "basic-string-interp-verbatim4" @$"this is {1} + {1+1}" "this is 1 + 2"
+
+check "basic-string-interp-verbatim5" @$"this is {1}" "this is 1"
+
+check "basic-string-interp-verbatim6" @$"this i\s {1}" "this i\s 1"
+
+check "basic-string-interp-verbatim1b" $@"this is 2" "this is 2"
+
+check "basic-string-interp-verbatim2b" $@"this is {1} + 1 = 2" "this is 1 + 1 = 2"
+
+check "basic-string-interp-verbatim3b" $@"this is {1} + {1+1} = 3" "this is 1 + 2 = 3"
+
+check "basic-string-interp-verbatim4b" $@"this is {1} + {1+1}" "this is 1 + 2"
+
+check "basic-string-interp-verbatim5b" $@"this is {1}" "this is 1"
+
+check "basic-string-interp-verbatim6b" $@"this i\s {1}" "this i\s 1"
+
+ """
+
+ []
+ let ``Basic string interpolation triple quote strings`` () =
+ SimpleCheckTest
+ "
+check \"basic-string-interp-triple1\" $\"\"\"this is 2\"\"\" \"this is 2\"
+
+check \"basic-string-interp-triple2\" $\"\"\"this is {1} + 1 = 2\"\"\" \"this is 1 + 1 = 2\"
+
+check \"basic-string-interp-triple3\" $\"\"\"this is {1} + {1+1} = 3\"\"\" \"this is 1 + 2 = 3\"
+
+check \"basic-string-interp-triple4\" $\"\"\"this is {1} + {1+1}\"\"\" \"this is 1 + 2\"
+
+check \"basic-string-interp-triple5\" $\"\"\"this is {1}\"\"\" \"this is 1\"
+
+check \"basic-string-interp-triple6\" $\"\"\"this i\s {1}\"\"\" \"this i\s 1\"
+
+// check nested string with %s
+check \"basic-string-interp-triple7\" $\"\"\"x = %s{\"1\"}\"\"\" \"x = 1\"
+
+// multiline
+check \"basic-string-interp-triple8\"
+ $\"\"\"this
+is {1+1}\"\"\"
+ \"\"\"this
+is 2\"\"\"
+ "
+
+ []
+ let ``String interpolation using atomic expression forms`` () =
+ SimpleCheckTest
+ """
+let x = 12
+let s = "sixsix"
+
+check "vcewwei4" $"this is %d{1} + {1+1+3} = 6" "this is 1 + 5 = 6"
+
+check "vcewwei5" $"this is 0x%08x{x} + {1+1} = 14" "this is 0x0000000c + 2 = 14"
+
+// Check dot notation
+check "vcewwei6" $"this is {s.Length} + {1+1} = 8" "this is 6 + 2 = 8"
+
+// Check null expression
+check "vcewwei8" $"abc{null}def" "abcdef"
+
+// Check mod operator
+check "vcewwei8" $"abc{4%3}def" "abc1def"
+
+ """
+
+
+ []
+ let ``String interpolation using nested control flow expressions`` () =
+ SimpleCheckTest
+ """
+let x = 12
+let s = "sixsix"
+
+// Check let expression
+check "string-interp-nested7" $"abc {let x = 3 in x + x} def" "abc 6 def"
+
+// Check if expression (parenthesized)
+check "string-interp-nested9" $"abc{(if true then 3 else 4)}def" "abc3def"
+
+// Check if-then-else expression (un-parenthesized)
+check "string-interp-nested10" $"abc{if true then 3 else 4}def" "abc3def"
+
+// Check two if-then-else expression (un-parenthesized)
+check "string-interp-nested11" $"abc{if true then 3 else 4}def{if false then 3 else 4}xyz" "abc3def4xyz"
+
+// Check two if-then-else expression (un-parenthesized, first split)
+check "string-interp-nested12"
+ $"abc{if true then 3
+ else 4}def{if false then 3 else 4}xyz" "abc3def4xyz"
+
+// Check two if-then-else expression (un-parenthesized, second split)
+check "string-interp-nested13"
+ $"abc{if true then 3 else 4}def{if false then 3
+ else 4}xyz" "abc3def4xyz"
+
+// Check two if-then-else expression (un-parenthesized, both split)
+check "string-interp-nested14"
+ $"abc{if true then 3
+ else 4}def{if false then 3
+ else 4}xyz" "abc3def4xyz"
+
+// Check if-then expression (un-parenthesized)
+check "string-interp-nested15" $"abc{if true then ()}def" "abcdef"
+
+// Check two if-then expression (un-parenthesized)
+check "string-interp-nested16" $"abc{if true then ()}def{if true then ()}xyz" "abcdefxyz"
+
+// Check multi-line let with parentheses
+check "string-interp-nested17"
+ $"abc {(let x = 3
+ x + x)} def"
+ "abc 6 def"
+
+// Check multi-line let without parentheses
+check "string-interp-nested18"
+ $"abc {let x = 3
+ x + x} def"
+ "abc 6 def"
+
+// Check multi-line let without parentheses (two)
+check "string-interp-nested19"
+ $"abc {let x = 3
+ x + x} def {let x = 3
+ x + x} xyz"
+ "abc 6 def 6 xyz"
+
+// Check while expression (un-parenthesized)
+check "vcewweh17" $"abc{while false do ()}def" "abcdef"
+
+ """
+
+
+
+ []
+ let ``String interpolation using nested string`` () =
+ SimpleCheckTest
+ "
+// check nested string
+check \"vcewweh22m1\" $\"\"\"x = {\"1\"} \"\"\" \"x = 1 \"
+
+check \"vcewweh22m2\" $\"\"\"x = {$\"\"} \"\"\" \"x = \"
+
+do
+ let genreSpecified = true
+ let getGenre() = \"comedy\"
+ check \"vcewweh22m6\" $\"\"\"/api/movie/{if not genreSpecified then \"\" else $\"q?genre={getGenre()}\"}\"\"\" \"/api/movie/q?genre=comedy\"
+
+"
+
+ []
+ let ``Triple quote string interpolation using nested string`` () =
+ SimpleCheckTest
+ "
+do
+ let itvar=\"i\"
+ let iterfrom=\"0\"
+ let iterto=\"100\"
+ let block= $\"\"\"printf(\"%%d\", {itvar});
+ do({itvar});\"\"\"
+ check \"vcewweh22m7\" $\"\"\"
+for({itvar}={iterfrom};{itvar}<{iterto};++{itvar}) {{
+ {block}
+}}\"\"\" \"\"\"
+for(i=0;i<100;++i) {
+ printf(\"%d\", i);
+ do(i);
+}\"\"\"
+"
+
+ []
+ let ``Mixed quote string interpolation using nested string`` () =
+ SimpleCheckTest
+ "
+
+check \"vcewweh22n1\"
+ $\"\"\"
+ PROCEDURE SEARCH;
+ BEGIN
+ END;\"\"\"
+ \"\"\"
+ PROCEDURE SEARCH;
+ BEGIN
+ END;\"\"\"
+
+check \"vcewweh22n2\"
+ $\"\"\"
+ PROCEDURE SEARCH;
+ BEGIN
+ WRITELN({ $\"{21+21}\" });
+ END;\"\"\"
+ \"\"\"
+ PROCEDURE SEARCH;
+ BEGIN
+ WRITELN(42);
+ END;\"\"\"
+"
+
+ []
+ let ``String interpolation to FormattableString`` () =
+ SimpleCheckTest
+ """
+open System
+open System.Globalization
+
+let fmt (x: FormattableString) = x.ToString()
+let fmt_us (x: FormattableString) = x.ToString(CultureInfo("en-US"))
+let fmt_de (x: FormattableString) = x.ToString(CultureInfo("de-DE"))
+
+check "fwejwflpej1" (fmt $"") ""
+check "fwejwflpej2" (fmt $"abc") "abc"
+check "fwejwflpej3" (fmt $"abc{1}") "abc1"
+check "fwejwflpej6" (fmt_us $"abc {30000} def") "abc 30000 def"
+check "fwejwflpej7" (fmt_de $"abc {30000} def") "abc 30000 def"
+check "fwejwflpej8" (fmt_us $"abc {30000:N} def") "abc 30,000.00 def"
+check "fwejwflpej9" (fmt_de $"abc {30000:N} def") "abc 30.000,00 def"
+check "fwejwflpej10" (fmt_us $"abc {30000} def {40000} hij") "abc 30000 def 40000 hij"
+check "fwejwflpej11" (fmt_us $"abc {30000,-10} def {40000} hij") "abc 30000 def 40000 hij"
+check "fwejwflpej12" (fmt_us $"abc {30000,10} def {40000} hij") "abc 30000 def 40000 hij"
+check "fwejwflpej13" (fmt_de $"abc {30000} def {40000} hij") "abc 30000 def 40000 hij"
+check "fwejwflpej14" (fmt_us $"abc {30000:N} def {40000:N} hij") "abc 30,000.00 def 40,000.00 hij"
+check "fwejwflpej15" (fmt_de $"abc {30000:N} def {40000:N} hij") "abc 30.000,00 def 40.000,00 hij"
+check "fwejwflpej16" (fmt_de $"abc {30000,10:N} def {40000:N} hij") "abc 30.000,00 def 40.000,00 hij"
+check "fwejwflpej17" (fmt_de $"abc {30000,-10:N} def {40000:N} hij") "abc 30.000,00 def 40.000,00 hij"
+
+ """
+
+ []
+ let ``String interpolation to IFormattable`` () =
+ SimpleCheckTest
+ """
+open System
+open System.Globalization
+
+let fmt (x: IFormattable) = x.ToString()
+let fmt_us (x: IFormattable) = x.ToString("", CultureInfo("en-US"))
+let fmt_de (x: IFormattable) = x.ToString("", CultureInfo("de-DE"))
+
+check "fwejwflpej1" (fmt $"") ""
+check "fwejwflpej2" (fmt $"abc") "abc"
+check "fwejwflpej3" (fmt $"abc{1}") "abc1"
+check "fwejwflpej6" (fmt_us $"abc {30000} def") "abc 30000 def"
+check "fwejwflpej7" (fmt_de $"abc {30000} def") "abc 30000 def"
+check "fwejwflpej8" (fmt_us $"abc {30000:N} def") "abc 30,000.00 def"
+check "fwejwflpej9" (fmt_de $"abc {30000:N} def") "abc 30.000,00 def"
+check "fwejwflpej10" (fmt_us $"abc {30000} def {40000} hij") "abc 30000 def 40000 hij"
+check "fwejwflpej11" (fmt_us $"abc {30000,-10} def {40000} hij") "abc 30000 def 40000 hij"
+check "fwejwflpej12" (fmt_us $"abc {30000,10} def {40000} hij") "abc 30000 def 40000 hij"
+check "fwejwflpej13" (fmt_de $"abc {30000} def {40000} hij") "abc 30000 def 40000 hij"
+check "fwejwflpej14" (fmt_us $"abc {30000:N} def {40000:N} hij") "abc 30,000.00 def 40,000.00 hij"
+check "fwejwflpej15" (fmt_de $"abc {30000:N} def {40000:N} hij") "abc 30.000,00 def 40.000,00 hij"
+check "fwejwflpej16" (fmt_de $"abc {30000,10:N} def {40000:N} hij") "abc 30.000,00 def 40.000,00 hij"
+check "fwejwflpej17" (fmt_de $"abc {30000,-10:N} def {40000:N} hij") "abc 30.000,00 def 40.000,00 hij"
+
+ """
+
+ []
+ let ``String interpolation to PrintFormat`` () =
+ SimpleCheckTest
+ """
+open System.Text
+open Printf
+
+check "fwejwflpej1" (sprintf $"") ""
+check "fwejwflpej2" (sprintf $"abc") "abc"
+check "fwejwflpej3" (sprintf $"abc{1}") "abc1"
+
+let sb = StringBuilder()
+bprintf sb $"{0}"
+bprintf sb $"abc"
+bprintf sb $"abc{1}"
+check "fwejwflpej4" (sb.ToString()) "0abcabc1"
+
+ """
+
+
+ []
+ let ``String interpolation using .NET Formats`` () =
+ SimpleCheckTest
+ """
+check "vcewweh221q" $"abc {1}" "abc 1"
+check "vcewweh222w" $"abc {1:N3}" "abc 1.000"
+check "vcewweh223e" $"abc {1,10}" "abc 1"
+check "vcewweh223r" $"abc {1,-10}" "abc 1 "
+check "vcewweh224t" $"abc {1,10:N3}" "abc 1.000"
+check "vcewweh224y" $"abc {1,-10:N3}" "abc 1.000 "
+check "vcewweh225u" $"abc %d{1}" "abc 1"
+check "vcewweh225u" $"abc %5d{1}" "abc 1"
+check "vcewweh225u" $"abc %-5d{1}" "abc 1 "
+ """
+
+ []
+ let ``String interpolation of null`` () =
+ SimpleCheckTest
+ """
+
+check "vcewweh221q1" $"{null}" ""
+check "vcewweh221q2" $"%s{null}" ""
+check "vcewweh221q3" $"abc %s{null}" "abc "
+check "vcewweh221q4" $"abc %s{null} def" "abc def"
+ """
+
+ []
+ let ``String interpolation of basic types`` () =
+ SimpleCheckTest
+ """
+check "vcewweh221q11" $"{1y}" "1"
+check "vcewweh221q12" $"{1uy}" "1"
+check "vcewweh221q13" $"{1s}" "1"
+check "vcewweh221q14" $"{1us}" "1"
+check "vcewweh221q15" $"{1u}" "1"
+check "vcewweh221q16" $"{1}" "1"
+check "vcewweh221q17" $"{-1}" "-1"
+check "vcewweh221q18" $"{1L}" "1"
+check "vcewweh221q19" $"{1UL}" "1"
+check "vcewweh221q1q" $"{1n}" "1"
+check "vcewweh221q1w" $"{1un}" "1"
+check "vcewweh221q1e" $"{1.0}" "1"
+check "vcewweh221q1r" $"{1.01}" "1.01"
+check "vcewweh221q1t" $"{-1.01}" "-1.01"
+check "vcewweh221q1y" $"{1I}" "1"
+check "vcewweh221q1i" $"{1M}" "1"
+
+check "vcewweh221q1o" $"%d{1y}" "1"
+check "vcewweh221q1p" $"%d{1uy}" "1"
+check "vcewweh221q1a" $"%d{1s}" "1"
+check "vcewweh221q1s" $"%d{1us}" "1"
+check "vcewweh221q1d" $"%d{1u}" "1"
+check "vcewweh221q1f" $"%d{1}" "1"
+check "vcewweh221q1g" $"%d{-1}" "-1"
+check "vcewweh221q1h" $"%d{1L}" "1"
+check "vcewweh221q1j" $"%d{1UL}" "1"
+check "vcewweh221q1k" $"%d{1n}" "1"
+check "vcewweh221q1l" $"%d{1un}" "1"
+
+check "vcewweh221q1" $"%f{1.0}" "1.000000"
+ """
+ []
+ let ``String interpolation using escaped braces`` () =
+ SimpleCheckTest
+ """
+check "vcewweh226i" $"{{" "{"
+check "vcewweh226o" $"{{{{" "{{"
+check "vcewweh226p" $"{{{1}}}" "{1}"
+check "vcewweh227a" $"}}" "}"
+check "vcewweh227s" $"}}}}" "}}"
+check "vcewweh228d" "{{" "{{"
+check "vcewweh229f" "}}" "}}"
+ """
+
+ []
+ let ``String interpolation using verbatim strings`` () =
+ SimpleCheckTest
+ """
+check "vcewweh226i" $"{{" "{"
+check "vcewweh226o" $"{{{{" "{{"
+check "vcewweh226p" $"{{{1}}}" "{1}"
+check "vcewweh227a" $"}}" "}"
+check "vcewweh227s" $"}}}}" "}}"
+check "vcewweh228d" "{{" "{{"
+check "vcewweh229f" "}}" "}}"
+ """
+
+
+ []
+ let ``String interpolation using record data`` () =
+ SimpleCheckTest
+ """
+type R = { X : int }
+type R2 = { X : int ; Y: int }
+
+// Check record expression (parenthesized)
+check "vcewweh18" $"abc{({contents=1}.contents)}def" "abc1def"
+
+// Check record expression (unparenthesized, spaced)
+check "vcewweh19a" $"abc{ {X=1} }def" "abc{ X = 1 }def"
+
+check "vcewweh19b" $"abc{ {X=1} }def" "abc{ X = 1 }def"
+
+// Check record expression (unparenthesized, spaced ending in token brace then string hole brace)
+check "vcewweh19v" $"abc{ {X=1}}def" "abc{ X = 1 }def"
+
+// Check thing that is not really a record expression (braces are escaped)
+check "vcewweh20" $"abc{{X=1}}def" "abc{X=1}def"
+
+// Check thing that is not really a record expression (braces are escaped)
+check "vcewweh20b" $"abc{{quack=1}}def" "abc{quack=1}def"
+
+// Check thing that is not really a record expression (braces are escaped)
+check "vcewweh21" $"abc{{X=1; Y=2}}def" "abc{X=1; Y=2}def"
+
+ """
+
+
+ []
+ let ``String interpolation using printf formats`` () =
+ SimpleCheckTest
+ """
+let x = 12
+let s = "sixsix"
+
+// check %A
+check "vcewweh22" $"x = %A{1}" "x = 1"
+
+// check %d
+check "vcewweh22b" $"x = %d{1}" "x = 1"
+
+// check %x
+check "vcewweh22c" $"x = %x{1}" "x = 1"
+
+// check %o (octal)
+check "vcewweh22d" $"x = %o{15}" "x = 17"
+
+// check %b
+check "vcewweh22e" $"x = %b{true}" "x = true"
+
+// check %s
+check "vcewweh22f" $"x = %s{s}" "x = sixsix"
+
+// check %A of string
+check "vcewweh22g" $"x = %A{s}" "x = \"sixsix\""
+
+check "vcewweh20" $"x = %A{1}" "x = 1"
+
+ """
+
+
+ []
+ let ``String interpolation using list and array data`` () =
+ SimpleCheckTest
+ """
+// check unannotated of list
+check "vcewweh22i" $"x = {[0..100]} " "x = [0; 1; 2; ... ] "
+
+let xs = [0..100]
+// check unannotated of list
+check "vcewweh22i" $"x = {xs} " "x = [0; 1; 2; ... ] "
+
+// check %A of list
+check "vcewweh22h" $"x = %0A{[0..100]} " "x = [0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15; 16; 17; 18; 19; 20; 21; 22; 23; 24; 25; 26; 27; 28; 29; 30; 31; 32; 33; 34; 35; 36; 37; 38; 39; 40; 41; 42; 43; 44; 45; 46; 47; 48; 49; 50; 51; 52; 53; 54; 55; 56; 57; 58; 59; 60; 61; 62; 63; 64; 65; 66; 67; 68; 69; 70; 71; 72; 73; 74; 75; 76; 77; 78; 79; 80; 81; 82; 83; 84; 85; 86; 87; 88; 89; 90; 91; 92; 93; 94; 95; 96; 97; 98; 99; ...] "
+
+// check unannotated of array
+check "vcewweh22j" $"x = {[|0..100|]} " "x = System.Int32[] "
+
+let arr = [|0..100|]
+// check unannotated of array
+check "vcewweh22j" $"x = {arr} " "x = System.Int32[] "
+
+// check %0A of array
+check "vcewweh22k" $"x = %0A{[|0..100|]} " "x = [|0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15; 16; 17; 18; 19; 20; 21; 22; 23; 24; 25; 26; 27; 28; 29; 30; 31; 32; 33; 34; 35; 36; 37; 38; 39; 40; 41; 42; 43; 44; 45; 46; 47; 48; 49; 50; 51; 52; 53; 54; 55; 56; 57; 58; 59; 60; 61; 62; 63; 64; 65; 66; 67; 68; 69; 70; 71; 72; 73; 74; 75; 76; 77; 78; 79; 80; 81; 82; 83; 84; 85; 86; 87; 88; 89; 90; 91; 92; 93; 94; 95; 96; 97; 98; 99; ...|] "
+
+ """
+
+
+ []
+ let ``Quotations of interpolation`` () =
+ SimpleCheckTest
+ """
+check "vcewweh1"
+ ((<@ $"this {1} is 2" @>).ToString().Replace("\r","").Replace("\n","").Replace("\"",""))
+ "Call (None, PrintFormatToString, [NewObject (PrintfFormat`5, Value (this %P() is 2), NewArray (Object, Call (None, Box, [Value (1)])), Value ())])"
+ """
+
+ []
+ let ``Quotations in interpolation`` () =
+ SimpleCheckTest
+ """
+check "check-quotation1" $"this {<@ 1 @>} is 2" "this Value (1) is 2"
+ """
+
+ []
+ let ``Object expression in interpolation`` () =
+ SimpleCheckTest
+ """
+check "check-object-expression-in-interpolation1"
+ (let s = "AA" in $"this { {new System.Object() with member x.ToString() = s } } is 2")
+ "this AA is 2"
+ """
+
+ []
+ let ``Exception handling in interpolation`` () =
+ SimpleCheckTest
+ """
+check "check-object-expression-in-interpolation1"
+ (let s = "AA" in $"this { try failwith s with _ -> s } is 2")
+ "this AA is 2"
+ """
+
+ []
+ let ``String interpolation using anonymous records`` () =
+ SimpleCheckTest
+ """
+// Check anonymous record expression (parenthesized)
+check "vcewweh23" $"abc{({| A=1 |})}def" "abc{ A = 1 }def"
+
+ """
+
+
+ []
+ let ``Basic string interpolation (no preview)`` () =
+ CompilerAssert.TypeCheckWithErrorsAndOptions [| |]
+ """
+let x = $"one"
+ """
+ [|(FSharpErrorSeverity.Error, 3350, (2, 9, 2, 15),
+ "Feature 'string interpolation' is not available in F# 4.7. Please use language version 'preview' or greater.")|]
+
+
+ []
+ let ``Basic string interpolation negative`` () =
+ let code = """
+let x1 = $"one %d{System.String.Empty}" // mismatched types
+let x2 = $"one %s{1}" // mismatched types
+let x3 = $"one %s" // naked percent in interpolated
+let x4 = $"one %d" // naked percent in interpolated
+let x5 = $"one %A" // naked percent in interpolated
+let x6 = $"one %P" // interpolation hole marker in interploation
+let x7 = $"one %P()" // interpolation hole marker in interploation
+let x8 = $"one %P(){1}" // interpolation hole marker in interploation
+let x9 = $"one %f" // naked percent in interpolated
+let xa = $"one %d{3:N}" // mix of formats
+let xc = $"5%6" // bad F# format specifier
+let xe = $"%A{{1}}" // fake expression (delimiters escaped)
+"""
+ CompilerAssert.TypeCheckWithErrorsAndOptions [| "--langversion:preview" |]
+ code
+ [|(FSharpErrorSeverity.Error, 1, (2, 19, 2, 38),
+ "The type 'string' is not compatible with any of the types byte,int16,int32,int64,sbyte,uint16,uint32,uint64,nativeint,unativeint, arising from the use of a printf-style format string");
+ (FSharpErrorSeverity.Error, 1, (3, 19, 3, 20),
+ """This expression was expected to have type
+ 'string'
+but here has type
+ 'int' """);
+ (FSharpErrorSeverity.Error, 3376, (4, 10, 4, 19),
+ "Invalid interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{1+1}'.");
+ (FSharpErrorSeverity.Error, 3376, (5, 10, 5, 19),
+ "Invalid interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{1+1}'.");
+ (FSharpErrorSeverity.Error, 3376, (6, 10, 6, 19),
+ "Invalid interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{1+1}'.");
+ (FSharpErrorSeverity.Error, 3376, (7, 10, 7, 19),
+ "Invalid interpolated string. The '%P' specifier may not be used explicitly.");
+ (FSharpErrorSeverity.Error, 3371, (8, 10, 8, 21),
+ "Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{1+1}'");
+ (FSharpErrorSeverity.Error, 3371, (9, 10, 9, 24),
+ "Mismatch in interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{1+1}'");
+ (FSharpErrorSeverity.Error, 3376, (10, 10, 10, 19),
+ "Invalid interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{1+1}'.");
+ (FSharpErrorSeverity.Error, 3376, (11, 10, 11, 24),
+ "Invalid interpolated string. .NET-style format specifiers such as '{x,3}' or '{x:N5}' may not be mixed with '%' format specifiers.")
+ (FSharpErrorSeverity.Error, 3376, (12, 10, 12, 16),
+ "Invalid interpolated string. Bad precision in format specifier")
+ (FSharpErrorSeverity.Error, 3376, (13, 10, 13, 20),
+ "Invalid interpolated string. Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{1+1}'.")
+ |]
+
+ let code = """
+let xb = $"{%5d{1:N3}}" // inner error that looks like format specifiers
+"""
+ CompilerAssert.TypeCheckWithErrorsAndOptions [| "--langversion:preview" |]
+ code
+ [|(FSharpErrorSeverity.Error, 1156, (2, 14, 2, 16),
+ "This is not a valid numeric literal. Valid numeric literals include 1, 0x1, 0o1, 0b1, 1l (int), 1u (uint32), 1L (int64), 1UL (uint64), 1s (int16), 1y (sbyte), 1uy (byte), 1.0 (float), 1.0f (float32), 1.0m (decimal), 1I (BigInteger).");
+ (FSharpErrorSeverity.Error, 10, (2, 18, 2, 19),
+ "Unexpected symbol ':' in expression. Expected '}' or other token.");
+ (FSharpErrorSeverity.Error, 604, (2, 16, 2, 17), "Unmatched '{'")
+ |]
+
+ let code = """
+let xd = $"%A{}" // empty expression
+"""
+ CompilerAssert.TypeCheckWithErrorsAndOptions [| "--langversion:preview" |]
+ code
+ [|(FSharpErrorSeverity.Error, 10, (2, 15, 2, 17),
+ "Unexpected interpolated string (final part) in binding")
+ |]
+
+ []
+ let ``String interpolation FormattableString negative`` () =
+ let code = """
+
+open System
+let x1 : FormattableString = $"one %d{100}" // no %d in FormattableString
+let x2 : FormattableString = $"one %s{String.Empty}" // no %s in FormattableString
+let x3 : FormattableString = $"one %10s{String.Empty}" // no %10s in FormattableString
+"""
+ CompilerAssert.TypeCheckWithErrorsAndOptions [| "--langversion:preview" |]
+ code
+ [|(FSharpErrorSeverity.Error, 3376, (4, 30, 4, 44),
+ "Invalid interpolated string. Interpolated strings used as type IFormattable or type FormattableString may not use '%' specifiers, only .NET-style interpolands such as '{expr}', '{expr,3}' or '{expr:N5}' may be used.");
+ (FSharpErrorSeverity.Error, 3376, (5, 30, 5, 53),
+ "Invalid interpolated string. Interpolated strings used as type IFormattable or type FormattableString may not use '%' specifiers, only .NET-style interpolands such as '{expr}', '{expr,3}' or '{expr:N5}' may be used.");
+ (FSharpErrorSeverity.Error, 3376, (6, 30, 6, 55),
+ "Invalid interpolated string. Interpolated strings used as type IFormattable or type FormattableString may not use '%' specifiers, only .NET-style interpolands such as '{expr}', '{expr,3}' or '{expr:N5}' may be used.")|]
+
+
+ []
+ let ``String interpolation negative nested in single`` () =
+ let code = """
+
+open System
+let s1 = $"123{456}789{"012"}345"
+let s2 = $"123{456}789{@"012"}345"
+let s3 = $"123{456}789{$"012"}345"
+let s4 = $@"123{456}789{"012"}345"
+let s5 = @$"123{456}789{"012"}345"
+let s6 = $@"123{456}789{@"012"}345"
+let s7 = @$"123{456}789{$"012"}345"
+let s8 = $@"123{456}789{@$"012"}345"
+let s9 = @$"123{456}789{$@"012"}345"
+"""
+ CompilerAssert.TypeCheckWithErrorsAndOptions [| "--langversion:preview" |]
+ code
+ [|(FSharpErrorSeverity.Error, 3373, (4, 24, 4, 25),
+ "Invalid interpolated string. Single quote or verbatim string literals may not be used in interpolated expressions in single quote or verbatim strings. Consider using an explicit 'let' binding for the interpolation expression or use a triple quote string as the outer string literal.");
+ (FSharpErrorSeverity.Error, 3373, (5, 24, 5, 26),
+ "Invalid interpolated string. Single quote or verbatim string literals may not be used in interpolated expressions in single quote or verbatim strings. Consider using an explicit 'let' binding for the interpolation expression or use a triple quote string as the outer string literal.");
+ (FSharpErrorSeverity.Error, 3373, (6, 24, 6, 26),
+ "Invalid interpolated string. Single quote or verbatim string literals may not be used in interpolated expressions in single quote or verbatim strings. Consider using an explicit 'let' binding for the interpolation expression or use a triple quote string as the outer string literal.");
+ (FSharpErrorSeverity.Error, 3373, (7, 25, 7, 26),
+ "Invalid interpolated string. Single quote or verbatim string literals may not be used in interpolated expressions in single quote or verbatim strings. Consider using an explicit 'let' binding for the interpolation expression or use a triple quote string as the outer string literal.");
+ (FSharpErrorSeverity.Error, 3373, (8, 25, 8, 26),
+ "Invalid interpolated string. Single quote or verbatim string literals may not be used in interpolated expressions in single quote or verbatim strings. Consider using an explicit 'let' binding for the interpolation expression or use a triple quote string as the outer string literal.");
+ (FSharpErrorSeverity.Error, 3373, (9, 25, 9, 27),
+ "Invalid interpolated string. Single quote or verbatim string literals may not be used in interpolated expressions in single quote or verbatim strings. Consider using an explicit 'let' binding for the interpolation expression or use a triple quote string as the outer string literal.");
+ (FSharpErrorSeverity.Error, 3373, (10, 25, 10, 27),
+ "Invalid interpolated string. Single quote or verbatim string literals may not be used in interpolated expressions in single quote or verbatim strings. Consider using an explicit 'let' binding for the interpolation expression or use a triple quote string as the outer string literal.");
+ (FSharpErrorSeverity.Error, 3373, (11, 25, 11, 28),
+ "Invalid interpolated string. Single quote or verbatim string literals may not be used in interpolated expressions in single quote or verbatim strings. Consider using an explicit 'let' binding for the interpolation expression or use a triple quote string as the outer string literal.");
+ (FSharpErrorSeverity.Error, 3373, (12, 25, 12, 28),
+ "Invalid interpolated string. Single quote or verbatim string literals may not be used in interpolated expressions in single quote or verbatim strings. Consider using an explicit 'let' binding for the interpolation expression or use a triple quote string as the outer string literal.")|]
+
+ []
+ let ``String interpolation negative nested in triple`` () =
+ let code = "
+
+open System
+let TripleInTripleInterpolated = $\"\"\"123{456}789{\"\"\"012\"\"\"}345\"\"\"
+let TripleInSingleInterpolated = $\"123{456}789{\"\"\"012\"\"\"}345\"
+let TripleInVerbatimInterpolated = $\"123{456}789{\"\"\"012\"\"\"}345\"
+let TripleInterpolatedInTripleInterpolated = $\"\"\"123{456}789{$\"\"\"012\"\"\"}345\"\"\"
+let TripleInterpolatedInSingleInterpolated = $\"123{456}789{$\"\"\"012\"\"\"}345\"
+let TripleInterpolatedInVerbatimInterpolated = $\"123{456}789{$\"\"\"012\"\"\"}345\"
+"
+ CompilerAssert.TypeCheckWithErrorsAndOptions [| "--langversion:preview" |]
+ code
+ [|(FSharpErrorSeverity.Error, 3374, (4, 52, 4, 55),
+ "Invalid interpolated string. Triple quote string literals may not be used in interpolated expressions. Consider using an explicit 'let' binding for the interpolation expression.");
+ (FSharpErrorSeverity.Error, 3374, (5, 50, 5, 53),
+ "Invalid interpolated string. Triple quote string literals may not be used in interpolated expressions. Consider using an explicit 'let' binding for the interpolation expression.");
+ (FSharpErrorSeverity.Error, 3374, (6, 50, 6, 53),
+ "Invalid interpolated string. Triple quote string literals may not be used in interpolated expressions. Consider using an explicit 'let' binding for the interpolation expression.");
+ (FSharpErrorSeverity.Error, 3374, (7, 64, 7, 68),
+ "Invalid interpolated string. Triple quote string literals may not be used in interpolated expressions. Consider using an explicit 'let' binding for the interpolation expression.");
+ (FSharpErrorSeverity.Error, 3374, (8, 62, 8, 66),
+ "Invalid interpolated string. Triple quote string literals may not be used in interpolated expressions. Consider using an explicit 'let' binding for the interpolation expression.");
+ (FSharpErrorSeverity.Error, 3374, (9, 62, 9, 66),
+ "Invalid interpolated string. Triple quote string literals may not be used in interpolated expressions. Consider using an explicit 'let' binding for the interpolation expression.")|]
+
+ []
+ let ``String interpolation negative incomplete string`` () =
+ let code = """let x1 = $"one %d{System.String.Empty}"""
+ CompilerAssert.TypeCheckWithErrorsAndOptions [| "--langversion:preview" |]
+ code
+ [|(FSharpErrorSeverity.Error, 10, (1, 1, 1, 39),
+ "Incomplete structured construct at or before this point in binding. Expected interpolated string (final part), interpolated string (part) or other token.");
+ (FSharpErrorSeverity.Error, 3379, (1, 38, 1, 39),
+ "Incomplete interpolated string begun at or before here")|]
+
+ []
+ let ``String interpolation negative incomplete string fill`` () =
+ let code = """let x1 = $"one %d{System.String.Empty"""
+ CompilerAssert.TypeCheckWithErrorsAndOptions [| "--langversion:preview" |]
+ code
+ [|(FSharpErrorSeverity.Error, 10, (1, 1, 1, 38),
+ "Incomplete structured construct at or before this point in binding. Expected interpolated string (final part), interpolated string (part) or other token.");
+ (FSharpErrorSeverity.Error, 3378, (1, 18, 1, 19),
+ "Incomplete interpolated string expression fill begun at or before here")|]
+
+ []
+ let ``String interpolation negative incomplete verbatim string`` () =
+ let code = """let x1 = @$"one %d{System.String.Empty} """
+ CompilerAssert.TypeCheckWithErrorsAndOptions [| "--langversion:preview" |]
+ code
+ [|(FSharpErrorSeverity.Error, 10, (1, 1, 1, 41),
+ "Incomplete structured construct at or before this point in binding. Expected interpolated string (final part), interpolated string (part) or other token.");
+ (FSharpErrorSeverity.Error, 3380, (1, 39, 1, 40),
+ "Incomplete interpolated verbatim string begun at or before here")|]
+
+ []
+ let ``String interpolation negative incomplete triple quote string`` () =
+ let code = "let x1 = $\"\"\"one"
+ CompilerAssert.TypeCheckWithErrorsAndOptions [| "--langversion:preview" |]
+ code
+ [|(FSharpErrorSeverity.Warning, 58, (1, 1, 1, 17),
+ "Possible incorrect indentation: this token is offside of context started at position (1:1). Try indenting this token further or using standard formatting conventions.");
+ (FSharpErrorSeverity.Warning, 58, (1, 17, 1, 17),
+ "Possible incorrect indentation: this token is offside of context started at position (1:1). Try indenting this token further or using standard formatting conventions.");
+ (FSharpErrorSeverity.Error, 10, (1, 1, 1, 17),
+ "Incomplete structured construct at or before this point in binding");
+ (FSharpErrorSeverity.Error, 3381, (1, 10, 1, 14),
+ "Incomplete interpolated triple-quote string begun at or before here")|]
+
+ []
+ let ``String interpolation extra right brace single quote`` () =
+ let code = "let x1 = $\"}\""
+ CompilerAssert.TypeCheckWithErrorsAndOptions [| "--langversion:preview" |]
+ code
+ [|(FSharpErrorSeverity.Error, 3382, (1, 10, 1, 14),
+ "A '}' character must be escaped (by doubling) in an interpolated string.")|]
+
+ []
+ let ``String interpolation extra right brace verbatim`` () =
+ let code = "let x1 = @$\"}\""
+ CompilerAssert.TypeCheckWithErrorsAndOptions [| "--langversion:preview" |]
+ code
+ [|(FSharpErrorSeverity.Error, 3382, (1, 10, 1, 15),
+ "A '}' character must be escaped (by doubling) in an interpolated string.")|]
+
+ []
+ let ``String interpolation extra right brace triple`` () =
+ let code = "let x1 = $\"\"\"}\"\"\""
+ CompilerAssert.TypeCheckWithErrorsAndOptions [| "--langversion:preview" |]
+ code
+ [|(FSharpErrorSeverity.Error, 3382, (1, 10, 1, 18),
+ "A '}' character must be escaped (by doubling) in an interpolated string.")|]
+
+ []
+ let ``String interpolation extra right brace single quote with hole`` () =
+ let code = "let x1 = $\"{0}}\""
+ CompilerAssert.TypeCheckWithErrorsAndOptions [| "--langversion:preview" |]
+ code
+ [|(FSharpErrorSeverity.Error, 3382, (1, 14, 1, 17),
+ "A '}' character must be escaped (by doubling) in an interpolated string.")|]
diff --git a/tests/fsharp/FSharpSuite.Tests.fsproj b/tests/fsharp/FSharpSuite.Tests.fsproj
index e5102336f20..3e1c1918e72 100644
--- a/tests/fsharp/FSharpSuite.Tests.fsproj
+++ b/tests/fsharp/FSharpSuite.Tests.fsproj
@@ -51,6 +51,7 @@
+
diff --git a/tests/fsharp/core/printf-interpolated/test.fsx b/tests/fsharp/core/printf-interpolated/test.fsx
new file mode 100644
index 00000000000..64e08fec66e
--- /dev/null
+++ b/tests/fsharp/core/printf-interpolated/test.fsx
@@ -0,0 +1,280 @@
+// #Conformance #Printing
+
+#if TESTS_AS_APP
+module Core_printf_interp
+#endif
+
+open Printf
+
+let failures = ref []
+
+let report_failure (s : string) =
+ stderr.Write" NO: "
+ stderr.WriteLine s
+ failures := !failures @ [s]
+
+// change this to true to run every test case
+// leave as false to randomly execute a subset of cases (this is a very expensive test area)
+let runEveryTest = true
+
+let test t (s1:Lazy) s2 =
+ stdout.WriteLine ("running test "+t+"...")
+ let s1 = s1.Force()
+ if s1 <> s2 then
+ report_failure ("test "+t+": expected \n\t'"+s2+"' but produced \n\t'"+s1+"'")
+ else
+ stdout.WriteLine ("test "+t+": correctly produced '"+s1+"'")
+
+let verify actual expected = test expected actual expected
+
+let adjust1 obj n1 = unbox ((unbox obj) n1)
+
+let _ = test "cewoui20" (lazy(sprintf $"")) ""
+let _ = test "cewoui21" (lazy(sprintf $"abc")) "abc"
+let _ = test "cewoui22" (lazy(sprintf $"%d{3}")) "3"
+let _ = test "cewoui2a" (lazy(sprintf $"%o{0}")) "0"
+let _ = test "cewoui2b" (lazy(sprintf $"%o{0}")) "0"
+let _ = test "cewoui2c" (lazy(sprintf $"%o{5}")) "5"
+let _ = test "cewoui2q" (lazy(sprintf $"%o{8}")) "10"
+let _ = test "cewoui2w" (lazy(sprintf $"%o{15}")) "17"
+let _ = test "cewoui2e" (lazy(sprintf $"%o{System.Int32.MinValue}" )) "20000000000"
+let _ = test "cewoui2r" (lazy(sprintf $"%o{0xffffffff}" )) "37777777777"
+let _ = test "cewoui2t" (lazy(sprintf $"%o{System.Int32.MinValue+1}")) "20000000001"
+let _ = test "cewoui2y" (lazy(sprintf $"%o{System.Int32.MaxValue}")) "17777777777"
+
+let _ = test "cewoui2u" (lazy(sprintf $"%o{-1}" )) "37777777777"
+
+let f z = sprintf $"%o{z}"
+
+let _ = test "cewoui2a" (lazy(f 0)) "0"
+let _ = test "cewoui2s" (lazy(f 0)) "0"
+let _ = test "cewoui2d" (lazy(f 5)) "5"
+let _ = test "cewoui2f" (lazy(f 8)) "10"
+let _ = test "cewoui2g" (lazy(f 15)) "17"
+let _ = test "cewoui2h" (lazy(f System.Int32.MinValue)) "20000000000"
+let _ = test "cewoui2j" (lazy(f 0xffffffff)) "37777777777"
+let _ = test "cewoui2lk" (lazy(f (System.Int32.MinValue+1))) "20000000001"
+let _ = test "cewoui2l" (lazy(f System.Int32.MaxValue)) "17777777777"
+
+let _ = test "cewoui212" (lazy(f (-1))) "37777777777"
+
+// check bprintf
+let _ = test "csd3oui2!" (lazy(let buf = new System.Text.StringBuilder() in ignore (bprintf buf $"%x{0}%x{1}"); buf.ToString())) "01"
+
+// check kbprintf
+let _ = test "csd3oui2!1" (lazy(let buf = new System.Text.StringBuilder() in kbprintf (fun () -> buf.ToString()) buf $"%x{0}%x{1}")) "01"
+
+let _ = test "cewoui2!" (lazy(sprintf $"%x{0}")) "0"
+let _ = test "cewoui26" (lazy(sprintf $"%x{5}")) "5"
+let _ = test "cewoui2f" (lazy(sprintf $"%x{8}")) "8"
+let _ = test "cewoui29" (lazy(sprintf $"%x{15}")) "f"
+let _ = test "cewoui2Z" (lazy(sprintf $"%x{System.Int32.MinValue}" )) "80000000"
+let _ = test "cewoui2X" (lazy(sprintf $"%x{0xffffffff}" )) "ffffffff"
+let _ = test "cewoui2A" (lazy(sprintf $"%x{System.Int32.MinValue+1}" )) "80000001"
+let _ = test "cewoui2Q" (lazy(sprintf $"%x{System.Int32.MaxValue}" )) "7fffffff"
+
+let fx z = sprintf $"%x{z}"
+let _ = test "cewoui2W" (lazy(fx 0)) "0"
+let _ = test "cewoui2E" (lazy(fx 5)) "5"
+let _ = test "cewoui2R" (lazy(fx 8)) "8"
+let _ = test "cewoui2T" (lazy(fx 15)) "f"
+let _ = test "cewoui2Y" (lazy(fx System.Int32.MinValue)) "80000000"
+let _ = test "cewoui2U" (lazy(fx 0xffffffff)) "ffffffff"
+let _ = test "cewoui2I" (lazy(fx (System.Int32.MinValue+1))) "80000001"
+let _ = test "cewoui2O" (lazy(fx System.Int32.MaxValue)) "7fffffff"
+
+let _ = test "cewoui2Z" (lazy(sprintf $"%X{0}")) "0"
+let _ = test "cewoui2X" (lazy(sprintf $"%X{5}")) "5"
+let _ = test "cewoui2C" (lazy(sprintf $"%X{8}")) "8"
+let _ = test "cewoui2V" (lazy(sprintf $"%X{15}")) "F"
+let _ = test "cewoui2v" (lazy(sprintf $"%X{System.Int32.MinValue}" )) "80000000"
+let _ = test "cewoui2B" (lazy(sprintf $"%X{0xffffffff}" )) "FFFFFFFF"
+let _ = test "cewoui2N" (lazy(sprintf $"%X{System.Int32.MinValue+1}")) "80000001"
+let _ = test "cewoui2M" (lazy(sprintf $"%X{System.Int32.MaxValue}" )) "7FFFFFFF"
+
+let _ = test "cewou44a" (lazy(sprintf $"%u{0}")) "0"
+let _ = test "cewou44b" (lazy(sprintf $"%u{5}" )) "5"
+let _ = test "cewou44c" (lazy(sprintf $"%u{8}" )) "8"
+let _ = test "cewou44d" (lazy(sprintf $"%u{15}" )) "15"
+let _ = test "cewou44e" (lazy(sprintf $"%u{System.Int32.MinValue}" )) "2147483648"
+let _ = test "cewou44f" (lazy(sprintf $"%u{0xffffffff}" )) "4294967295"
+let _ = test "cewou44g" (lazy(sprintf $"%u{System.Int32.MinValue+1}" )) "2147483649"
+let _ = test "cewou44h" (lazy(sprintf $"%u{System.Int32.MaxValue}" )) "2147483647"
+
+let _ = test "cewou45a" (lazy(sprintf $"%d{0ul}" )) "0"
+let _ = test "cewou45b" (lazy(sprintf $"%d{5ul}" )) "5"
+let _ = test "cewou45c" (lazy(sprintf $"%d{8ul}" )) "8"
+let _ = test "cewou45d" (lazy(sprintf $"%d{15ul}" )) "15"
+let _ = test "cewou45e" (lazy(sprintf $"%d{2147483648ul}" )) "2147483648"
+let _ = test "cewou45f" (lazy(sprintf $"%d{4294967295ul}" )) "4294967295"
+let _ = test "cewou45g" (lazy(sprintf $"%d{2147483649ul}" )) "2147483649"
+let _ = test "cewou45h" (lazy(sprintf $"%d{2147483647ul}" )) "2147483647"
+
+let _ = test "cewou46a" (lazy(sprintf $"%d{0ul}" )) "0"
+let _ = test "cewou46b" (lazy(sprintf $"%d{5ul}" )) "5"
+let _ = test "cewou46c" (lazy(sprintf $"%d{8ul}" )) "8"
+let _ = test "cewou46d" (lazy(sprintf $"%d{15ul}" )) "15"
+let _ = test "cewou46e" (lazy(sprintf $"%d{2147483648ul}" )) "2147483648"
+let _ = test "cewou46f" (lazy(sprintf $"%d{4294967295ul}" )) "4294967295"
+let _ = test "cewou46g" (lazy(sprintf $"%d{2147483649ul}" )) "2147483649"
+let _ = test "cewou46h" (lazy(sprintf $"%d{2147483647ul}" )) "2147483647"
+
+let _ = test "ceew903" (lazy(sprintf $"%u{System.Int64.MaxValue}" )) "9223372036854775807"
+let _ = test "ceew903" (lazy(sprintf $"%u{System.Int64.MinValue}" )) "9223372036854775808"
+let _ = test "ceew903" (lazy(sprintf $"%d{System.Int64.MaxValue}" )) "9223372036854775807"
+let _ = test "ceew903" (lazy(sprintf $"%d{System.Int64.MinValue}" )) "-9223372036854775808"
+
+let _ = test "ceew903" (lazy(sprintf $"%u{System.Int64.MaxValue}" )) "9223372036854775807"
+let _ = test "ceew903" (lazy(sprintf $"%u{System.Int64.MinValue}" )) "9223372036854775808"
+let _ = test "ceew903" (lazy(sprintf $"%d{System.Int64.MaxValue}" )) "9223372036854775807"
+let _ = test "ceew903" (lazy(sprintf $"%d{System.Int64.MinValue}" )) "-9223372036854775808"
+
+let _ = test "cewou47a" (lazy(sprintf $"%d{0n}" )) "0"
+let _ = test "cewou47b" (lazy(sprintf $"%d{5n}" )) "5"
+let _ = test "cewou47c" (lazy(sprintf $"%d{8n}" )) "8"
+let _ = test "cewou47d" (lazy(sprintf $"%d{15n}" )) "15"
+let _ = test "cewou47e" (lazy(sprintf $"%u{2147483648n}" )) "2147483648"
+let _ = test "cewou47f" (lazy(sprintf $"%u{4294967295n}" )) "4294967295"
+let _ = test "cewou47g" (lazy(sprintf $"%u{2147483649n}" )) "2147483649"
+let _ = test "cewou47h" (lazy(sprintf $"%u{2147483647n}" )) "2147483647"
+
+let _ = test "cewou47a" (lazy(sprintf $"%d{0n}" )) "0"
+let _ = test "cewou47b" (lazy(sprintf $"%d{5n}" )) "5"
+let _ = test "cewou47c" (lazy(sprintf $"%d{8n}" )) "8"
+let _ = test "cewou47d" (lazy(sprintf $"%d{15n}" )) "15"
+let _ = test "cewou47e" (lazy(sprintf $"%u{2147483648n}" )) "2147483648"
+let _ = test "cewou47f" (lazy(sprintf $"%u{4294967295n}" )) "4294967295"
+let _ = test "cewou47g" (lazy(sprintf $"%u{2147483649n}" )) "2147483649"
+let _ = test "cewou47h" (lazy(sprintf $"%u{2147483647n}" )) "2147483647"
+
+let _ = test "cewou48a" (lazy(sprintf $"%d{0un}" )) "0"
+let _ = test "cewou48b" (lazy(sprintf $"%d{5un}" )) "5"
+let _ = test "cewou48c" (lazy(sprintf $"%d{8un}" )) "8"
+let _ = test "cewou48d" (lazy(sprintf $"%d{15un}" )) "15"
+let _ = test "cewou48e" (lazy(sprintf $"%u{2147483648un}" )) "2147483648"
+let _ = test "cewou48f" (lazy(sprintf $"%u{4294967295un}" )) "4294967295"
+let _ = test "cewou48g" (lazy(sprintf $"%u{2147483649un}" )) "2147483649"
+let _ = test "cewou48h" (lazy(sprintf $"%u{2147483647un}" )) "2147483647"
+
+let _ = test "cewou49c" (lazy(sprintf $"%+d{5}" )) "+5"
+let _ = test "cewou49d" (lazy(sprintf $"% d{5}" )) " 5"
+let _ = test "cewou49e" (lazy(sprintf $"%+4d{5}" )) " +5"
+let _ = test "cewou49f" (lazy(sprintf $"%-+4d{5}" )) "+5 "
+let _ = test "cewou49g" (lazy(sprintf $"%-4d{5}" )) "5 "
+let _ = test "cewou49h" (lazy(sprintf $"%- 4d{5}" )) " 5 "
+let _ = test "cewou49i" (lazy(sprintf $"%- d{5}" )) " 5"
+let _ = test "cewou49j" (lazy(sprintf $"% d{5}" )) " 5"
+let _ = test "weioj31" (lazy(sprintf $"%3d{5}")) " 5"
+let _ = test "weioj32" (lazy(sprintf $"%1d{5}")) "5"
+let _ = test "weioj33" (lazy(sprintf $"%2d{500}")) "500"
+
+let _ =
+ test "test8535" (lazy(sprintf $"""%t{(fun _ -> "???")}""" )) "???"
+ test "test8536" (lazy(sprintf $"A%d{0}B")) "A0B"
+ test "test8537" (lazy(sprintf $"A%d{0}B%d{1}C")) "A0B1C"
+ test "test8538" (lazy(sprintf $"A%d{0}B%d{1}C%d{2}D")) "A0B1C2D"
+ test "test8539" (lazy(sprintf $"A%d{0}B%d{1}C%d{2}D%d{3}E")) "A0B1C2D3E"
+ test "test8540" (lazy(sprintf $"A%d{0}B%d{1}C%d{2}D%d{3}E%d{4}F")) "A0B1C2D3E4F"
+ test "test8541" (lazy(sprintf $"A%d{0}B%d{1}C%d{2}D%d{3}E%d{4}F%d{5}G")) "A0B1C2D3E4F5G"
+ test "test8542" (lazy(sprintf $"A%d{0}B%d{1}C%d{2}D%d{3}E%d{4}F%d{5}G%d{6}H")) "A0B1C2D3E4F5G6H"
+ test "test8543" (lazy(sprintf $"A%d{0}B%d{1}C%d{2}D%d{3}E%d{4}F%d{5}G%d{6}H%d{7}I")) "A0B1C2D3E4F5G6H7I"
+
+
+let _ =
+ test "test8361" (lazy(sprintf $"""%A{"abc"}""")) "\"abc\""
+ test "test8362" (lazy(sprintf $"""%5A{"abc"}""")) "\"abc\""
+ test "test8363" (lazy(sprintf $"""%1A{"abc"}""")) "\"abc\""
+ test "test8365" (lazy(sprintf $"""%.5A{"abc"}""")) "\"abc\""
+ test "test8368" (lazy(sprintf $"""%-A{"abc"}""")) "\"abc\""
+ test "test8369" (lazy(sprintf $"""%-5A{"abc"}""")) "\"abc\""
+ test "test8370" (lazy(sprintf $"""%-1A{"abc"}""")) "\"abc\""
+ test "test8372" (lazy(sprintf $"""%-.5A{"abc"}""")) "\"abc\""
+ test "test8375" (lazy(sprintf $"""%+A{"abc"}""")) "\"abc\""
+ test "test8376" (lazy(sprintf $"""%+5A{"abc"}""")) "\"abc\""
+ test "test8377" (lazy(sprintf $"""%+1A{"abc"}""")) "\"abc\""
+ test "test8379" (lazy(sprintf $"""%+.5A{"abc"}""")) "\"abc\""
+ test "test8382" (lazy(sprintf $"""%-+A{"abc"}""")) "\"abc\""
+ test "test8383" (lazy(sprintf $"""%-+5A{"abc"}""")) "\"abc\""
+ test "test8384" (lazy(sprintf $"""%-+1A{"abc"}""")) "\"abc\""
+ test "test8386" (lazy(sprintf $"""%-+.5A{"abc"}""")) "\"abc\""
+ test "test8389" (lazy(sprintf $"""%A{15}""")) "15"
+ test "test8390" (lazy(sprintf $"""%5A{15}""")) "15"
+ test "test8391" (lazy(sprintf $"""%1A{15}""")) "15"
+ test "test8393" (lazy(sprintf $"""%.5A{15}""")) "15"
+ test "test8396" (lazy(sprintf $"""%-A{15}""")) "15"
+ test "test8397" (lazy(sprintf $"""%-5A{15}""")) "15"
+ test "test8398" (lazy(sprintf $"""%-1A{15}""")) "15"
+ test "test8400" (lazy(sprintf $"""%-.5A{15}""")) "15"
+ test "test8403" (lazy(sprintf $"""%+A{15}""")) "15"
+ test "test8404" (lazy(sprintf $"""%+5A{15}""")) "15"
+ test "test8405" (lazy(sprintf $"""%+1A{15}""")) "15"
+ test "test8407" (lazy(sprintf $"""%+.5A{15}""")) "15"
+ test "test8410" (lazy(sprintf $"""%-+A{15}""")) "15"
+ test "test8411" (lazy(sprintf $"""%-+5A{15}""")) "15"
+ test "test8412" (lazy(sprintf $"""%-+1A{15}""")) "15"
+ test "test8414" (lazy(sprintf $"""%-+.5A{15}""")) "15"
+
+ test "test8417" (lazy(sprintf $"""%A{-10}""")) "-10"
+ test "test8418" (lazy(sprintf $"""%5A{-10}""")) "-10"
+ test "test8419" (lazy(sprintf $"""%1A{-10}""")) "-10"
+ test "test8421" (lazy(sprintf $"""%.5A{-10}""")) "-10"
+ test "test8424" (lazy(sprintf $"""%-A{-10}""")) "-10"
+ test "test8425" (lazy(sprintf $"""%-5A{-10}""")) "-10"
+ test "test8426" (lazy(sprintf $"""%-1A{-10}""")) "-10"
+ test "test8428" (lazy(sprintf $"""%-.5A{-10}""")) "-10"
+ test "test8431" (lazy(sprintf $"""%+A{-10}""")) "-10"
+ test "test8432" (lazy(sprintf $"""%+5A{-10}""")) "-10"
+ test "test8433" (lazy(sprintf $"""%+1A{-10}""")) "-10"
+ test "test8435" (lazy(sprintf $"""%+.5A{-10}""")) "-10"
+ test "test8438" (lazy(sprintf $"""%-+A{-10}""")) "-10"
+ test "test8439" (lazy(sprintf $"""%-+5A{-10}""")) "-10"
+ test "test8440" (lazy(sprintf $"""%-+1A{-10}""")) "-10"
+ test "test8442" (lazy(sprintf $"""%-+.5A{-10}""")) "-10"
+
+ // Check the static type matters for %A holes
+ test "test8445b1" (lazy(sprintf $"""%A{(Unchecked.defaultof)}""")) "None"
+ test "test8445b2" (lazy(sprintf $"""%A{box (None: int option)}""")) ""
+ test "test8445b3" (lazy(sprintf $"""%A{(None: int option)}""")) "None"
+ test "test8445b4" (lazy(sprintf $"""%A{(None: string option)}""")) "None"
+ test "test8445b5" (lazy(sprintf $"""%A{(None: obj option)}""")) "None"
+ test "test8445b6" (lazy($"""%A{(Unchecked.defaultof)}""")) "None"
+ test "test8445b7a" (lazy($"""{null}""")) ""
+ test "test8445b7b" (lazy($"""%O{null}""")) ""
+ test "test8445b8" (lazy($"""%A{null}""")) ""
+ test "test8445b9" (lazy($"""%A{box (None: int option)}""")) ""
+ test "test8445b10" (lazy($"""%A{(None: int option)}""")) "None"
+ test "test8445b11" (lazy($"""%A{(None: string option)}""")) "None"
+ test "test8445b12" (lazy($"""%A{(None: obj option)}""")) "None"
+
+ test "test8445" (lazy(sprintf $"""%A{null}""")) ""
+ test "test8446" (lazy(sprintf $"""%5A{null}""")) ""
+ test "test8447" (lazy(sprintf $"""%1A{null}""")) ""
+ test "test8449" (lazy(sprintf $"""%.5A{null}""")) ""
+ test "test8452" (lazy(sprintf $"""%-A{null}""")) ""
+ test "test8453" (lazy(sprintf $"""%-5A{null}""")) ""
+ test "test8454" (lazy(sprintf $"""%-1A{null}""")) ""
+ test "test8456" (lazy(sprintf $"""%-.5A{null}""")) ""
+ test "test8459" (lazy(sprintf $"""%+A{null}""")) ""
+ test "test8460" (lazy(sprintf $"""%+5A{null}""")) ""
+ test "test8461" (lazy(sprintf $"""%+1A{null}""")) ""
+ test "test8463" (lazy(sprintf $"""%+.5A{null}""")) ""
+ test "test8466" (lazy(sprintf $"""%-+A{null}""")) ""
+ test "test8467" (lazy(sprintf $"""%-+5A{null}""")) ""
+ test "test8468" (lazy(sprintf $"""%-+1A{null}""")) ""
+ test "test8470" (lazy(sprintf $"""%-+.5A{null}""")) ""
+
+
+#if TESTS_AS_APP
+let RUN() = !failures
+#else
+let aa =
+ match !failures with
+ | [] ->
+ stdout.WriteLine "Test Passed"
+ System.IO.File.WriteAllText("test.ok","ok")
+ exit 0
+ | _ ->
+ stdout.WriteLine "Test Failed"
+ exit 1
+#endif
+
diff --git a/tests/fsharp/core/printf/test.fsx b/tests/fsharp/core/printf/test.fsx
index fe48744f84e..af5673500f3 100644
--- a/tests/fsharp/core/printf/test.fsx
+++ b/tests/fsharp/core/printf/test.fsx
@@ -25,6 +25,7 @@ let rnd = System.Random()
let test t (s1:Lazy) s2 =
if runEveryTest || (rnd.Next() % 10) = 0 then
+ stdout.WriteLine ("running test "+t+"...")
let s1 = s1.Force()
if s1 <> s2 then
report_failure ("test "+t+": expected \n\t'"+s2+"' but produced \n\t'"+s1+"'")
diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs
index ba2223ce8c8..a7e6fdfa37b 100644
--- a/tests/fsharp/tests.fs
+++ b/tests/fsharp/tests.fs
@@ -196,7 +196,10 @@ module CoreTests =
let ``letrec (mutrec variations part two) FSI_BASIC`` () = singleTestBuildAndRun' "core/letrec-mutrec2" FSI_BASIC
[]
- let ``printf-FSC_BASIC`` () = singleTestBuildAndRun' "core/printf" FSC_BASIC
+ let ``printf`` () = singleTestBuildAndRun' "core/printf" FSC_BASIC
+
+ []
+ let ``printf-interpolated`` () = singleTestBuildAndRunVersion' "core/printf-interpolated" FSC_BASIC "preview"
[]
let ``tlr-FSC_BASIC`` () = singleTestBuildAndRun' "core/tlr" FSC_BASIC
diff --git a/tests/service/Common.fs b/tests/service/Common.fs
index 5b48e637d96..520b54ad3f8 100644
--- a/tests/service/Common.fs
+++ b/tests/service/Common.fs
@@ -168,7 +168,7 @@ let parseAndCheckFile fileName source options =
| parseResults, FSharpCheckFileAnswer.Succeeded(checkResults) -> parseResults, checkResults
| _ -> failwithf "Parsing aborted unexpectedly..."
-let parseAndCheckScript (file, input) =
+let parseAndCheckScriptWithOptions (file, input, opts) =
#if NETCOREAPP
let dllName = Path.ChangeExtension(file, ".dll")
@@ -179,9 +179,10 @@ let parseAndCheckScript (file, input) =
#else
let projectOptions, _diagnostics = checker.GetProjectOptionsFromScript(file, FSharp.Compiler.Text.SourceText.ofString input) |> Async.RunSynchronously
- printfn "projectOptions = %A" projectOptions
+ //printfn "projectOptions = %A" projectOptions
#endif
+ let projectOptions = { projectOptions with OtherOptions = Array.append opts projectOptions.OtherOptions }
let parseResult, typedRes = checker.ParseAndCheckFileInProject(file, 0, FSharp.Compiler.Text.SourceText.ofString input, projectOptions) |> Async.RunSynchronously
// if parseResult.Errors.Length > 0 then
@@ -192,6 +193,8 @@ let parseAndCheckScript (file, input) =
| FSharpCheckFileAnswer.Succeeded(res) -> parseResult, res
| res -> failwithf "Parsing did not finish... (%A)" res
+let parseAndCheckScript (file, input) = parseAndCheckScriptWithOptions (file, input, [| |])
+
let parseSourceCode (name: string, code: string) =
let location = Path.Combine(Path.GetTempPath(),"test"+string(hash (name, code)))
try Directory.CreateDirectory(location) |> ignore with _ -> ()
@@ -202,6 +205,16 @@ let parseSourceCode (name: string, code: string) =
let parseResults = checker.ParseFile(filePath, FSharp.Compiler.Text.SourceText.ofString code, options) |> Async.RunSynchronously
parseResults.ParseTree
+let matchBraces (name: string, code: string) =
+ let location = Path.Combine(Path.GetTempPath(),"test"+string(hash (name, code)))
+ try Directory.CreateDirectory(location) |> ignore with _ -> ()
+ let filePath = Path.Combine(location, name + ".fs")
+ let dllPath = Path.Combine(location, name + ".dll")
+ let args = mkProjectCommandLineArgs(dllPath, [filePath])
+ let options, errors = checker.GetParsingOptionsFromCommandLineArgs(List.ofArray args)
+ let braces = checker.MatchBraces(filePath, FSharp.Compiler.Text.SourceText.ofString code, options) |> Async.RunSynchronously
+ braces
+
let parseSourceCodeAndGetModule (source: string) =
match parseSourceCode ("test", source) with
| Some (ParsedInput.ImplFile (ParsedImplFileInput (_, _, _, _, _, [ moduleOrNamespace ], _))) -> moduleOrNamespace
diff --git a/tests/service/EditorTests.fs b/tests/service/EditorTests.fs
index ca0ce605d0a..6c50d1e8906 100644
--- a/tests/service/EditorTests.fs
+++ b/tests/service/EditorTests.fs
@@ -545,6 +545,62 @@ let _ = debug "[LanguageService] Type checking fails for '%s' with content=%A an
(4, 82, 4, 84, 1);
(4, 108, 4, 110, 1)|]
+#if ASSUME_PREVIEW_FSHARP_CORE
+[]
+let ``Printf specifiers for regular and verbatim interpolated strings`` () =
+ let input =
+ """let os = System.Text.StringBuilder() // line 1
+let _ = $"{0}" // line 2
+let _ = $"%A{0}" // line 3
+let _ = $"%7.1f{1.0}" // line 4
+let _ = $"%-8.1e{1.0}+567" // line 5
+let s = "value" // line 6
+let _ = $@"%-5s{s}" // line 7
+let _ = $@"%-A{-10}" // line 8
+let _ = @$"
+ %-O{-10}" // line 10
+let _ = $"
+
+ %-O{-10}" // line 13
+let _ = List.map (fun x -> sprintf $@"%A{x}
+ ") // line 15
+let _ = $"\n%-8.1e{1.0}+567" // line 16
+let _ = $@"%O{1}\n%-5s{s}" // line 17
+let _ = $"%%" // line 18
+let s2 = $"abc %d{s.Length} and %d{s.Length}def" // line 19
+let s3 = $"abc %d{s.Length}
+ and %d{s.Length}def" // line 21
+"""
+
+ let file = "/home/user/Test.fsx"
+ let parseResult, typeCheckResults = parseAndCheckScriptWithOptions(file, input, [| "/langversion:preview" |])
+
+ typeCheckResults.Errors |> shouldEqual [||]
+ typeCheckResults.GetFormatSpecifierLocationsAndArity()
+ |> Array.map (fun (range,numArgs) -> range.StartLine, range.StartColumn, range.EndLine, range.EndColumn, numArgs)
+ |> shouldEqual
+ [|(3, 10, 3, 12, 1); (4, 10, 4, 15, 1); (5, 10, 5, 16, 1); (7, 11, 7, 15, 1);
+ (8, 11, 8, 14, 1); (10, 12, 10, 15, 1); (13, 12, 13, 15, 1);
+ (14, 38, 14, 40, 1); (16, 12, 16, 18, 1); (17, 11, 17, 13, 1);
+ (17, 18, 17, 22, 1); (18, 10, 18, 12, 0); (19, 15, 19, 17, 1);
+ (19, 32, 19, 34, 1); (20, 15, 20, 17, 1); (21, 20, 21, 22, 1)|]
+
+[]
+let ``Printf specifiers for triple quote interpolated strings`` () =
+ let input =
+ "let _ = $\"\"\"abc %d{1} and %d{2+3}def\"\"\" "
+
+ let file = "/home/user/Test.fsx"
+ let parseResult, typeCheckResults = parseAndCheckScriptWithOptions(file, input, [| "/langversion:preview" |])
+
+ typeCheckResults.Errors |> shouldEqual [||]
+ typeCheckResults.GetFormatSpecifierLocationsAndArity()
+ |> Array.map (fun (range,numArgs) -> range.StartLine, range.StartColumn, range.EndLine, range.EndColumn, numArgs)
+ |> shouldEqual
+ [|(1, 16, 1, 18, 1); (1, 26, 1, 28, 1)|]
+#endif // ASSUME_PREVIEW_FSHARP_CORE
+
+
[]
let ``should not report format specifiers for illformed format strings`` () =
let input =
@@ -1372,3 +1428,52 @@ let ``Inherit ctor arg recovery`` () =
let x = this
"""
assertHasSymbolUsages ["x"] checkResults
+
+[]
+let ``Brace matching smoke test`` () =
+ let input =
+ """
+let x1 = { contents = 1 }
+let x2 = {| contents = 1 |}
+let x3 = [ 1 ]
+let x4 = [| 1 |]
+let x5 = $"abc{1}def"
+"""
+ let file = "/home/user/Test.fsx"
+ let braces = matchBraces(file, input)
+
+ braces
+ |> Array.map (fun (r1,r2) ->
+ (r1.StartLine, r1.StartColumn, r1.EndLine, r1.EndColumn),
+ (r2.StartLine, r2.StartColumn, r2.EndLine, r2.EndColumn))
+ |> shouldEqual
+ [|((2, 9, 2, 10), (2, 24, 2, 25));
+ ((3, 9, 3, 11), (3, 25, 3, 27));
+ ((4, 9, 4, 10), (4, 13, 4, 14));
+ ((5, 9, 5, 11), (5, 14, 5, 16));
+ ((6, 14, 6, 15), (6, 16, 6, 17))|]
+
+
+[]
+let ``Brace matching in interpolated strings`` () =
+ let input =
+ "
+let x5 = $\"abc{1}def\"
+let x6 = $\"abc{1}def{2}hij\"
+let x7 = $\"\"\"abc{1}def{2}hij\"\"\"
+let x8 = $\"\"\"abc{ {contents=1} }def{2}hij\"\"\"
+"
+ let file = "/home/user/Test.fsx"
+ let braces = matchBraces(file, input)
+
+ braces
+ |> Array.map (fun (r1,r2) ->
+ (r1.StartLine, r1.StartColumn, r1.EndLine, r1.EndColumn),
+ (r2.StartLine, r2.StartColumn, r2.EndLine, r2.EndColumn))
+ |> shouldEqual
+ [|((2, 14, 2, 15), (2, 16, 2, 17)); ((3, 14, 3, 15), (3, 16, 3, 17));
+ ((3, 20, 3, 21), (3, 22, 3, 23)); ((4, 16, 4, 17), (4, 18, 4, 19));
+ ((4, 22, 4, 23), (4, 24, 4, 25)); ((5, 19, 5, 20), (5, 30, 5, 31));
+ ((5, 16, 5, 17), (5, 32, 5, 33)); ((5, 36, 5, 37), (5, 38, 5, 39))|]
+
+
diff --git a/tests/service/ProjectAnalysisTests.fs b/tests/service/ProjectAnalysisTests.fs
index 1e6b1c418cc..110db85e4f5 100644
--- a/tests/service/ProjectAnalysisTests.fs
+++ b/tests/service/ProjectAnalysisTests.fs
@@ -3800,7 +3800,7 @@ let ``Test Project26 parameter symbols`` () =
let rec isByRef (ty: FSharpType) =
if ty.IsAbbreviation then isByRef ty.AbbreviatedType
- else ty.IsNamedType && ty.NamedEntity.IsByRef
+ else ty.HasTypeDefinition && ty.TypeDefinition.IsByRef
// check we can get the CurriedParameterGroups
let objMethodsCurriedParameterGroups =
diff --git a/tests/service/TokenizerTests.fs b/tests/service/TokenizerTests.fs
index 0827ff35027..6dea4640543 100644
--- a/tests/service/TokenizerTests.fs
+++ b/tests/service/TokenizerTests.fs
@@ -32,7 +32,7 @@ let tokenizeLines (lines:string[]) =
yield n, parseLine(line, state, tokenizer) |> List.ofSeq ]
[]
-let ``Tokenizer test 1``() =
+let ``Tokenizer test - simple let with string``() =
let tokenizedLines =
tokenizeLines
[| "// Sets the hello wrold variable"
@@ -54,5 +54,164 @@ let ``Tokenizer test 1``() =
("STRING_TEXT", "\""); ("STRING_TEXT", "Hello"); ("STRING_TEXT", " ");
("STRING_TEXT", "world"); ("STRING", "\""); ("WHITESPACE", " ")])]
- Assert.AreEqual(actual, expected)
+ if actual <> expected then
+ printfn "actual = %A" actual
+ printfn "expected = %A" expected
+ Assert.Fail(sprintf "actual and expected did not match,actual =\n%A\nexpected=\n%A\n" actual expected)
+
+[]
+let ``Tokenizer test 2 - single line non-nested string interpolation``() =
+ let tokenizedLines =
+ tokenizeLines
+ [| "// Tests tokenizing string interpolation"
+ "let hello0 = $\"\""
+ "let hello1 = $\"Hello world\" "
+ "let hello2 = $\"Hello world {1+1} = {2}\" "
+ "let hello0v = @$\"\""
+ "let hello1v = @$\"Hello world\" "
+ "let hello2v = @$\"Hello world {1+1} = {2}\" " |]
+
+ let actual =
+ [ for lineNo, lineToks in tokenizedLines do
+ yield lineNo, [ for str, info in lineToks do yield info.TokenName, str ] ]
+ let expected =
+ [(0,
+ [("LINE_COMMENT", "//"); ("LINE_COMMENT", " "); ("LINE_COMMENT", "Tests");
+ ("LINE_COMMENT", " "); ("LINE_COMMENT", "tokenizing"); ("LINE_COMMENT", " ");
+ ("LINE_COMMENT", "string"); ("LINE_COMMENT", " ");
+ ("LINE_COMMENT", "interpolation")]);
+ (1,
+ [("LET", "let"); ("WHITESPACE", " "); ("IDENT", "hello0"); ("WHITESPACE", " ");
+ ("EQUALS", "="); ("WHITESPACE", " "); ("STRING_TEXT", "$\"");
+ ("INTERP_STRING_BEGIN_END", "\"")]);
+ (2,
+ [("LET", "let"); ("WHITESPACE", " "); ("IDENT", "hello1"); ("WHITESPACE", " ");
+ ("EQUALS", "="); ("WHITESPACE", " "); ("STRING_TEXT", "$\"");
+ ("STRING_TEXT", "Hello"); ("STRING_TEXT", " "); ("STRING_TEXT", "world");
+ ("INTERP_STRING_BEGIN_END", "\""); ("WHITESPACE", " ")]);
+ (3,
+ [("LET", "let"); ("WHITESPACE", " "); ("IDENT", "hello2"); ("WHITESPACE", " ");
+ ("EQUALS", "="); ("WHITESPACE", " "); ("STRING_TEXT", "$\"");
+ ("STRING_TEXT", "Hello"); ("STRING_TEXT", " "); ("STRING_TEXT", "world");
+ ("STRING_TEXT", " "); ("INTERP_STRING_BEGIN_PART", "{"); ("INT32", "1");
+ ("PLUS_MINUS_OP", "+"); ("INT32", "1"); ("STRING_TEXT", "}");
+ ("STRING_TEXT", " "); ("STRING_TEXT", "="); ("STRING_TEXT", " ");
+ ("INTERP_STRING_PART", "{"); ("INT32", "2"); ("STRING_TEXT", "}");
+ ("INTERP_STRING_END", "\""); ("WHITESPACE", " ")]);
+ (4,
+ [("LET", "let"); ("WHITESPACE", " "); ("IDENT", "hello0v");
+ ("WHITESPACE", " "); ("EQUALS", "="); ("WHITESPACE", " ");
+ ("STRING_TEXT", "@$\""); ("INTERP_STRING_BEGIN_END", "\"")]);
+ (5,
+ [("LET", "let"); ("WHITESPACE", " "); ("IDENT", "hello1v");
+ ("WHITESPACE", " "); ("EQUALS", "="); ("WHITESPACE", " ");
+ ("STRING_TEXT", "@$\""); ("STRING_TEXT", "Hello"); ("STRING_TEXT", " ");
+ ("STRING_TEXT", "world"); ("INTERP_STRING_BEGIN_END", "\"");
+ ("WHITESPACE", " ")]);
+ (6,
+ [("LET", "let"); ("WHITESPACE", " "); ("IDENT", "hello2v");
+ ("WHITESPACE", " "); ("EQUALS", "="); ("WHITESPACE", " ");
+ ("STRING_TEXT", "@$\""); ("STRING_TEXT", "Hello"); ("STRING_TEXT", " ");
+ ("STRING_TEXT", "world"); ("STRING_TEXT", " ");
+ ("INTERP_STRING_BEGIN_PART", "{"); ("INT32", "1"); ("PLUS_MINUS_OP", "+");
+ ("INT32", "1"); ("STRING_TEXT", "}"); ("STRING_TEXT", " ");
+ ("STRING_TEXT", "="); ("STRING_TEXT", " "); ("INTERP_STRING_PART", "{");
+ ("INT32", "2"); ("STRING_TEXT", "}"); ("INTERP_STRING_END", "\"");
+ ("WHITESPACE", " ")]);]
+
+ if actual <> expected then
+ printfn "actual = %A" actual
+ printfn "expected = %A" expected
+ Assert.Fail(sprintf "actual and expected did not match,actual =\n%A\nexpected=\n%A\n" actual expected)
+
+
+[]
+let ``Tokenizer test - multiline non-nested string interpolation``() =
+ let tokenizedLines =
+ tokenizeLines
+ [| "let hello1t = $\"\"\"abc {1+"
+ " 1} def\"\"\"" |]
+
+ let actual =
+ [ for lineNo, lineToks in tokenizedLines do
+ yield lineNo, [ for str, info in lineToks do yield info.TokenName, str ] ]
+ let expected =
+ [(0,
+ [("LET", "let"); ("WHITESPACE", " "); ("IDENT", "hello1t");
+ ("WHITESPACE", " "); ("EQUALS", "="); ("WHITESPACE", " ");
+ ("STRING_TEXT", "$\"\"\""); ("STRING_TEXT", "abc"); ("STRING_TEXT", " ");
+ ("INTERP_STRING_BEGIN_PART", "{"); ("INT32", "1"); ("PLUS_MINUS_OP", "+")]);
+ (1,
+ [("WHITESPACE", " "); ("INT32", "1"); ("STRING_TEXT", "}");
+ ("STRING_TEXT", " "); ("STRING_TEXT", "def"); ("INTERP_STRING_END", "\"\"\"")])]
+
+ if actual <> expected then
+ printfn "actual = %A" actual
+ printfn "expected = %A" expected
+ Assert.Fail(sprintf "actual and expected did not match,actual =\n%A\nexpected=\n%A\n" actual expected)
+
+[]
+// checks nested '{' and nested single-quote strings
+let ``Tokenizer test - multi-line nested string interpolation``() =
+ let tokenizedLines =
+ tokenizeLines
+ [| "let hello1t = $\"\"\"abc {\"a\" + "
+ " { "
+ " contents = \"b\" "
+ " }.contents "
+ " } def\"\"\"" |]
+
+ let actual =
+ [ for lineNo, lineToks in tokenizedLines do
+ yield lineNo, [ for str, info in lineToks do yield info.TokenName, str ] ]
+ let expected =
+ [(0,
+ [("LET", "let"); ("WHITESPACE", " "); ("IDENT", "hello1t");
+ ("WHITESPACE", " "); ("EQUALS", "="); ("WHITESPACE", " ");
+ ("STRING_TEXT", "$\"\"\""); ("STRING_TEXT", "abc"); ("STRING_TEXT", " ");
+ ("INTERP_STRING_BEGIN_PART", "{"); ("STRING_TEXT", "\""); ("STRING_TEXT", "a");
+ ("STRING", "\""); ("WHITESPACE", " "); ("PLUS_MINUS_OP", "+");
+ ("WHITESPACE", " ")]);
+ (1,
+ [("WHITESPACE", " "); ("LBRACE", "{");
+ ("WHITESPACE", " ")]);
+ (2,
+ [("WHITESPACE", " "); ("IDENT", "contents");
+ ("WHITESPACE", " "); ("EQUALS", "="); ("WHITESPACE", " ");
+ ("STRING_TEXT", "\""); ("STRING_TEXT", "b"); ("STRING", "\"");
+ ("WHITESPACE", " ")]);
+ (3,
+ [("WHITESPACE", " "); ("RBRACE", "}"); ("DOT", ".");
+ ("IDENT", "contents"); ("WHITESPACE", " ")]);
+ (4,
+ [("WHITESPACE", " "); ("STRING_TEXT", "}");
+ ("STRING_TEXT", " "); ("STRING_TEXT", "def"); ("INTERP_STRING_END", "\"\"\"")])]
+
+ if actual <> expected then
+ printfn "actual = %A" actual
+ printfn "expected = %A" expected
+ Assert.Fail(sprintf "actual and expected did not match,actual =\n%A\nexpected=\n%A\n" actual expected)
+
+[]
+let ``Tokenizer test - single-line nested string interpolation``() =
+ let tokenizedLines =
+ tokenizeLines
+ [| " $\"abc { { contents = 1 } }\" " |]
+
+ let actual =
+ [ for lineNo, lineToks in tokenizedLines do
+ yield lineNo, [ for str, info in lineToks do yield info.TokenName, str ] ]
+ let expected =
+ [(0,
+ [("WHITESPACE", " "); ("STRING_TEXT", "$\""); ("STRING_TEXT", "abc");
+ ("STRING_TEXT", " "); ("INTERP_STRING_BEGIN_PART", "{"); ("WHITESPACE", " ");
+ ("LBRACE", "{"); ("WHITESPACE", " "); ("IDENT", "contents");
+ ("WHITESPACE", " "); ("EQUALS", "="); ("WHITESPACE", " "); ("INT32", "1");
+ ("WHITESPACE", " "); ("RBRACE", "}"); ("WHITESPACE", " ");
+ ("STRING_TEXT", "}"); ("INTERP_STRING_END", "\""); ("WHITESPACE", " ")])]
+
+ if actual <> expected then
+ printfn "actual = %A" actual
+ printfn "expected = %A" expected
+ Assert.Fail(sprintf "actual and expected did not match,actual =\n%A\nexpected=\n%A\n" actual expected)
diff --git a/tests/service/data/CSharp_Analysis/CSharp_Analysis.csproj b/tests/service/data/CSharp_Analysis/CSharp_Analysis.csproj
index 4fc4184b23d..51649639ca5 100644
--- a/tests/service/data/CSharp_Analysis/CSharp_Analysis.csproj
+++ b/tests/service/data/CSharp_Analysis/CSharp_Analysis.csproj
@@ -2,9 +2,9 @@
- net45
+ netstandard2.0
1.0.0.0
- nunit
+ none
$(NoWarn);0067;1591
diff --git a/vsintegration/src/FSharp.Editor/AutomaticCompletion/BraceCompletionSessionProvider.fs b/vsintegration/src/FSharp.Editor/AutomaticCompletion/BraceCompletionSessionProvider.fs
index dd3be821094..0ee68698c2e 100644
--- a/vsintegration/src/FSharp.Editor/AutomaticCompletion/BraceCompletionSessionProvider.fs
+++ b/vsintegration/src/FSharp.Editor/AutomaticCompletion/BraceCompletionSessionProvider.fs
@@ -459,6 +459,12 @@ type AsteriskCompletionSession() =
[, FSharpConstants.FSharpLanguageName)>]
type EditorBraceCompletionSessionFactory() =
+ let spanIsNotCommentOrString (span: ClassifiedSpan) =
+ match span.ClassificationType with
+ | ClassificationTypeNames.Comment
+ | ClassificationTypeNames.StringLiteral -> false
+ | _ -> true
+
member __.IsSupportedOpeningBrace openingBrace =
match openingBrace with
| Parenthesis.OpenCharacter | CurlyBrackets.OpenCharacter | SquareBrackets.OpenCharacter
@@ -466,23 +472,37 @@ type EditorBraceCompletionSessionFactory() =
| Asterisk.OpenCharacter -> true
| _ -> false
- member __.CheckCodeContext(document: Document, position: int, _openingBrace, cancellationToken) =
- // We need to know if we are inside a F# comment. If we are, then don't do automatic completion.
+ member __.CheckCodeContext(document: Document, position: int, _openingBrace:char, cancellationToken) =
+ // We need to know if we are inside a F# string or comment. If we are, then don't do automatic completion.
let sourceCodeTask = document.GetTextAsync(cancellationToken)
sourceCodeTask.Wait(cancellationToken)
let sourceCode = sourceCodeTask.Result
position = 0
- || let colorizationData = Tokenizer.getClassifiedSpans(document.Id, sourceCode, TextSpan(position - 1, 1), Some (document.FilePath), [ ], cancellationToken)
- in colorizationData.Count = 0
- || colorizationData.Exists(fun classifiedSpan ->
- classifiedSpan.TextSpan.IntersectsWith position &&
- (
- match classifiedSpan.ClassificationType with
- | ClassificationTypeNames.Comment
- | ClassificationTypeNames.StringLiteral -> false
- | _ -> true // anything else is a valid classification type
- ))
+ || (let colorizationData = Tokenizer.getClassifiedSpans(document.Id, sourceCode, TextSpan(position - 1, 1), Some (document.FilePath), [ ], cancellationToken)
+ colorizationData.Count = 0
+ ||
+ colorizationData.Exists(fun classifiedSpan ->
+ classifiedSpan.TextSpan.IntersectsWith position &&
+ spanIsNotCommentOrString classifiedSpan))
+
+ // This would be the case where '{' has been pressed in a string and the next position
+ // is known not to be a string. This corresponds to the end of an interpolated string part.
+ //
+ // However, Roslyn doesn't activate BraceCompletionSessionProvider for string text at all (and at the time '{
+ // is pressed the text is classified as a string). So this code doesn't get called at all and so
+ // no brace completion is available inside interpolated strings.
+ //
+ // || (openingBrace = '{' &&
+ // colorizationData.Exists(fun classifiedSpan ->
+ // classifiedSpan.TextSpan.IntersectsWith (position-1) &&
+ // spanIsString classifiedSpan) &&
+ // let colorizationData2 = Tokenizer.getClassifiedSpans(document.Id, sourceCode, TextSpan(position, 1), Some (document.FilePath), [ ], cancellationToken)
+ // (colorizationData2.Count = 0
+ // ||
+ // colorizationData2.Exists(fun classifiedSpan ->
+ // classifiedSpan.TextSpan.IntersectsWith position &&
+ // not (spanIsString classifiedSpan)))))
member __.CreateEditorSession(_document, _openingPosition, openingBrace, _cancellationToken) =
match openingBrace with
diff --git a/vsintegration/src/FSharp.Editor/Completion/CompletionUtils.fs b/vsintegration/src/FSharp.Editor/Completion/CompletionUtils.fs
index 5d210d5f363..c5494a39fae 100644
--- a/vsintegration/src/FSharp.Editor/Completion/CompletionUtils.fs
+++ b/vsintegration/src/FSharp.Editor/Completion/CompletionUtils.fs
@@ -89,7 +89,8 @@ module internal CompletionUtils =
let triggerLine = textLines.GetLineFromPosition triggerPosition
let classifiedSpans = Tokenizer.getClassifiedSpans(documentId, sourceText, triggerLine.Span, Some filePath, defines, CancellationToken.None)
classifiedSpans.Count = 0 || // we should provide completion at the start of empty line, where there are no tokens at all
- classifiedSpans.Exists (fun classifiedSpan ->
+ let result =
+ classifiedSpans.Exists (fun classifiedSpan ->
classifiedSpan.TextSpan.IntersectsWith triggerPosition &&
(
match classifiedSpan.ClassificationType with
@@ -100,6 +101,7 @@ module internal CompletionUtils =
| ClassificationTypeNames.NumericLiteral -> false
| _ -> true // anything else is a valid classification type
))
+ result
let inline getKindPriority kind =
match kind with
diff --git a/vsintegration/tests/UnitTests/BraceMatchingServiceTests.fs b/vsintegration/tests/UnitTests/BraceMatchingServiceTests.fs
index 0e71493d22b..67d8f88b882 100644
--- a/vsintegration/tests/UnitTests/BraceMatchingServiceTests.fs
+++ b/vsintegration/tests/UnitTests/BraceMatchingServiceTests.fs
@@ -86,6 +86,19 @@ type BraceMatchingServiceTests() =
member this.BracketInExpression() =
this.VerifyBraceMatch("let x = (3*5)-1", "(3*", ")-1")
+ []
+ member this.BraceInInterpolatedStringSimple() =
+ this.VerifyBraceMatch("let x = $\"abc{1}def\"", "{1", "}def")
+
+ []
+ member this.BraceInInterpolatedStringTwoHoles() =
+ this.VerifyBraceMatch("let x = $\"abc{1}def{2+3}hij\"", "{2", "}hij")
+
+ []
+ member this.BraceInInterpolatedStringNestedRecord() =
+ this.VerifyBraceMatch("let x = $\"abc{ id{contents=3}.contents }\"", "{contents", "}.contents")
+ this.VerifyBraceMatch("let x = $\"abc{ id{contents=3}.contents }\"", "{ id", "}\"")
+
[]
[]
member this.BraceInMultiLineCommentShouldNotBeMatched(startMarker: string) =
diff --git a/vsintegration/tests/UnitTests/CompletionProviderTests.fs b/vsintegration/tests/UnitTests/CompletionProviderTests.fs
index 97ea7cbeff8..520ef2b661c 100644
--- a/vsintegration/tests/UnitTests/CompletionProviderTests.fs
+++ b/vsintegration/tests/UnitTests/CompletionProviderTests.fs
@@ -35,12 +35,12 @@ open FSharp.Compiler.SourceCodeServices
open UnitTests.TestLib.LanguageService
let filePath = "C:\\test.fs"
-let internal projectOptions = {
+let internal projectOptions opts = {
ProjectFileName = "C:\\test.fsproj"
ProjectId = None
SourceFiles = [| filePath |]
ReferencedProjects = [| |]
- OtherOptions = [| |]
+ OtherOptions = opts
IsIncompleteTypeCheckEnvironment = true
UseScriptResolutionRules = false
LoadTime = DateTime.MaxValue
@@ -53,10 +53,10 @@ let internal projectOptions = {
let formatCompletions(completions : string seq) =
"\n\t" + String.Join("\n\t", completions)
-let VerifyCompletionList(fileContents: string, marker: string, expected: string list, unexpected: string list) =
+let VerifyCompletionListWithOptions(fileContents: string, marker: string, expected: string list, unexpected: string list, opts) =
let caretPosition = fileContents.IndexOf(marker) + marker.Length
let results =
- FSharpCompletionProvider.ProvideCompletionsAsyncAux(checker, SourceText.From(fileContents), caretPosition, projectOptions, filePath, 0, (fun _ -> []), LanguageServicePerformanceOptions.Default, IntelliSenseOptions.Default)
+ FSharpCompletionProvider.ProvideCompletionsAsyncAux(checker, SourceText.From(fileContents), caretPosition, projectOptions opts, filePath, 0, (fun _ -> []), LanguageServicePerformanceOptions.Default, IntelliSenseOptions.Default)
|> Async.RunSynchronously
|> Option.defaultValue (ResizeArray())
|> Seq.map(fun result -> result.DisplayText)
@@ -99,12 +99,15 @@ let VerifyCompletionList(fileContents: string, marker: string, expected: string
let msg = sprintf "%s%s%s" expectedNotFoundMsg unexpectedFoundMsg completionsMsg
Assert.Fail(msg)
+let VerifyCompletionList(fileContents, marker, expected, unexpected) =
+ VerifyCompletionListWithOptions(fileContents, marker, expected, unexpected, [| |])
+
let VerifyCompletionListExactly(fileContents: string, marker: string, expected: string list) =
let caretPosition = fileContents.IndexOf(marker) + marker.Length
let actual =
- FSharpCompletionProvider.ProvideCompletionsAsyncAux(checker, SourceText.From(fileContents), caretPosition, projectOptions, filePath, 0, (fun _ -> []), LanguageServicePerformanceOptions.Default, IntelliSenseOptions.Default)
+ FSharpCompletionProvider.ProvideCompletionsAsyncAux(checker, SourceText.From(fileContents), caretPosition, projectOptions [| |], filePath, 0, (fun _ -> []), LanguageServicePerformanceOptions.Default, IntelliSenseOptions.Default)
|> Async.RunSynchronously
|> Option.defaultValue (ResizeArray())
|> Seq.toList
@@ -134,18 +137,18 @@ let ShouldTriggerCompletionAtCorrectMarkers() =
("System.", true)
("Console.", true) ]
- for (marker: string, shouldBeTriggered: bool) in testCases do
- let fileContents = """
+ for (marker, shouldBeTriggered) in testCases do
+ let fileContents = """
let x = 1
let y = 2
System.Console.WriteLine(x + y)
"""
- let caretPosition = fileContents.IndexOf(marker) + marker.Length
- let documentId = DocumentId.CreateNewId(ProjectId.CreateNewId())
- let getInfo() = documentId, filePath, []
- let triggered = FSharpCompletionProvider.ShouldTriggerCompletionAux(SourceText.From(fileContents), caretPosition, CompletionTriggerKind.Insertion, getInfo, IntelliSenseOptions.Default)
- Assert.AreEqual(shouldBeTriggered, triggered, "FSharpCompletionProvider.ShouldTriggerCompletionAux() should compute the correct result")
+ let caretPosition = fileContents.IndexOf(marker) + marker.Length
+ let documentId = DocumentId.CreateNewId(ProjectId.CreateNewId())
+ let getInfo() = documentId, filePath, []
+ let triggered = FSharpCompletionProvider.ShouldTriggerCompletionAux(SourceText.From(fileContents), caretPosition, CompletionTriggerKind.Insertion, getInfo, IntelliSenseOptions.Default)
+ Assert.AreEqual(shouldBeTriggered, triggered, "FSharpCompletionProvider.ShouldTriggerCompletionAux() should compute the correct result")
[]
let ShouldNotTriggerCompletionAfterAnyTriggerOtherThanInsertionOrDeletion() =
@@ -180,6 +183,32 @@ System.Console.WriteLine()
let triggered = FSharpCompletionProvider.ShouldTriggerCompletionAux(SourceText.From(fileContents), caretPosition, CompletionTriggerKind.Insertion, getInfo, IntelliSenseOptions.Default)
Assert.IsFalse(triggered, "FSharpCompletionProvider.ShouldTriggerCompletionAux() should not trigger")
+[]
+let ShouldTriggerCompletionInInterpolatedString() =
+ let fileContents = """
+
+let x = 1
+let y = 2
+let z = $"abc {System.Console.WriteLine(x + y)} def"
+"""
+ let testCases =
+ [
+ ("x", true)
+ ("y", true)
+ ("1", false)
+ ("2", false)
+ ("x +", false)
+ ("Console.Write", false)
+ ("System.", true)
+ ("Console.", true) ]
+
+ for (marker, shouldBeTriggered) in testCases do
+ let caretPosition = fileContents.IndexOf(marker) + marker.Length
+ let documentId = DocumentId.CreateNewId(ProjectId.CreateNewId())
+ let getInfo() = documentId, filePath, []
+ let triggered = FSharpCompletionProvider.ShouldTriggerCompletionAux(SourceText.From(fileContents), caretPosition, CompletionTriggerKind.Insertion, getInfo, IntelliSenseOptions.Default)
+ Assert.AreEqual(shouldBeTriggered, triggered, sprintf "FSharpCompletionProvider.ShouldTriggerCompletionAux() should compute the correct result for marker '%s'" marker)
+
[]
let ShouldNotTriggerCompletionInExcludedCode() =
let fileContents = """
@@ -306,6 +335,16 @@ System.Console.WriteLine()
"""
VerifyCompletionList(fileContents, "System.", ["Console"; "Array"; "String"], ["T1"; "M1"; "M2"])
+[]
+let ShouldDisplaySystemNamespaceInInterpolatedString() =
+ let fileContents = """
+type T1 =
+ member this.M1 = 5
+ member this.M2 = "literal"
+let x = $"1 not the same as {System.Int32.MaxValue} is it"
+"""
+ VerifyCompletionListWithOptions(fileContents, "System.", ["Console"; "Array"; "String"], ["T1"; "M1"; "M2"], [| "/langversion:preview" |])
+
[]
let ``Class instance members are ordered according to their kind and where they are defined (simple case, by a variable)``() =
let fileContents = """
diff --git a/vsintegration/tests/UnitTests/GoToDefinitionServiceTests.fs b/vsintegration/tests/UnitTests/GoToDefinitionServiceTests.fs
index 17322b8faa3..755b66ca085 100644
--- a/vsintegration/tests/UnitTests/GoToDefinitionServiceTests.fs
+++ b/vsintegration/tests/UnitTests/GoToDefinitionServiceTests.fs
@@ -62,6 +62,37 @@ module GoToDefinitionServiceTests =
| _ -> return! None
}
+ let makeOptions filePath args =
+ {
+ ProjectFileName = "C:\\test.fsproj"
+ ProjectId = None
+ SourceFiles = [| filePath |]
+ ReferencedProjects = [| |]
+ OtherOptions = args
+ IsIncompleteTypeCheckEnvironment = true
+ UseScriptResolutionRules = false
+ LoadTime = DateTime.MaxValue
+ OriginalLoadReferences = []
+ UnresolvedReferences = None
+ ExtraProjectInfo = None
+ Stamp = None
+ }
+
+ let GoToDefinitionTest (fileContents: string, caretMarker: string, expected) =
+
+ let filePath = Path.GetTempFileName() + ".fs"
+ let options = makeOptions filePath [| |]
+ File.WriteAllText(filePath, fileContents)
+
+ let caretPosition = fileContents.IndexOf(caretMarker) + caretMarker.Length - 1 // inside the marker
+ let documentId = DocumentId.CreateNewId(ProjectId.CreateNewId())
+ let actual =
+ findDefinition(checker, documentId, SourceText.From(fileContents), filePath, caretPosition, [], options, 0)
+ |> Option.map (fun range -> (range.StartLine, range.EndLine, range.StartColumn, range.EndColumn))
+
+ if actual <> expected then
+ Assert.Fail(sprintf "Incorrect information returned for fileContents=<<<%s>>>, caretMarker=<<<%s>>>, expected =<<<%A>>>, actual = <<<%A>>>" fileContents caretMarker expected actual)
+
[]
let VerifyDefinition() =
@@ -100,33 +131,20 @@ let _ = Module1.foo 1
for caretMarker, expected in testCases do
printfn "Test case: caretMarker=<<<%s>>>" caretMarker
- let filePath = Path.GetTempFileName() + ".fs"
- let options: FSharpProjectOptions = {
- ProjectFileName = "C:\\test.fsproj"
- ProjectId = None
- SourceFiles = [| filePath |]
- ReferencedProjects = [| |]
- OtherOptions = [| |]
- IsIncompleteTypeCheckEnvironment = true
- UseScriptResolutionRules = false
- LoadTime = DateTime.MaxValue
- OriginalLoadReferences = []
- UnresolvedReferences = None
- ExtraProjectInfo = None
- Stamp = None
- }
+ GoToDefinitionTest (fileContents, caretMarker, expected)
- File.WriteAllText(filePath, fileContents)
+ []
+ let VerifyDefinitionStringInterpolation() =
- let caretPosition = fileContents.IndexOf(caretMarker) + caretMarker.Length - 1 // inside the marker
- let documentId = DocumentId.CreateNewId(ProjectId.CreateNewId())
- let actual =
- findDefinition(checker, documentId, SourceText.From(fileContents), filePath, caretPosition, [], options, 0)
- |> Option.map (fun range -> (range.StartLine, range.EndLine, range.StartColumn, range.EndColumn))
+ let fileContents = """
+let xxxxx = 1
+let yyyy = $"{abc{xxxxx}def}" """
+ let caretMarker = "xxxxx"
+ let expected = Some(2, 2, 4, 9)
- if actual <> expected then
- Assert.Fail(sprintf "Incorrect information returned for fileContents=<<<%s>>>, caretMarker=<<<%s>>>, expected =<<<%A>>>, actual = <<<%A>>>" fileContents caretMarker expected actual)
+ GoToDefinitionTest (fileContents, caretMarker, expected)
#if EXE
VerifyDefinition()
+ VerifyDefinitionStringInterpolation()
#endif
\ No newline at end of file
diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.General.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.General.fs
index 6bc62eda151..7bf26561c21 100644
--- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.General.fs
+++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.General.fs
@@ -330,8 +330,8 @@ type UsingMSBuild() =
Parser.RPAREN, (FSharpTokenColorKind.Punctuation,FSharpTokenCharKind.Delimiter, FSharpTokenTriggerClass.ParamEnd ||| FSharpTokenTriggerClass.MatchBraces) ]
let matching =
[ // Other cases where we expect MatchBraces
- Parser.LQUOTE("", false); Parser.LBRACK; Parser.LBRACE; Parser.LBRACK_BAR;
- Parser.RQUOTE("", false); Parser.RBRACK; Parser.RBRACE; Parser.BAR_RBRACK ]
+ Parser.LQUOTE("", false); Parser.LBRACK; Parser.LBRACE (Unchecked.defaultof<_>); Parser.LBRACK_BAR;
+ Parser.RQUOTE("", false); Parser.RBRACK; Parser.RBRACE (Unchecked.defaultof<_>); Parser.BAR_RBRACK ]
|> List.map (fun n -> n, (FSharpTokenColorKind.Punctuation,FSharpTokenCharKind.Delimiter, FSharpTokenTriggerClass.MatchBraces))
for tok, expected in List.concat [ important; matching ] do
let info = TestExpose.TokenInfo tok
diff --git a/vsintegration/tests/UnitTests/ProjectDiagnosticAnalyzerTests.fs b/vsintegration/tests/UnitTests/ProjectDiagnosticAnalyzerTests.fs
deleted file mode 100644
index 2d45bef6cd2..00000000000
--- a/vsintegration/tests/UnitTests/ProjectDiagnosticAnalyzerTests.fs
+++ /dev/null
@@ -1,34 +0,0 @@
-// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.
-namespace Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn
-
-open System
-open System.IO
-open System.Threading
-
-open FSharp.Compiler.Service.Tests.Common
-
-open NUnit.Framework
-
-open Microsoft.CodeAnalysis
-open Microsoft.CodeAnalysis.Classification
-open Microsoft.CodeAnalysis.Editor
-open Microsoft.CodeAnalysis.Text
-
-open Microsoft.VisualStudio.FSharp.Editor
-open Microsoft.VisualStudio.FSharp.LanguageService
-
-open FSharp.Compiler.SourceCodeServices
-open FSharp.Compiler.Range
-
-[][]
-type ProjectDiagnosticAnalyzerTests() =
-
- let CreateProjectAndGetOptions(fileContents: string) =
- let tempName = Path.GetTempFileName()
- let fileName = Path.ChangeExtension(tempName, ".fs")
- let projectName = Path.ChangeExtension(tempName, ".fsproj")
- let dllName = Path.ChangeExtension(tempName, ".dll")
- File.WriteAllText(fileName, fileContents)
-
- let args = mkProjectCommandLineArgs (dllName, [fileName])
- checker.GetProjectOptionsFromCommandLineArgs (projectName, args)
diff --git a/vsintegration/tests/UnitTests/UnusedOpensTests.fs b/vsintegration/tests/UnitTests/UnusedOpensTests.fs
index 097e583fe6a..28738bfe1cb 100644
--- a/vsintegration/tests/UnitTests/UnusedOpensTests.fs
+++ b/vsintegration/tests/UnitTests/UnusedOpensTests.fs
@@ -6,7 +6,10 @@ open System
open NUnit.Framework
open FSharp.Compiler.SourceCodeServices
open FSharp.Compiler.Range
-open FsUnit
+
+
+/// like "should equal", but validates same-type
+let shouldEqual (x: 'a) (y: 'a) = Assert.AreEqual(x, y, sprintf "Expected: %A\nActual: %A" x y)
let private filePath = "C:\\test.fs"
diff --git a/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj b/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj
index 4ce16d5e270..8956299d6ec 100644
--- a/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj
+++ b/vsintegration/tests/UnitTests/VisualFSharp.UnitTests.fsproj
@@ -57,56 +57,9 @@
-
- CompilerService\FsUnit.fs
-
-
- CompilerService\Common.fs
-
-
- CompilerService\Symbols.fs
-
-
- CompilerService\EditorTests.fs
-
-
- CompilerService\FileSystemTests.fs
-
-
- CompilerService\ProjectAnalysisTests.fs
-
-
-
- CompilerService\PerfTests.fs
-
-
- CompilerService\InteractiveCheckerTests.fs
-
-
- CompilerService\ExprTests.fs
-
-
- CompilerService\CSharpProjectAnalysis.fs
-
-
- CompilerService\StructureTests.fs
-
-
- CompilerService\AssemblyContentProviderTests.fs
-
-
- CompilerService\ServiceUntypedParseTests.fs
-
CompilerService\UnusedOpensTests.fs
-
- CompilerService\TreeVisitorTests.fs
-
Roslyn\ProjectOptionsBuilder.fs
@@ -139,9 +92,6 @@
Roslyn\DocumentDiagnosticAnalyzerTests.fs
-
- Roslyn\ProjectDiagnosticAnalyzerTests.fs
-
Roslyn\CompletionProviderTests.fs
@@ -182,7 +132,6 @@
-