Refactor #line processing - keep the original positions in the AST

docs/release-notes/.FSharp.Compiler.Service/10.0.100.md

@@ -23,3 +23,4 @@
 * Simplify creation of `FSharpDiagnostics`. In a few cases, errors without ranges were assigned to the currently checked file, while in other cases they carried an empty range. The latter is now true in all cases. In a few cases, ranges at eof were corrected, while in others they were not. They are now always left uncorrected. This is a prerequisit for [#18553](https://github.com/dotnet/fsharp/issues/18553). ([PR #18610](https://github.com/dotnet/fsharp/pull/18610)).
 * `SynExprRecordField` now includes a `range` field ([PR #18617](https://github.com/dotnet/fsharp/pull/18617))
 * Mark `Range.Zero` as obsolete in favor of `Range.range0` ([PR #18664](https://github.com/dotnet/fsharp/pull/18664))
+* Redesign #line processing. The original positions (unaffected by #line directives) are now kept in the AST, and `__LINE__` and `__SOURCE_LINE__` show the original line numbers / file names. However, all diagnostics and debug information stays the same (shows the position transformed by the #line directives). ([Issue #18553](https://github.com/dotnet/fsharp/issues/18553), [PR #18699](https://github.com/dotnet/fsharp/pull/18699))

src/Compiler/Checking/PatternMatchCompilation.fs

@@ -1069,11 +1069,12 @@ let CompilePatternBasic
                     mkCompGenSequential mMatch e (mkDefault (mMatch, resultTy))
 
             | ThrowIncompleteMatchException ->
+                let mmMatch = mMatch.ApplyLineDirectives()
                 mkThrow mMatch resultTy
                     (mkExnExpr(g.MatchFailureException_tcr,
-                                [ mkString g mMatch mMatch.FileName
-                                  mkInt g mMatch mMatch.StartLine
-                                  mkInt g mMatch mMatch.StartColumn], mMatch))
+                                [ mkString g mMatch mmMatch.FileName
+                                  mkInt g mMatch mmMatch.StartLine
+                                  mkInt g mMatch mmMatch.StartColumn], mMatch))
 
             | IgnoreWithWarning ->
                 mkUnit g mMatch

src/Compiler/Checking/QuotationTranslator.fs

@@ -214,20 +214,21 @@ let (|ObjectInitializationCheck|_|) g expr =
             isUnitTy g resultTy -> ValueSome()
     | _ -> ValueNone
 
-let rec EmitDebugInfoIfNecessary cenv env m astExpr : ExprData =
+let rec EmitDebugInfoIfNecessary cenv env (m: range) astExpr : ExprData =
     // do not emit debug info if emitDebugInfoInQuotations = false or it was already written for the given expression
     if cenv.emitDebugInfoInQuotations && not (QP.isAttributedExpression astExpr) then
         cenv.emitDebugInfoInQuotations <- false
         try
             let mk_tuple g m es = mkRefTupled g m es (List.map (tyOfExpr g) es)
 
             let rangeExpr =
+                let mm = m.ApplyLineDirectives() // LineDirectives: map ranges for the debugger
                 mk_tuple cenv.g m
-                    [ mkString cenv.g m m.FileName
-                      mkInt cenv.g m m.StartLine
-                      mkInt cenv.g m m.StartColumn
-                      mkInt cenv.g m m.EndLine
-                      mkInt cenv.g m m.EndColumn ]
+                    [ mkString cenv.g m mm.FileName
+                      mkInt cenv.g m mm.StartLine
+                      mkInt cenv.g m mm.StartColumn
+                      mkInt cenv.g m mm.EndLine
+                      mkInt cenv.g m mm.EndColumn ]
             let attrExpr =
                 mk_tuple cenv.g m
                     [ mkString cenv.g m "DebugRange"

src/Compiler/CodeGen/IlxGen.fs

@@ -1849,6 +1849,8 @@ let AddIncrementalLocalAssemblyFragmentToIlxGenEnv (cenv: cenv, isIncrementalFra
 
 /// Generate IL debugging information.
 let GenILSourceMarker (g: TcGlobals) (m: range) =
+    let m = m.ApplyLineDirectives()
+
     ILDebugPoint.Create(
         document = g.memoize_file m.FileIndex,
         line = m.StartLine,
@@ -2512,7 +2514,7 @@ type CodeGenBuffer(m: range, mgbuf: AssemblyBuilder, methodName, alreadyUsedArgs
     // Add a nop to make way for the first debug point.
     do
         if mgbuf.cenv.options.generateDebugSymbols then
-            let doc = g.memoize_file m.FileIndex
+            let doc = g.memoize_file (m.ApplyLineDirectives().FileIndex)
             let i = FeeFeeInstr mgbuf.cenv doc
             codebuf.Add i // for the FeeFee or a better debug point
 
@@ -2599,7 +2601,7 @@ type CodeGenBuffer(m: range, mgbuf: AssemblyBuilder, methodName, alreadyUsedArgs
     // Emit FeeFee breakpoints for hidden code, see https://blogs.msdn.microsoft.com/jmstall/2005/06/19/line-hidden-and-0xfeefee-sequence-points/
     member cgbuf.EmitStartOfHiddenCode() =
         if mgbuf.cenv.options.generateDebugSymbols then
-            let doc = g.memoize_file m.FileIndex
+            let doc = g.memoize_file (m.ApplyLineDirectives().FileIndex)
             let i = FeeFeeInstr mgbuf.cenv doc
             hasDebugPoints <- true
 

src/Compiler/Driver/CompilerDiagnostics.fs

@@ -2063,6 +2063,7 @@ let FormatDiagnosticLocation (tcConfig: TcConfig) (m: Range) : FormattedDiagnost
             File = ""
         }
     else
+        let m = m.ApplyLineDirectives()
         let file = m.FileName
 
         let file =
@@ -2194,6 +2195,8 @@ let CollectFormattedDiagnostics (tcConfig: TcConfig, severity: FSharpDiagnosticS
                 | DiagnosticStyle.Rich ->
                     match diagnostic.Range with
                     | Some m ->
+                        let m = m.ApplyLineDirectives()
+
                         let content =
                             m.FileName
                             |> FileSystem.GetFullFilePathInDirectoryShim tcConfig.implicitIncludeDir
@@ -2279,6 +2282,7 @@ type PhasedDiagnostic with
         match diagnostic.Range with
         | None -> ()
         | Some m ->
+            let m = m.ApplyLineDirectives()
             let fileName = m.FileName
             let lineA = m.StartLine
             let lineB = m.EndLine

src/Compiler/Driver/ParseAndCheckInputs.fs

@@ -215,24 +215,24 @@ let PostParseModuleSpec (_i, defaultNamespace, isLastCompiland, fileName, intf)
 
         SynModuleOrNamespaceSig(lid, isRecursive, kind, decls, xmlDoc, attributes, None, range, trivia)
 
-let private collectCodeComments (lexbuf: UnicodeLexing.Lexbuf) =
-    let tripleSlashComments = XmlDocStore.ReportInvalidXmlDocPositions(lexbuf)
-
-    [
-        yield! CommentStore.GetComments(lexbuf)
-        yield! (List.map CommentTrivia.LineComment tripleSlashComments)
-    ]
-    |> List.sortBy (function
-        | CommentTrivia.LineComment r
-        | CommentTrivia.BlockComment r -> r.StartLine, r.StartColumn)
-
-let private collectParsedInputTrivia lexbuf diagnosticOptions isScript submoduleRanges =
+let private finishPreprocessing lexbuf diagnosticOptions isScript submoduleRanges =
     WarnScopes.MergeInto diagnosticOptions isScript submoduleRanges lexbuf
+    LineDirectives.add lexbuf.StartPos.FileIndex (LineDirectiveStore.GetLineDirectives lexbuf)
 
+let private collectParsedInputTrivia lexbuf =
     {
         ConditionalDirectives = IfdefStore.GetTrivia(lexbuf)
         WarnDirectives = WarnScopes.getDirectiveTrivia (lexbuf)
-        CodeComments = collectCodeComments lexbuf
+        CodeComments =
+            let tripleSlashComments = XmlDocStore.ReportInvalidXmlDocPositions(lexbuf)
+
+            [
+                yield! CommentStore.GetComments(lexbuf)
+                yield! List.map CommentTrivia.LineComment tripleSlashComments
+            ]
+            |> List.sortBy (function
+                | CommentTrivia.LineComment r
+                | CommentTrivia.BlockComment r -> r.StartLine, r.StartColumn)
     }
 
 let private getImplSubmoduleRanges (impls: ParsedImplFileFragment list) =
@@ -276,8 +276,9 @@ let PostParseModuleImpls
 
     let isScript = IsScript fileName
 
-    let trivia =
-        collectParsedInputTrivia lexbuf diagnosticOptions isScript (getImplSubmoduleRanges impls)
+    finishPreprocessing lexbuf diagnosticOptions isScript (getImplSubmoduleRanges impls)
+
+    let trivia = collectParsedInputTrivia lexbuf
 
     let othersWithSameName =
         impls
@@ -309,8 +310,9 @@ let PostParseModuleSpecs
         identifiers: Set<string>
     ) =
 
-    let trivia =
-        collectParsedInputTrivia lexbuf diagnosticOptions false (getSpecSubmoduleRanges specs)
+    finishPreprocessing lexbuf diagnosticOptions false (getSpecSubmoduleRanges specs)
+
+    let trivia = collectParsedInputTrivia lexbuf
 
     let othersWithSameName =
         specs

src/Compiler/Facilities/prim-lexing.fs

@@ -211,40 +211,35 @@ open System.Collections.Generic
 type internal Position =
     val FileIndex: int
     val Line: int
-    val OriginalLine: int
     val AbsoluteOffset: int
     val StartOfLineAbsoluteOffset: int
     member x.Column = x.AbsoluteOffset - x.StartOfLineAbsoluteOffset
 
-    new(fileIndex: int, line: int, originalLine: int, startOfLineAbsoluteOffset: int, absoluteOffset: int) =
+    new(fileIndex: int, line: int, startOfLineAbsoluteOffset: int, absoluteOffset: int) =
         {
             FileIndex = fileIndex
             Line = line
-            OriginalLine = originalLine
             AbsoluteOffset = absoluteOffset
             StartOfLineAbsoluteOffset = startOfLineAbsoluteOffset
         }
 
     member x.NextLine =
-        Position(x.FileIndex, x.Line + 1, x.OriginalLine + 1, x.AbsoluteOffset, x.AbsoluteOffset)
+        Position(x.FileIndex, x.Line + 1, x.AbsoluteOffset, x.AbsoluteOffset)
 
     member x.EndOfToken n =
-        Position(x.FileIndex, x.Line, x.OriginalLine, x.StartOfLineAbsoluteOffset, x.AbsoluteOffset + n)
+        Position(x.FileIndex, x.Line, x.StartOfLineAbsoluteOffset, x.AbsoluteOffset + n)
 
     member x.ShiftColumnBy by =
-        Position(x.FileIndex, x.Line, x.OriginalLine, x.StartOfLineAbsoluteOffset, x.AbsoluteOffset + by)
+        Position(x.FileIndex, x.Line, x.StartOfLineAbsoluteOffset, x.AbsoluteOffset + by)
 
     member x.ColumnMinusOne =
-        Position(x.FileIndex, x.Line, x.OriginalLine, x.StartOfLineAbsoluteOffset, x.StartOfLineAbsoluteOffset - 1)
-
-    member x.ApplyLineDirective(fileIdx, line) =
-        Position(fileIdx, line, x.OriginalLine + 1, x.AbsoluteOffset, x.AbsoluteOffset)
+        Position(x.FileIndex, x.Line, x.StartOfLineAbsoluteOffset, x.StartOfLineAbsoluteOffset - 1)
 
     override p.ToString() = $"({p.Line},{p.Column})"
 
     static member Empty = Position()
 
-    static member FirstLine fileIdx = Position(fileIdx, 1, 1, 0, 0)
+    static member FirstLine fileIdx = Position(fileIdx, 1, 0, 0)
 
 type internal LexBufferFiller<'Char> = LexBuffer<'Char> -> unit
 

src/Compiler/Facilities/prim-lexing.fsi

@@ -76,10 +76,6 @@ type internal Position =
     /// for the new line by modifying the EndPos property of the LexBuffer.
     val Line: int
 
-    /// The line number for the position in the input stream, assuming fresh positions have been updated
-    /// using for the new line.
-    val OriginalLine: int
-
     /// The character number in the input stream.
     val AbsoluteOffset: int
 
@@ -102,9 +98,6 @@ type internal Position =
     /// Same line, column -1.
     member ColumnMinusOne: Position
 
-    /// Apply a #line directive.
-    member ApplyLineDirective: fileIdx: int * line: int -> Position
-
     /// Get an arbitrary position, with the empty string as file name.
     static member Empty: Position
 

src/Compiler/Symbols/FSharpDiagnostic.fs

@@ -235,7 +235,7 @@ type FSharpDiagnostic(m: range, severity: FSharpDiagnosticSeverity, message: str
              | _ -> diagnostic.FormatCore(flatErrors, suggestNames)
 
         let errorNum = diagnostic.Number
-        let m = match diagnostic.Range with Some m -> m | None -> range0
+        let m = match diagnostic.Range with Some m -> m.ApplyLineDirectives() | None -> range0
         FSharpDiagnostic(m, severity, msg, diagnostic.Subcategory(), errorNum, "FS", extendedData)
 
     static member NewlineifyErrorString(message) = NewlineifyErrorString(message)
@@ -335,10 +335,13 @@ module DiagnosticHelpers =
         | FSharpDiagnosticSeverity.Hidden -> []
         | adjustedSeverity ->
 
-            let diagnostic = FSharpDiagnostic.CreateFromException (diagnostic, adjustedSeverity, suggestNames, flatErrors, symbolEnv)
-            let fileName = diagnostic.Range.FileName
+            let fileName = 
+                match diagnostic.Range with
+                | Some r -> r.FileName
+                | None -> TcGlobals.DummyFileNameForRangesWithoutASpecificLocation
+            let fDiagnostic = FSharpDiagnostic.CreateFromException (diagnostic, adjustedSeverity, suggestNames, flatErrors, symbolEnv)
             if allErrors || fileName = mainInputFileName || fileName = TcGlobals.DummyFileNameForRangesWithoutASpecificLocation then
-                [diagnostic]
+                [fDiagnostic]
             else []
 
     let CreateDiagnostics (options, allErrors, mainInputFileName, diagnostics, suggestNames, flatErrors, symbolEnv) =

src/Compiler/SyntaxTree/LexFilter.fs

@@ -19,9 +19,9 @@ open FSharp.Compiler.UnicodeLexing
 
 let forceDebug = false
 
-let stringOfPos (pos: Position) = sprintf "(%d:%d)" pos.OriginalLine pos.Column
+let stringOfPos (pos: Position) = sprintf "(%d:%d)" pos.Line pos.Column
 
-let outputPos os (pos: Position) = Printf.fprintf os "(%d:%d)" pos.OriginalLine pos.Column
+let outputPos os (pos: Position) = Printf.fprintf os "(%d:%d)" pos.Line pos.Column
 
 /// Used for warning strings, which should display columns as 1-based and display
 /// the lines after taking '# line' directives into account (i.e. do not use
@@ -996,7 +996,7 @@ type LexFilterImpl (
                     let warnF = if strictIndentation then error else warn 
                     warnF tokenTup
                         (if debug then
-                            sprintf "possible incorrect indentation: this token is offside of context at position %s, newCtxt = %A, stack = %A, newCtxtPos = %s, c1 = %d, c2 = %d"
+                            sprintf "possible incorrect indentation: this token is offside of context at (original!) position %s, newCtxt = %A, stack = %A, newCtxtPos = %s, c1 = %d, c2 = %d"
                                 (warningStringOfPosition p1.Position) newCtxt offsideStack (stringOfPos newCtxt.StartPos) p1.Column c2
                          else
                             FSComp.SR.lexfltTokenIsOffsideOfContextStartedEarlier(warningStringOfPosition p1.Position))
@@ -1305,7 +1305,7 @@ type LexFilterImpl (
         let isSameLine() =
             match token with
             | EOF _ -> false
-            | _ -> (startPosOfTokenTup (peekNextTokenTup())).OriginalLine = tokenStartPos.OriginalLine
+            | _ -> (startPosOfTokenTup (peekNextTokenTup())).Line = tokenStartPos.Line
 
         let isControlFlowOrNotSameLine() =
             match token with
@@ -1817,7 +1817,7 @@ type LexFilterImpl (
                             elif isTypeCtxt then isTypeSeqBlockElementContinuator token
                             else isSeqBlockElementContinuator token)
                     && (tokenStartCol = offsidePos.Column)
-                    && (tokenStartPos.OriginalLine <> offsidePos.OriginalLine) ->
+                    && (tokenStartPos.Line <> offsidePos.Line) ->
                 if debug then dprintf "offside at column %d matches start of block(%a)! delaying token, returning OBLOCKSEP\n" tokenStartCol outputPos offsidePos
                 replaceCtxt tokenTup (CtxtSeqBlock (FirstInSeqBlock, offsidePos, addBlockEnd))
                 // No change to offside stack: another statement block starts...
@@ -2320,7 +2320,7 @@ type LexFilterImpl (
                 //  For attributes on properties:
                 //      member  x.PublicGetSetProperty
                 //         with [<Foo>]  get() = "Ralf"
-                if (match lookaheadTokenTup.Token with LBRACK_LESS -> true | _ -> false) && (lookaheadTokenStartPos.OriginalLine = tokenTup.StartPos.OriginalLine) then
+                if (match lookaheadTokenTup.Token with LBRACK_LESS -> true | _ -> false) && (lookaheadTokenStartPos.Line = tokenTup.StartPos.Line) then
                     let offsidePos = tokenStartPos
                     pushCtxt tokenTup (CtxtWithAsLet offsidePos)
                     returnToken tokenLexbufState OWITH

src/Compiler/SyntaxTree/LexerStore.fs

@@ -143,3 +143,20 @@ module CommentStore =
     let GetComments (lexbuf: Lexbuf) : CommentTrivia list =
         let store = getStore lexbuf
         Seq.toList store
+
+//------------------------------------------------------------------------
+// Storage to hold the current accumulated line directives, and related access functions
+//------------------------------------------------------------------------
+
+[<RequireQualifiedAccess>]
+module LineDirectiveStore =
+    let private getStore (lexbuf: Lexbuf) =
+        lexbuf.GetLocalData("LineDirectives", ResizeArray<int * (FileIndex * int)>)
+
+    let SaveLineDirective (lexbuf: Lexbuf, fileIndex: FileIndex, line: int) =
+        let store = getStore lexbuf
+        store.Add(lexbuf.StartPos.Line, (fileIndex, line))
+
+    let GetLineDirectives (lexbuf: Lexbuf) : (int * (FileIndex * int)) list =
+        let store = getStore lexbuf
+        Seq.toList store

src/Compiler/SyntaxTree/LexerStore.fsi

@@ -50,3 +50,10 @@ module CommentStore =
     val SaveBlockComment: lexbuf: Lexbuf * startRange: range * endRange: range -> unit
 
     val GetComments: lexbuf: Lexbuf -> CommentTrivia list
+
+[<RequireQualifiedAccess>]
+module LineDirectiveStore =
+
+    val SaveLineDirective: lexbuf: Lexbuf * fileIndex: FileIndex * line: int -> unit
+
+    val GetLineDirectives: lexbuf: Lexbuf -> (int * (FileIndex * int)) list

src/Compiler/SyntaxTree/SyntaxTree.fs

@@ -775,10 +775,7 @@ type SynExpr =
 
     member e.Range =
         match e with
-        | SynExpr.Paren(_, leftParenRange, rightParenRange, r) ->
-            match rightParenRange with
-            | Some rightParenRange when leftParenRange.FileIndex <> rightParenRange.FileIndex -> leftParenRange
-            | _ -> r
+        | SynExpr.Paren(range = m)
         | SynExpr.Quote(range = m)
         | SynExpr.Const(range = m)
         | SynExpr.Typed(range = m)