From 369bbfb8396b83c9d94dd1f52d2e99543fa74697 Mon Sep 17 00:00:00 2001 From: dawe Date: Wed, 28 Feb 2024 16:13:06 +0100 Subject: [PATCH 1/5] use the same mechanism we used to fix the range start of INTERP_STRING_END to also fix the range start of INTERP_STRING_PART --- src/Compiler/Service/ServiceLexing.fs | 4 ++-- src/Compiler/SyntaxTree/LexHelpers.fs | 2 +- src/Compiler/lex.fsl | 6 +++--- src/Compiler/pars.fsy | 20 ++++++++++++++++--- ...tringWithTripleQuoteMultipleDollars.fs.bsl | 2 +- 5 files changed, 24 insertions(+), 10 deletions(-) diff --git a/src/Compiler/Service/ServiceLexing.fs b/src/Compiler/Service/ServiceLexing.fs index bc967f30dbe..424f3297a11 100644 --- a/src/Compiler/Service/ServiceLexing.fs +++ b/src/Compiler/Service/ServiceLexing.fs @@ -35,7 +35,7 @@ module FSharpTokenTag = let INTERP_STRING_BEGIN_PART = tagOfToken (INTERP_STRING_BEGIN_PART("a", SynStringKind.Regular, LexCont.Default)) - let INTERP_STRING_PART = tagOfToken (INTERP_STRING_PART("a", LexCont.Default)) + let INTERP_STRING_PART = tagOfToken (INTERP_STRING_PART("a", None, LexCont.Default)) let INTERP_STRING_END = tagOfToken (INTERP_STRING_END("a", None, LexCont.Default)) let LPAREN = tagOfToken LPAREN let RPAREN = tagOfToken RPAREN @@ -491,7 +491,7 @@ module internal LexerStateEncoding = | STRING_TEXT cont | EOF cont | INTERP_STRING_BEGIN_PART(_, _, cont) - | INTERP_STRING_PART(_, cont) + | INTERP_STRING_PART(_, _, cont) | INTERP_STRING_BEGIN_END(_, _, cont) | INTERP_STRING_END(_, _, cont) | LBRACE cont diff --git a/src/Compiler/SyntaxTree/LexHelpers.fs b/src/Compiler/SyntaxTree/LexHelpers.fs index 5ee9a16c90b..00bdd86cf1a 100644 --- a/src/Compiler/SyntaxTree/LexHelpers.fs +++ b/src/Compiler/SyntaxTree/LexHelpers.fs @@ -188,7 +188,7 @@ type LexerStringFinisher = else INTERP_STRING_BEGIN_END(s, synStringKind, cont) else if isPart then - INTERP_STRING_PART(s, cont) + INTERP_STRING_PART(s, None, cont) else INTERP_STRING_END(s, None, cont) elif kind.IsByteString then diff --git a/src/Compiler/lex.fsl b/src/Compiler/lex.fsl index 958c2fa51ea..a5499b2efbc 100644 --- a/src/Compiler/lex.fsl +++ b/src/Compiler/lex.fsl @@ -120,7 +120,7 @@ let checkExprGreaterColonOp (lexbuf:UnicodeLexing.Lexbuf) = let unexpectedChar lexbuf = LEX_FAILURE (FSComp.SR.lexUnexpectedChar(lexeme lexbuf)) -let startString args (lexbuf: UnicodeLexing.Lexbuf) altStartForStringEnd = +let startString args (lexbuf: UnicodeLexing.Lexbuf) altStartForStringPartOrEnd = let buf = ByteBuffer.Create StringCapacity let m = lexbuf.LexemeRange let startp = lexbuf.StartPos @@ -158,9 +158,9 @@ let startString args (lexbuf: UnicodeLexing.Lexbuf) altStartForStringEnd = INTERP_STRING_BEGIN_END (s, synStringKind, cont) else if isPart then - INTERP_STRING_PART (s, cont) + INTERP_STRING_PART (s, altStartForStringPartOrEnd, cont) else - INTERP_STRING_END (s, altStartForStringEnd, cont) + INTERP_STRING_END (s, altStartForStringPartOrEnd, cont) else let s = Lexhelp.stringBufferAsString buf let synStringKind = diff --git a/src/Compiler/pars.fsy b/src/Compiler/pars.fsy index 36e8d0838c8..95e11c83ff4 100644 --- a/src/Compiler/pars.fsy +++ b/src/Compiler/pars.fsy @@ -37,7 +37,7 @@ let parse_error_rich = Some(fun (ctxt: ParseErrorContext<_>) -> %token STRING %token INTERP_STRING_BEGIN_END %token INTERP_STRING_BEGIN_PART -%token INTERP_STRING_PART +%token INTERP_STRING_PART %token INTERP_STRING_END %token LBRACE RBRACE @@ -6784,13 +6784,27 @@ interpolatedStringParts: [ SynInterpolatedStringPart.String(s, m) ] } | INTERP_STRING_PART interpolatedStringFill interpolatedStringParts - { SynInterpolatedStringPart.String(fst $1, rhs parseState 1) :: SynInterpolatedStringPart.FillExpr $2 :: $3 } + { // let origM = rhs parseState 1 + // let dummy = mkRange origM.FileName (mkPos origM.StartLine (origM.StartColumn - 2)) (mkPos origM.EndLine origM.EndColumn) + let (s, altStart, _) = $1 + let mOrig = rhs parseState 1 + let m = + match altStart with + | Some r -> unionRanges r mOrig + | None -> mOrig + SynInterpolatedStringPart.String(s, m) :: SynInterpolatedStringPart.FillExpr $2 :: $3 } | INTERP_STRING_PART interpolatedStringParts { let rbrace = parseState.InputEndPosition 1 let lbrace = parseState.InputStartPosition 2 reportParseErrorAt (mkSynRange rbrace lbrace) (FSComp.SR.parsEmptyFillInInterpolatedString()) - SynInterpolatedStringPart.String(fst $1, rhs parseState 1) :: $2 } + let (s, altStart, _) = $1 + let mOrig = rhs parseState 1 + let m = + match altStart with + | Some r -> unionRanges r mOrig + | None -> mOrig + SynInterpolatedStringPart.String(s, m) :: $2 } /* INTERP_STRING_BEGIN_END */ /* INTERP_STRING_BEGIN_PART int32 INTERP_STRING_END */ diff --git a/tests/service/data/SyntaxTree/String/SynExprInterpolatedStringWithTripleQuoteMultipleDollars.fs.bsl b/tests/service/data/SyntaxTree/String/SynExprInterpolatedStringWithTripleQuoteMultipleDollars.fs.bsl index e59b33d951a..db6d4bcdc96 100644 --- a/tests/service/data/SyntaxTree/String/SynExprInterpolatedStringWithTripleQuoteMultipleDollars.fs.bsl +++ b/tests/service/data/SyntaxTree/String/SynExprInterpolatedStringWithTripleQuoteMultipleDollars.fs.bsl @@ -18,7 +18,7 @@ ImplFile InterpolatedString ([String ("1 + ", (2,8--2,21)); FillExpr (Const (Int32 41, (2,21--2,23)), None); - String (" = ", (2,25--2,32)); + String (" = ", (2,23--2,32)); FillExpr (Const (Int32 6, (2,32--2,33)), None); String (" * 7", (2,33--2,43))], TripleQuote, (2,8--2,43)), (2,4--2,5), Yes (2,0--2,43), { LeadingKeyword = Let (2,0--2,3) From 4d01cda71a7dbd46f2cb06c91c6d0c32857fe63c Mon Sep 17 00:00:00 2001 From: dawe Date: Thu, 29 Feb 2024 11:57:10 +0100 Subject: [PATCH 2/5] - use a new rule for '"}" +' to catch the correct range start - clean up work around structures introduced before and not needed anymore with this --- .../.FSharp.Compiler.Service/8.0.300.md | 2 +- src/Compiler/Service/FSharpCheckerResults.fs | 2 +- src/Compiler/Service/ServiceLexing.fs | 16 ++-- src/Compiler/SyntaxTree/LexHelpers.fs | 4 +- src/Compiler/SyntaxTree/ParseHelpers.fs | 4 +- src/Compiler/SyntaxTree/ParseHelpers.fsi | 2 +- src/Compiler/lex.fsl | 89 +++++++++++-------- src/Compiler/pars.fsy | 31 ++----- 8 files changed, 72 insertions(+), 78 deletions(-) diff --git a/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md b/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md index 5507157222e..ac42e37ca8d 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md +++ b/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md @@ -1,6 +1,6 @@ ### Fixed -* Fix wrong range start of INTERP_STRING_END. ([PR #16774](https://github.com/dotnet/fsharp/pull/16774)) +* Fix wrong range start of INTERP_STRING_END. ([PR #16774](https://github.com/dotnet/fsharp/pull/16774), [PR #16785](https://github.com/dotnet/fsharp/pull/16785)) * Fix missing warning for recursive calls in list comprehensions. ([PR #16652](https://github.com/dotnet/fsharp/pull/16652)) * Code generated files with > 64K methods and generated symbols crash when loaded. Use infered sequence points for debugging. ([Issue #16399](https://github.com/dotnet/fsharp/issues/16399), [#PR 16514](https://github.com/dotnet/fsharp/pull/16514)) * `nameof Module` expressions and patterns are processed to link files in `--test:GraphBasedChecking`. ([PR #16550](https://github.com/dotnet/fsharp/pull/16550), [PR #16743](https://github.com/dotnet/fsharp/pull/16743)) diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index dda21fffd39..045e0aae7a0 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -2685,7 +2685,7 @@ module internal ParseAndCheckFile = | INTERP_STRING_BEGIN_PART _ | INTERP_STRING_PART _ as tok, _ -> let braceOffset = match tok with - | INTERP_STRING_BEGIN_PART(_, SynStringKind.TripleQuote, (LexerContinuation.Token(_, (_, _, dl, _, _) :: _))) -> + | INTERP_STRING_BEGIN_PART(_, SynStringKind.TripleQuote, (LexerContinuation.Token(_, (_, _, dl, _) :: _))) -> dl - 1 | _ -> 0 diff --git a/src/Compiler/Service/ServiceLexing.fs b/src/Compiler/Service/ServiceLexing.fs index 424f3297a11..66893ac950e 100644 --- a/src/Compiler/Service/ServiceLexing.fs +++ b/src/Compiler/Service/ServiceLexing.fs @@ -35,8 +35,8 @@ module FSharpTokenTag = let INTERP_STRING_BEGIN_PART = tagOfToken (INTERP_STRING_BEGIN_PART("a", SynStringKind.Regular, LexCont.Default)) - let INTERP_STRING_PART = tagOfToken (INTERP_STRING_PART("a", None, LexCont.Default)) - let INTERP_STRING_END = tagOfToken (INTERP_STRING_END("a", None, 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 @@ -491,9 +491,9 @@ module internal LexerStateEncoding = | STRING_TEXT cont | EOF cont | INTERP_STRING_BEGIN_PART(_, _, cont) - | INTERP_STRING_PART(_, _, cont) + | INTERP_STRING_PART(_, cont) | INTERP_STRING_BEGIN_END(_, _, cont) - | INTERP_STRING_END(_, _, cont) + | INTERP_STRING_END(_, cont) | LBRACE cont | RBRACE cont | BYTEARRAY(_, _, cont) @@ -621,12 +621,12 @@ module internal LexerStateEncoding = let tag1, i1, kind1, rest = match stringNest with | [] -> false, 0, 0, [] - | (i1, kind1, _, _, _) :: rest -> true, i1, encodeStringStyle kind1, rest + | (i1, kind1, _, _) :: rest -> true, i1, encodeStringStyle kind1, rest let tag2, i2, kind2 = match rest with | [] -> false, 0, 0 - | (i2, kind2, _, _, _) :: _ -> true, i2, encodeStringStyle kind2 + | (i2, kind2, _, _) :: _ -> true, i2, encodeStringStyle kind2 (if tag1 then 0b100000000000 else 0) ||| (if tag2 then 0b010000000000 else 0) @@ -696,9 +696,9 @@ module internal LexerStateEncoding = let nest = [ if tag1 then - i1, decodeStringStyle kind1, 0, None, range0 + i1, decodeStringStyle kind1, 0, range0 if tag2 then - i2, decodeStringStyle kind2, 0, None, range0 + i2, decodeStringStyle kind2, 0, range0 ] nest diff --git a/src/Compiler/SyntaxTree/LexHelpers.fs b/src/Compiler/SyntaxTree/LexHelpers.fs index 00bdd86cf1a..02d4da364d4 100644 --- a/src/Compiler/SyntaxTree/LexHelpers.fs +++ b/src/Compiler/SyntaxTree/LexHelpers.fs @@ -188,9 +188,9 @@ type LexerStringFinisher = else INTERP_STRING_BEGIN_END(s, synStringKind, cont) else if isPart then - INTERP_STRING_PART(s, None, cont) + INTERP_STRING_PART(s, cont) else - INTERP_STRING_END(s, None, cont) + INTERP_STRING_END(s, cont) elif kind.IsByteString then let synByteStringKind = if isVerbatim then diff --git a/src/Compiler/SyntaxTree/ParseHelpers.fs b/src/Compiler/SyntaxTree/ParseHelpers.fs index d90e395c0c9..cd4b41787e1 100644 --- a/src/Compiler/SyntaxTree/ParseHelpers.fs +++ b/src/Compiler/SyntaxTree/ParseHelpers.fs @@ -308,7 +308,7 @@ type LexerStringKind = /// 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 * int * range option * range) list +type LexerInterpolatedStringNesting = (int * LexerStringStyle * int * range) list /// The parser defines a number of tokens for whitespace and /// comments eliminated by the lexer. These carry a specification of @@ -973,7 +973,7 @@ let checkEndOfFileError t = match nesting with | [] -> () - | (_, _, _, _, m) :: _ -> reportParseErrorAt m (FSComp.SR.parsEofInInterpolatedStringFill ()) + | (_, _, _, m) :: _ -> reportParseErrorAt m (FSComp.SR.parsEofInInterpolatedStringFill ()) type BindingSet = BindingSetPreAttrs of range * bool * bool * (SynAttributes -> SynAccess option -> SynAttributes * SynBinding list) * range diff --git a/src/Compiler/SyntaxTree/ParseHelpers.fsi b/src/Compiler/SyntaxTree/ParseHelpers.fsi index a8d61f3cb7e..9add16af683 100644 --- a/src/Compiler/SyntaxTree/ParseHelpers.fsi +++ b/src/Compiler/SyntaxTree/ParseHelpers.fsi @@ -118,7 +118,7 @@ type LexerStringKind = static member String: LexerStringKind -type LexerInterpolatedStringNesting = (int * LexerStringStyle * int * range option * range) list +type LexerInterpolatedStringNesting = (int * LexerStringStyle * int * range) list [] type LexerContinuation = diff --git a/src/Compiler/lex.fsl b/src/Compiler/lex.fsl index a5499b2efbc..cce978d4a13 100644 --- a/src/Compiler/lex.fsl +++ b/src/Compiler/lex.fsl @@ -120,7 +120,7 @@ let checkExprGreaterColonOp (lexbuf:UnicodeLexing.Lexbuf) = let unexpectedChar lexbuf = LEX_FAILURE (FSComp.SR.lexUnexpectedChar(lexeme lexbuf)) -let startString args (lexbuf: UnicodeLexing.Lexbuf) altStartForStringPartOrEnd = +let startString args (lexbuf: UnicodeLexing.Lexbuf) = let buf = ByteBuffer.Create StringCapacity let m = lexbuf.LexemeRange let startp = lexbuf.StartPos @@ -158,9 +158,9 @@ let startString args (lexbuf: UnicodeLexing.Lexbuf) altStartForStringPartOrEnd = INTERP_STRING_BEGIN_END (s, synStringKind, cont) else if isPart then - INTERP_STRING_PART (s, altStartForStringPartOrEnd, cont) + INTERP_STRING_PART (s, cont) else - INTERP_STRING_END (s, altStartForStringPartOrEnd, cont) + INTERP_STRING_END (s, cont) else let s = Lexhelp.stringBufferAsString buf let synStringKind = @@ -587,12 +587,12 @@ rule token (args: LexArgs) (skip: bool) = parse else mlOnly m args skip lexbuf } | '"' - { let buf, fin, m = startString args lexbuf None + { let buf, fin, m = startString args lexbuf // Single quote in triple quote ok, others disallowed match args.stringNest with - | (_, LexerStringStyle.ExtendedInterpolated, _, _, _) :: _ - | (_, LexerStringStyle.TripleQuote, _, _, _) :: _ -> () + | (_, LexerStringStyle.ExtendedInterpolated, _, _) :: _ + | (_, LexerStringStyle.TripleQuote, _, _) :: _ -> () | _ :: _ -> errorR(Error(FSComp.SR.lexSingleQuoteInSingleQuote(), m)) | [] -> () @@ -600,7 +600,7 @@ rule token (args: LexArgs) (skip: bool) = parse else singleQuoteString (buf, fin, m, LexerStringKind.String, args) skip lexbuf } | '$' '"' '"' '"' - { let buf, fin, m = startString args lexbuf None + { let buf, fin, m = startString args lexbuf // Single quote in triple quote ok, others disallowed match args.stringNest with @@ -612,7 +612,7 @@ rule token (args: LexArgs) (skip: bool) = parse else tripleQuoteString (buf, fin, m, LexerStringKind.InterpolatedStringFirst, args) skip lexbuf } | ('$'+) '"' '"' '"' - { let buf, fin, m = startString args lexbuf None + { let buf, fin, m = startString args lexbuf if lexbuf.SupportsFeature LanguageFeature.ExtendedStringInterpolation then // Single quote in triple quote ok, others disallowed @@ -635,11 +635,11 @@ rule token (args: LexArgs) (skip: bool) = parse } | '$' '"' - { let buf,fin,m = startString args lexbuf None + { let buf,fin,m = startString args lexbuf // Single quote in triple quote ok, others disallowed match args.stringNest with - | (_, style, _, _, _) :: _ when style = LexerStringStyle.ExtendedInterpolated || style = LexerStringStyle.TripleQuote -> () + | (_, style, _, _) :: _ when style = LexerStringStyle.ExtendedInterpolated || style = LexerStringStyle.TripleQuote -> () | _ :: _ -> errorR(Error(FSComp.SR.lexSingleQuoteInSingleQuote(), m)) | _ -> () @@ -649,7 +649,7 @@ rule token (args: LexArgs) (skip: bool) = parse singleQuoteString (buf, fin, m, LexerStringKind.InterpolatedStringFirst, args) skip lexbuf } | '"' '"' '"' - { let buf, fin, m = startString args lexbuf None + { let buf, fin, m = startString args lexbuf args.interpolationDelimiterLength <- 0 @@ -664,12 +664,12 @@ rule token (args: LexArgs) (skip: bool) = parse tripleQuoteString (buf, fin, m, LexerStringKind.String, args) skip lexbuf } | '@' '"' - { let buf, fin, m = startString args lexbuf None + { let buf, fin, m = startString args lexbuf // Single quote in triple quote ok, others disallowed match args.stringNest with - | (_, LexerStringStyle.ExtendedInterpolated, _, _, _) :: _ - | (_, LexerStringStyle.TripleQuote, _, _, _) :: _ -> () + | (_, LexerStringStyle.ExtendedInterpolated, _, _) :: _ + | (_, LexerStringStyle.TripleQuote, _, _) :: _ -> () | _ :: _ -> errorR(Error(FSComp.SR.lexSingleQuoteInSingleQuote(), m)) | _ -> () @@ -679,11 +679,11 @@ rule token (args: LexArgs) (skip: bool) = parse verbatimString (buf, fin, m, LexerStringKind.String, args) skip lexbuf } | ("$@" | "@$") '"' - { let buf, fin, m = startString args lexbuf None + { let buf, fin, m = startString args lexbuf // Single quote in triple quote ok, others disallowed match args.stringNest with - | (_, style, _, _, _) :: _ when style = LexerStringStyle.ExtendedInterpolated || style = LexerStringStyle.TripleQuote -> () + | (_, style, _, _) :: _ when style = LexerStringStyle.ExtendedInterpolated || style = LexerStringStyle.TripleQuote -> () | _ :: _ -> errorR(Error(FSComp.SR.lexSingleQuoteInSingleQuote(), m)) | _ -> () @@ -888,10 +888,10 @@ rule token (args: LexArgs) (skip: bool) = parse { match args.stringNest with | [] -> () - | (counter, style, d, _, m) :: rest -> + | (counter, style, d, m) :: rest -> // Note, we do not update the 'm', any incomplete-interpolation error // will be reported w.r.t. the first '{' - args.stringNest <- (counter + 1, style, d, None, m) :: rest + args.stringNest <- (counter + 1, style, d, m) :: rest // To continue token-by-token lexing may involve picking up the new args.stringNes let cont = LexCont.Token(args.ifdefStack, args.stringNest) LBRACE cont @@ -899,22 +899,37 @@ rule token (args: LexArgs) (skip: bool) = parse | "|" { BAR } + | "}" + + { + match args.stringNest with + | (1, style, _, _r) :: rest -> + args.stringNest <- rest + let buf, fin, m = startString args lexbuf + if not skip then + STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, style, LexerStringKind.InterpolatedStringPart, args.interpolationDelimiterLength, m)) + else + match style with + | LexerStringStyle.Verbatim -> verbatimString (buf, fin, m, LexerStringKind.InterpolatedStringPart, args) skip lexbuf + | LexerStringStyle.SingleQuote -> singleQuoteString (buf, fin, m, LexerStringKind.InterpolatedStringPart, args) skip lexbuf + | LexerStringStyle.TripleQuote -> tripleQuoteString (buf, fin, m, LexerStringKind.InterpolatedStringPart, args) skip lexbuf + | LexerStringStyle.ExtendedInterpolated -> extendedInterpolatedString (buf, fin, m, LexerStringKind.InterpolatedStringPart, args) skip lexbuf + | (counter, style, d, m) :: rest -> + // Note, we do not update the 'm', any incomplete-interpolation error + // will be reported w.r.t. the first '{' + args.stringNest <- (counter - 1, style, d, m) :: rest + let cont = LexCont.Token(args.ifdefStack, args.stringNest) + RBRACE cont + | _ -> + let cont = LexCont.Token(args.ifdefStack, args.stringNest) + RBRACE cont + } + | "}" { - // We encounter a '}' in the expression token stream. First check if we're in an interpolated string expression - // and continue the string if necessary match args.stringNest with - | (1, LexerStringStyle.ExtendedInterpolated, delimLength, altR, r) :: rest when delimLength > 1 -> - // On the first "}" of multiple "}", keep the range of the starting "}" for later processing in startString - let altStart = - match altR with - | None -> Some lexbuf.LexemeRange - | _ -> altR - args.stringNest <- (1, LexerStringStyle.ExtendedInterpolated, delimLength - 1, altStart, r) :: rest - token args skip lexbuf - | (1, style, _, altR, _r) :: rest -> + | (1, style, _, _r) :: rest -> args.stringNest <- rest - let buf, fin, m = startString args lexbuf altR + let buf, fin, m = startString args lexbuf if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, style, LexerStringKind.InterpolatedStringPart, args.interpolationDelimiterLength, m)) else @@ -923,10 +938,10 @@ rule token (args: LexArgs) (skip: bool) = parse | LexerStringStyle.SingleQuote -> singleQuoteString (buf, fin, m, LexerStringKind.InterpolatedStringPart, args) skip lexbuf | LexerStringStyle.TripleQuote -> tripleQuoteString (buf, fin, m, LexerStringKind.InterpolatedStringPart, args) skip lexbuf | LexerStringStyle.ExtendedInterpolated -> extendedInterpolatedString (buf, fin, m, LexerStringKind.InterpolatedStringPart, args) skip lexbuf - | (counter, style, d, altR, m) :: rest -> + | (counter, style, d, m) :: rest -> // Note, we do not update the 'm', any incomplete-interpolation error // will be reported w.r.t. the first '{' - args.stringNest <- (counter - 1, style, d, altR, m) :: rest + args.stringNest <- (counter - 1, style, d, m) :: rest let cont = LexCont.Token(args.ifdefStack, args.stringNest) RBRACE cont @@ -1264,7 +1279,7 @@ and singleQuoteString (sargs: LexerStringArgs) (skip: bool) = parse if kind.IsInterpolated then // get a new range for where the fill starts let m2 = lexbuf.LexemeRange - args.stringNest <- (1, LexerStringStyle.SingleQuote, args.interpolationDelimiterLength, None, m2) :: args.stringNest + args.stringNest <- (1, LexerStringStyle.SingleQuote, args.interpolationDelimiterLength, m2) :: args.stringNest let cont = LexCont.Token(args.ifdefStack, args.stringNest) fin.Finish buf kind LexerStringFinisherContext.InterpolatedPart cont else @@ -1380,7 +1395,7 @@ and verbatimString (sargs: LexerStringArgs) (skip: bool) = parse if kind.IsInterpolated then // get a new range for where the fill starts let m2 = lexbuf.LexemeRange - args.stringNest <- (1, LexerStringStyle.Verbatim, args.interpolationDelimiterLength, None, m2) :: args.stringNest + args.stringNest <- (1, LexerStringStyle.Verbatim, args.interpolationDelimiterLength, m2) :: args.stringNest let cont = LexCont.Token(args.ifdefStack, args.stringNest) fin.Finish buf kind (LexerStringFinisherContext.InterpolatedPart ||| LexerStringFinisherContext.Verbatim) cont else @@ -1499,7 +1514,7 @@ and tripleQuoteString (sargs: LexerStringArgs) (skip: bool) = parse if kind.IsInterpolated then // get a new range for where the fill starts let m2 = lexbuf.LexemeRange - args.stringNest <- (1, LexerStringStyle.TripleQuote, args.interpolationDelimiterLength, None, m2) :: args.stringNest + args.stringNest <- (1, LexerStringStyle.TripleQuote, args.interpolationDelimiterLength, m2) :: args.stringNest let cont = LexCont.Token(args.ifdefStack, args.stringNest) fin.Finish buf kind (LexerStringFinisherContext.InterpolatedPart ||| LexerStringFinisherContext.TripleQuote) cont else @@ -1604,7 +1619,7 @@ and extendedInterpolatedString (sargs: LexerStringArgs) (skip: bool) = parse let maxBraces = 2 * args.interpolationDelimiterLength - 1 if numBraces > maxBraces then let m2 = lexbuf.LexemeRange - args.stringNest <- (1, LexerStringStyle.ExtendedInterpolated, args.interpolationDelimiterLength, None, m2) :: args.stringNest + args.stringNest <- (1, LexerStringStyle.ExtendedInterpolated, args.interpolationDelimiterLength, m2) :: args.stringNest let cont = LexCont.Token(args.ifdefStack, args.stringNest) fail args lexbuf (FSComp.SR.lexTooManyLBracesInTripleQuote()) @@ -1625,7 +1640,7 @@ and extendedInterpolatedString (sargs: LexerStringArgs) (skip: bool) = parse String.replicate extraBraces "{" |> addUnicodeString buf // get a new range for where the fill starts let m2 = lexbuf.LexemeRange - args.stringNest <- (1, LexerStringStyle.ExtendedInterpolated, args.interpolationDelimiterLength, None, m2) :: args.stringNest + args.stringNest <- (1, LexerStringStyle.ExtendedInterpolated, args.interpolationDelimiterLength, m2) :: args.stringNest let cont = LexCont.Token(args.ifdefStack, args.stringNest) fin.Finish buf kind (LexerStringFinisherContext.InterpolatedPart ||| LexerStringFinisherContext.TripleQuote) cont } diff --git a/src/Compiler/pars.fsy b/src/Compiler/pars.fsy index 95e11c83ff4..4080fc7ec8b 100644 --- a/src/Compiler/pars.fsy +++ b/src/Compiler/pars.fsy @@ -37,8 +37,8 @@ let parse_error_rich = Some(fun (ctxt: ParseErrorContext<_>) -> %token STRING %token INTERP_STRING_BEGIN_END %token INTERP_STRING_BEGIN_PART -%token INTERP_STRING_PART -%token INTERP_STRING_END +%token INTERP_STRING_PART +%token INTERP_STRING_END %token LBRACE RBRACE %token KEYWORD_STRING // Like __SOURCE_DIRECTORY__ @@ -6774,37 +6774,16 @@ interpolatedStringFill: interpolatedStringParts: | INTERP_STRING_END - { - let (s, altStart, _) = $1 - let mOrig = rhs parseState 1 - let m = - match altStart with - | Some r -> unionRanges r mOrig - | None -> mOrig - [ SynInterpolatedStringPart.String(s, m) ] } + { [ SynInterpolatedStringPart.String(fst $1, rhs parseState 1) ] } | INTERP_STRING_PART interpolatedStringFill interpolatedStringParts - { // let origM = rhs parseState 1 - // let dummy = mkRange origM.FileName (mkPos origM.StartLine (origM.StartColumn - 2)) (mkPos origM.EndLine origM.EndColumn) - let (s, altStart, _) = $1 - let mOrig = rhs parseState 1 - let m = - match altStart with - | Some r -> unionRanges r mOrig - | None -> mOrig - SynInterpolatedStringPart.String(s, m) :: SynInterpolatedStringPart.FillExpr $2 :: $3 } + { SynInterpolatedStringPart.String(fst $1, rhs parseState 1) :: SynInterpolatedStringPart.FillExpr $2 :: $3 } | INTERP_STRING_PART interpolatedStringParts { let rbrace = parseState.InputEndPosition 1 let lbrace = parseState.InputStartPosition 2 reportParseErrorAt (mkSynRange rbrace lbrace) (FSComp.SR.parsEmptyFillInInterpolatedString()) - let (s, altStart, _) = $1 - let mOrig = rhs parseState 1 - let m = - match altStart with - | Some r -> unionRanges r mOrig - | None -> mOrig - SynInterpolatedStringPart.String(s, m) :: $2 } + SynInterpolatedStringPart.String(fst $1, rhs parseState 1) :: $2 } /* INTERP_STRING_BEGIN_END */ /* INTERP_STRING_BEGIN_PART int32 INTERP_STRING_END */ From be31d00e8e4b0f306dacc8b8e0b50fff5601f16a Mon Sep 17 00:00:00 2001 From: dawe Date: Thu, 29 Feb 2024 13:13:05 +0100 Subject: [PATCH 3/5] Revert "- use a new rule for '"}" +' to catch the correct range start" This reverts commit 4d01cda71a7dbd46f2cb06c91c6d0c32857fe63c. --- .../.FSharp.Compiler.Service/8.0.300.md | 2 +- src/Compiler/Service/FSharpCheckerResults.fs | 2 +- src/Compiler/Service/ServiceLexing.fs | 16 ++-- src/Compiler/SyntaxTree/LexHelpers.fs | 4 +- src/Compiler/SyntaxTree/ParseHelpers.fs | 4 +- src/Compiler/SyntaxTree/ParseHelpers.fsi | 2 +- src/Compiler/lex.fsl | 89 ++++++++----------- src/Compiler/pars.fsy | 31 +++++-- 8 files changed, 78 insertions(+), 72 deletions(-) diff --git a/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md b/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md index ac42e37ca8d..5507157222e 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md +++ b/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md @@ -1,6 +1,6 @@ ### Fixed -* Fix wrong range start of INTERP_STRING_END. ([PR #16774](https://github.com/dotnet/fsharp/pull/16774), [PR #16785](https://github.com/dotnet/fsharp/pull/16785)) +* Fix wrong range start of INTERP_STRING_END. ([PR #16774](https://github.com/dotnet/fsharp/pull/16774)) * Fix missing warning for recursive calls in list comprehensions. ([PR #16652](https://github.com/dotnet/fsharp/pull/16652)) * Code generated files with > 64K methods and generated symbols crash when loaded. Use infered sequence points for debugging. ([Issue #16399](https://github.com/dotnet/fsharp/issues/16399), [#PR 16514](https://github.com/dotnet/fsharp/pull/16514)) * `nameof Module` expressions and patterns are processed to link files in `--test:GraphBasedChecking`. ([PR #16550](https://github.com/dotnet/fsharp/pull/16550), [PR #16743](https://github.com/dotnet/fsharp/pull/16743)) diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 045e0aae7a0..dda21fffd39 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -2685,7 +2685,7 @@ module internal ParseAndCheckFile = | INTERP_STRING_BEGIN_PART _ | INTERP_STRING_PART _ as tok, _ -> let braceOffset = match tok with - | INTERP_STRING_BEGIN_PART(_, SynStringKind.TripleQuote, (LexerContinuation.Token(_, (_, _, dl, _) :: _))) -> + | INTERP_STRING_BEGIN_PART(_, SynStringKind.TripleQuote, (LexerContinuation.Token(_, (_, _, dl, _, _) :: _))) -> dl - 1 | _ -> 0 diff --git a/src/Compiler/Service/ServiceLexing.fs b/src/Compiler/Service/ServiceLexing.fs index 66893ac950e..424f3297a11 100644 --- a/src/Compiler/Service/ServiceLexing.fs +++ b/src/Compiler/Service/ServiceLexing.fs @@ -35,8 +35,8 @@ module FSharpTokenTag = let INTERP_STRING_BEGIN_PART = tagOfToken (INTERP_STRING_BEGIN_PART("a", SynStringKind.Regular, 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 INTERP_STRING_PART = tagOfToken (INTERP_STRING_PART("a", None, LexCont.Default)) + let INTERP_STRING_END = tagOfToken (INTERP_STRING_END("a", None, LexCont.Default)) let LPAREN = tagOfToken LPAREN let RPAREN = tagOfToken RPAREN let LBRACK = tagOfToken LBRACK @@ -491,9 +491,9 @@ module internal LexerStateEncoding = | STRING_TEXT cont | EOF cont | INTERP_STRING_BEGIN_PART(_, _, cont) - | INTERP_STRING_PART(_, cont) + | INTERP_STRING_PART(_, _, cont) | INTERP_STRING_BEGIN_END(_, _, cont) - | INTERP_STRING_END(_, cont) + | INTERP_STRING_END(_, _, cont) | LBRACE cont | RBRACE cont | BYTEARRAY(_, _, cont) @@ -621,12 +621,12 @@ module internal LexerStateEncoding = let tag1, i1, kind1, rest = match stringNest with | [] -> false, 0, 0, [] - | (i1, kind1, _, _) :: rest -> true, i1, encodeStringStyle kind1, rest + | (i1, kind1, _, _, _) :: rest -> true, i1, encodeStringStyle kind1, rest let tag2, i2, kind2 = match rest with | [] -> false, 0, 0 - | (i2, kind2, _, _) :: _ -> true, i2, encodeStringStyle kind2 + | (i2, kind2, _, _, _) :: _ -> true, i2, encodeStringStyle kind2 (if tag1 then 0b100000000000 else 0) ||| (if tag2 then 0b010000000000 else 0) @@ -696,9 +696,9 @@ module internal LexerStateEncoding = let nest = [ if tag1 then - i1, decodeStringStyle kind1, 0, range0 + i1, decodeStringStyle kind1, 0, None, range0 if tag2 then - i2, decodeStringStyle kind2, 0, range0 + i2, decodeStringStyle kind2, 0, None, range0 ] nest diff --git a/src/Compiler/SyntaxTree/LexHelpers.fs b/src/Compiler/SyntaxTree/LexHelpers.fs index 02d4da364d4..00bdd86cf1a 100644 --- a/src/Compiler/SyntaxTree/LexHelpers.fs +++ b/src/Compiler/SyntaxTree/LexHelpers.fs @@ -188,9 +188,9 @@ type LexerStringFinisher = else INTERP_STRING_BEGIN_END(s, synStringKind, cont) else if isPart then - INTERP_STRING_PART(s, cont) + INTERP_STRING_PART(s, None, cont) else - INTERP_STRING_END(s, cont) + INTERP_STRING_END(s, None, cont) elif kind.IsByteString then let synByteStringKind = if isVerbatim then diff --git a/src/Compiler/SyntaxTree/ParseHelpers.fs b/src/Compiler/SyntaxTree/ParseHelpers.fs index cd4b41787e1..d90e395c0c9 100644 --- a/src/Compiler/SyntaxTree/ParseHelpers.fs +++ b/src/Compiler/SyntaxTree/ParseHelpers.fs @@ -308,7 +308,7 @@ type LexerStringKind = /// 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 * int * range) list +type LexerInterpolatedStringNesting = (int * LexerStringStyle * int * range option * range) list /// The parser defines a number of tokens for whitespace and /// comments eliminated by the lexer. These carry a specification of @@ -973,7 +973,7 @@ let checkEndOfFileError t = match nesting with | [] -> () - | (_, _, _, m) :: _ -> reportParseErrorAt m (FSComp.SR.parsEofInInterpolatedStringFill ()) + | (_, _, _, _, m) :: _ -> reportParseErrorAt m (FSComp.SR.parsEofInInterpolatedStringFill ()) type BindingSet = BindingSetPreAttrs of range * bool * bool * (SynAttributes -> SynAccess option -> SynAttributes * SynBinding list) * range diff --git a/src/Compiler/SyntaxTree/ParseHelpers.fsi b/src/Compiler/SyntaxTree/ParseHelpers.fsi index 9add16af683..a8d61f3cb7e 100644 --- a/src/Compiler/SyntaxTree/ParseHelpers.fsi +++ b/src/Compiler/SyntaxTree/ParseHelpers.fsi @@ -118,7 +118,7 @@ type LexerStringKind = static member String: LexerStringKind -type LexerInterpolatedStringNesting = (int * LexerStringStyle * int * range) list +type LexerInterpolatedStringNesting = (int * LexerStringStyle * int * range option * range) list [] type LexerContinuation = diff --git a/src/Compiler/lex.fsl b/src/Compiler/lex.fsl index cce978d4a13..a5499b2efbc 100644 --- a/src/Compiler/lex.fsl +++ b/src/Compiler/lex.fsl @@ -120,7 +120,7 @@ let checkExprGreaterColonOp (lexbuf:UnicodeLexing.Lexbuf) = let unexpectedChar lexbuf = LEX_FAILURE (FSComp.SR.lexUnexpectedChar(lexeme lexbuf)) -let startString args (lexbuf: UnicodeLexing.Lexbuf) = +let startString args (lexbuf: UnicodeLexing.Lexbuf) altStartForStringPartOrEnd = let buf = ByteBuffer.Create StringCapacity let m = lexbuf.LexemeRange let startp = lexbuf.StartPos @@ -158,9 +158,9 @@ let startString args (lexbuf: UnicodeLexing.Lexbuf) = INTERP_STRING_BEGIN_END (s, synStringKind, cont) else if isPart then - INTERP_STRING_PART (s, cont) + INTERP_STRING_PART (s, altStartForStringPartOrEnd, cont) else - INTERP_STRING_END (s, cont) + INTERP_STRING_END (s, altStartForStringPartOrEnd, cont) else let s = Lexhelp.stringBufferAsString buf let synStringKind = @@ -587,12 +587,12 @@ rule token (args: LexArgs) (skip: bool) = parse else mlOnly m args skip lexbuf } | '"' - { let buf, fin, m = startString args lexbuf + { let buf, fin, m = startString args lexbuf None // Single quote in triple quote ok, others disallowed match args.stringNest with - | (_, LexerStringStyle.ExtendedInterpolated, _, _) :: _ - | (_, LexerStringStyle.TripleQuote, _, _) :: _ -> () + | (_, LexerStringStyle.ExtendedInterpolated, _, _, _) :: _ + | (_, LexerStringStyle.TripleQuote, _, _, _) :: _ -> () | _ :: _ -> errorR(Error(FSComp.SR.lexSingleQuoteInSingleQuote(), m)) | [] -> () @@ -600,7 +600,7 @@ rule token (args: LexArgs) (skip: bool) = parse else singleQuoteString (buf, fin, m, LexerStringKind.String, args) skip lexbuf } | '$' '"' '"' '"' - { let buf, fin, m = startString args lexbuf + { let buf, fin, m = startString args lexbuf None // Single quote in triple quote ok, others disallowed match args.stringNest with @@ -612,7 +612,7 @@ rule token (args: LexArgs) (skip: bool) = parse else tripleQuoteString (buf, fin, m, LexerStringKind.InterpolatedStringFirst, args) skip lexbuf } | ('$'+) '"' '"' '"' - { let buf, fin, m = startString args lexbuf + { let buf, fin, m = startString args lexbuf None if lexbuf.SupportsFeature LanguageFeature.ExtendedStringInterpolation then // Single quote in triple quote ok, others disallowed @@ -635,11 +635,11 @@ rule token (args: LexArgs) (skip: bool) = parse } | '$' '"' - { let buf,fin,m = startString args lexbuf + { let buf,fin,m = startString args lexbuf None // Single quote in triple quote ok, others disallowed match args.stringNest with - | (_, style, _, _) :: _ when style = LexerStringStyle.ExtendedInterpolated || style = LexerStringStyle.TripleQuote -> () + | (_, style, _, _, _) :: _ when style = LexerStringStyle.ExtendedInterpolated || style = LexerStringStyle.TripleQuote -> () | _ :: _ -> errorR(Error(FSComp.SR.lexSingleQuoteInSingleQuote(), m)) | _ -> () @@ -649,7 +649,7 @@ rule token (args: LexArgs) (skip: bool) = parse singleQuoteString (buf, fin, m, LexerStringKind.InterpolatedStringFirst, args) skip lexbuf } | '"' '"' '"' - { let buf, fin, m = startString args lexbuf + { let buf, fin, m = startString args lexbuf None args.interpolationDelimiterLength <- 0 @@ -664,12 +664,12 @@ rule token (args: LexArgs) (skip: bool) = parse tripleQuoteString (buf, fin, m, LexerStringKind.String, args) skip lexbuf } | '@' '"' - { let buf, fin, m = startString args lexbuf + { let buf, fin, m = startString args lexbuf None // Single quote in triple quote ok, others disallowed match args.stringNest with - | (_, LexerStringStyle.ExtendedInterpolated, _, _) :: _ - | (_, LexerStringStyle.TripleQuote, _, _) :: _ -> () + | (_, LexerStringStyle.ExtendedInterpolated, _, _, _) :: _ + | (_, LexerStringStyle.TripleQuote, _, _, _) :: _ -> () | _ :: _ -> errorR(Error(FSComp.SR.lexSingleQuoteInSingleQuote(), m)) | _ -> () @@ -679,11 +679,11 @@ rule token (args: LexArgs) (skip: bool) = parse verbatimString (buf, fin, m, LexerStringKind.String, args) skip lexbuf } | ("$@" | "@$") '"' - { let buf, fin, m = startString args lexbuf + { let buf, fin, m = startString args lexbuf None // Single quote in triple quote ok, others disallowed match args.stringNest with - | (_, style, _, _) :: _ when style = LexerStringStyle.ExtendedInterpolated || style = LexerStringStyle.TripleQuote -> () + | (_, style, _, _, _) :: _ when style = LexerStringStyle.ExtendedInterpolated || style = LexerStringStyle.TripleQuote -> () | _ :: _ -> errorR(Error(FSComp.SR.lexSingleQuoteInSingleQuote(), m)) | _ -> () @@ -888,10 +888,10 @@ rule token (args: LexArgs) (skip: bool) = parse { match args.stringNest with | [] -> () - | (counter, style, d, m) :: rest -> + | (counter, style, d, _, m) :: rest -> // Note, we do not update the 'm', any incomplete-interpolation error // will be reported w.r.t. the first '{' - args.stringNest <- (counter + 1, style, d, m) :: rest + args.stringNest <- (counter + 1, style, d, None, 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 @@ -899,37 +899,22 @@ rule token (args: LexArgs) (skip: bool) = parse | "|" { BAR } - | "}" + - { - match args.stringNest with - | (1, style, _, _r) :: rest -> - args.stringNest <- rest - let buf, fin, m = startString args lexbuf - if not skip then - STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, style, LexerStringKind.InterpolatedStringPart, args.interpolationDelimiterLength, m)) - else - match style with - | LexerStringStyle.Verbatim -> verbatimString (buf, fin, m, LexerStringKind.InterpolatedStringPart, args) skip lexbuf - | LexerStringStyle.SingleQuote -> singleQuoteString (buf, fin, m, LexerStringKind.InterpolatedStringPart, args) skip lexbuf - | LexerStringStyle.TripleQuote -> tripleQuoteString (buf, fin, m, LexerStringKind.InterpolatedStringPart, args) skip lexbuf - | LexerStringStyle.ExtendedInterpolated -> extendedInterpolatedString (buf, fin, m, LexerStringKind.InterpolatedStringPart, args) skip lexbuf - | (counter, style, d, m) :: rest -> - // Note, we do not update the 'm', any incomplete-interpolation error - // will be reported w.r.t. the first '{' - args.stringNest <- (counter - 1, style, d, m) :: rest - let cont = LexCont.Token(args.ifdefStack, args.stringNest) - RBRACE cont - | _ -> - let cont = LexCont.Token(args.ifdefStack, args.stringNest) - RBRACE cont - } - | "}" { + // 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, _, _r) :: rest -> + | (1, LexerStringStyle.ExtendedInterpolated, delimLength, altR, r) :: rest when delimLength > 1 -> + // On the first "}" of multiple "}", keep the range of the starting "}" for later processing in startString + let altStart = + match altR with + | None -> Some lexbuf.LexemeRange + | _ -> altR + args.stringNest <- (1, LexerStringStyle.ExtendedInterpolated, delimLength - 1, altStart, r) :: rest + token args skip lexbuf + | (1, style, _, altR, _r) :: rest -> args.stringNest <- rest - let buf, fin, m = startString args lexbuf + let buf, fin, m = startString args lexbuf altR if not skip then STRING_TEXT (LexCont.String(args.ifdefStack, args.stringNest, style, LexerStringKind.InterpolatedStringPart, args.interpolationDelimiterLength, m)) else @@ -938,10 +923,10 @@ rule token (args: LexArgs) (skip: bool) = parse | LexerStringStyle.SingleQuote -> singleQuoteString (buf, fin, m, LexerStringKind.InterpolatedStringPart, args) skip lexbuf | LexerStringStyle.TripleQuote -> tripleQuoteString (buf, fin, m, LexerStringKind.InterpolatedStringPart, args) skip lexbuf | LexerStringStyle.ExtendedInterpolated -> extendedInterpolatedString (buf, fin, m, LexerStringKind.InterpolatedStringPart, args) skip lexbuf - | (counter, style, d, m) :: rest -> + | (counter, style, d, altR, m) :: rest -> // Note, we do not update the 'm', any incomplete-interpolation error // will be reported w.r.t. the first '{' - args.stringNest <- (counter - 1, style, d, m) :: rest + args.stringNest <- (counter - 1, style, d, altR, m) :: rest let cont = LexCont.Token(args.ifdefStack, args.stringNest) RBRACE cont @@ -1279,7 +1264,7 @@ and singleQuoteString (sargs: LexerStringArgs) (skip: bool) = parse if kind.IsInterpolated then // get a new range for where the fill starts let m2 = lexbuf.LexemeRange - args.stringNest <- (1, LexerStringStyle.SingleQuote, args.interpolationDelimiterLength, m2) :: args.stringNest + args.stringNest <- (1, LexerStringStyle.SingleQuote, args.interpolationDelimiterLength, None, m2) :: args.stringNest let cont = LexCont.Token(args.ifdefStack, args.stringNest) fin.Finish buf kind LexerStringFinisherContext.InterpolatedPart cont else @@ -1395,7 +1380,7 @@ and verbatimString (sargs: LexerStringArgs) (skip: bool) = parse if kind.IsInterpolated then // get a new range for where the fill starts let m2 = lexbuf.LexemeRange - args.stringNest <- (1, LexerStringStyle.Verbatim, args.interpolationDelimiterLength, m2) :: args.stringNest + args.stringNest <- (1, LexerStringStyle.Verbatim, args.interpolationDelimiterLength, None, m2) :: args.stringNest let cont = LexCont.Token(args.ifdefStack, args.stringNest) fin.Finish buf kind (LexerStringFinisherContext.InterpolatedPart ||| LexerStringFinisherContext.Verbatim) cont else @@ -1514,7 +1499,7 @@ and tripleQuoteString (sargs: LexerStringArgs) (skip: bool) = parse if kind.IsInterpolated then // get a new range for where the fill starts let m2 = lexbuf.LexemeRange - args.stringNest <- (1, LexerStringStyle.TripleQuote, args.interpolationDelimiterLength, m2) :: args.stringNest + args.stringNest <- (1, LexerStringStyle.TripleQuote, args.interpolationDelimiterLength, None, m2) :: args.stringNest let cont = LexCont.Token(args.ifdefStack, args.stringNest) fin.Finish buf kind (LexerStringFinisherContext.InterpolatedPart ||| LexerStringFinisherContext.TripleQuote) cont else @@ -1619,7 +1604,7 @@ and extendedInterpolatedString (sargs: LexerStringArgs) (skip: bool) = parse let maxBraces = 2 * args.interpolationDelimiterLength - 1 if numBraces > maxBraces then let m2 = lexbuf.LexemeRange - args.stringNest <- (1, LexerStringStyle.ExtendedInterpolated, args.interpolationDelimiterLength, m2) :: args.stringNest + args.stringNest <- (1, LexerStringStyle.ExtendedInterpolated, args.interpolationDelimiterLength, None, m2) :: args.stringNest let cont = LexCont.Token(args.ifdefStack, args.stringNest) fail args lexbuf (FSComp.SR.lexTooManyLBracesInTripleQuote()) @@ -1640,7 +1625,7 @@ and extendedInterpolatedString (sargs: LexerStringArgs) (skip: bool) = parse String.replicate extraBraces "{" |> addUnicodeString buf // get a new range for where the fill starts let m2 = lexbuf.LexemeRange - args.stringNest <- (1, LexerStringStyle.ExtendedInterpolated, args.interpolationDelimiterLength, m2) :: args.stringNest + args.stringNest <- (1, LexerStringStyle.ExtendedInterpolated, args.interpolationDelimiterLength, None, m2) :: args.stringNest let cont = LexCont.Token(args.ifdefStack, args.stringNest) fin.Finish buf kind (LexerStringFinisherContext.InterpolatedPart ||| LexerStringFinisherContext.TripleQuote) cont } diff --git a/src/Compiler/pars.fsy b/src/Compiler/pars.fsy index 4080fc7ec8b..95e11c83ff4 100644 --- a/src/Compiler/pars.fsy +++ b/src/Compiler/pars.fsy @@ -37,8 +37,8 @@ let parse_error_rich = Some(fun (ctxt: ParseErrorContext<_>) -> %token STRING %token INTERP_STRING_BEGIN_END %token INTERP_STRING_BEGIN_PART -%token INTERP_STRING_PART -%token INTERP_STRING_END +%token INTERP_STRING_PART +%token INTERP_STRING_END %token LBRACE RBRACE %token KEYWORD_STRING // Like __SOURCE_DIRECTORY__ @@ -6774,16 +6774,37 @@ interpolatedStringFill: interpolatedStringParts: | INTERP_STRING_END - { [ SynInterpolatedStringPart.String(fst $1, rhs parseState 1) ] } + { + let (s, altStart, _) = $1 + let mOrig = rhs parseState 1 + let m = + match altStart with + | Some r -> unionRanges r mOrig + | None -> mOrig + [ SynInterpolatedStringPart.String(s, m) ] } | INTERP_STRING_PART interpolatedStringFill interpolatedStringParts - { SynInterpolatedStringPart.String(fst $1, rhs parseState 1) :: SynInterpolatedStringPart.FillExpr $2 :: $3 } + { // let origM = rhs parseState 1 + // let dummy = mkRange origM.FileName (mkPos origM.StartLine (origM.StartColumn - 2)) (mkPos origM.EndLine origM.EndColumn) + let (s, altStart, _) = $1 + let mOrig = rhs parseState 1 + let m = + match altStart with + | Some r -> unionRanges r mOrig + | None -> mOrig + SynInterpolatedStringPart.String(s, m) :: SynInterpolatedStringPart.FillExpr $2 :: $3 } | INTERP_STRING_PART interpolatedStringParts { let rbrace = parseState.InputEndPosition 1 let lbrace = parseState.InputStartPosition 2 reportParseErrorAt (mkSynRange rbrace lbrace) (FSComp.SR.parsEmptyFillInInterpolatedString()) - SynInterpolatedStringPart.String(fst $1, rhs parseState 1) :: $2 } + let (s, altStart, _) = $1 + let mOrig = rhs parseState 1 + let m = + match altStart with + | Some r -> unionRanges r mOrig + | None -> mOrig + SynInterpolatedStringPart.String(s, m) :: $2 } /* INTERP_STRING_BEGIN_END */ /* INTERP_STRING_BEGIN_PART int32 INTERP_STRING_END */ From 1907702c78d85adc22afd93cf5f318a81781d9cc Mon Sep 17 00:00:00 2001 From: dawe Date: Thu, 29 Feb 2024 13:14:55 +0100 Subject: [PATCH 4/5] add second PR to changelog --- docs/release-notes/.FSharp.Compiler.Service/8.0.300.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md b/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md index 5507157222e..ac42e37ca8d 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md +++ b/docs/release-notes/.FSharp.Compiler.Service/8.0.300.md @@ -1,6 +1,6 @@ ### Fixed -* Fix wrong range start of INTERP_STRING_END. ([PR #16774](https://github.com/dotnet/fsharp/pull/16774)) +* Fix wrong range start of INTERP_STRING_END. ([PR #16774](https://github.com/dotnet/fsharp/pull/16774), [PR #16785](https://github.com/dotnet/fsharp/pull/16785)) * Fix missing warning for recursive calls in list comprehensions. ([PR #16652](https://github.com/dotnet/fsharp/pull/16652)) * Code generated files with > 64K methods and generated symbols crash when loaded. Use infered sequence points for debugging. ([Issue #16399](https://github.com/dotnet/fsharp/issues/16399), [#PR 16514](https://github.com/dotnet/fsharp/pull/16514)) * `nameof Module` expressions and patterns are processed to link files in `--test:GraphBasedChecking`. ([PR #16550](https://github.com/dotnet/fsharp/pull/16550), [PR #16743](https://github.com/dotnet/fsharp/pull/16743)) From b8492a1fae3dc0020f28e27383b160db7a5a698a Mon Sep 17 00:00:00 2001 From: dawe Date: Thu, 29 Feb 2024 22:24:07 +0100 Subject: [PATCH 5/5] remove commented poc code --- src/Compiler/pars.fsy | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/Compiler/pars.fsy b/src/Compiler/pars.fsy index 95e11c83ff4..bd46ab5711e 100644 --- a/src/Compiler/pars.fsy +++ b/src/Compiler/pars.fsy @@ -6784,9 +6784,7 @@ interpolatedStringParts: [ SynInterpolatedStringPart.String(s, m) ] } | INTERP_STRING_PART interpolatedStringFill interpolatedStringParts - { // let origM = rhs parseState 1 - // let dummy = mkRange origM.FileName (mkPos origM.StartLine (origM.StartColumn - 2)) (mkPos origM.EndLine origM.EndColumn) - let (s, altStart, _) = $1 + { let (s, altStart, _) = $1 let mOrig = rhs parseState 1 let m = match altStart with