Monotonic locations (#17632)

When GHC is parsing a file generated by a tool, e.g. by the C preprocessor, the
tool may insert #line pragmas to adjust the locations reported to the user.

As the result, the locations recorded in RealSrcLoc are not monotonic. Elements
that appear later in the StringBuffer are not guaranteed to have a higher
line/column number.

In fact, there are no guarantees whatsoever, as #line pragmas can arbitrarily
modify locations. This lack of guarantees makes ideas such as #17544
infeasible.

This patch adds an additional bit of information to every SrcLoc:

	newtype BufPos = BufPos { bufPos :: Int }

A BufPos represents the location in the StringBuffer, unaffected by any
pragmas.

Updates haddock submodule.

Metric Increase:
    haddock.Cabal
    haddock.base
    haddock.compiler
    MultiLayerModules
    Naperian
    parsing001
    T12150

3 files changed, 15 insertions, 15 deletions

diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 31243edfc1..7793b7183a 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -559,7 +559,7 @@ ghciLogAction old_log_action lastErrLocations
     old_log_action dflags flag severity srcSpan style msg
     case severity of
         SevError -> case srcSpan of
-            RealSrcSpan rsp -> modifyIORef lastErrLocations
+            RealSrcSpan rsp _ -> modifyIORef lastErrLocations
                 (++ [(srcLocFile (realSrcSpanStart rsp), srcLocLine (realSrcSpanStart rsp))])
             _ -> return ()
         _ -> return ()
@@ -2220,7 +2220,7 @@ parseSpanArg s = do
 -- while simply unpacking 'UnhelpfulSpan's
 showSrcSpan :: SrcSpan -> String
 showSrcSpan (UnhelpfulSpan s)  = unpackFS s
-showSrcSpan (RealSrcSpan spn)  = showRealSrcSpan spn
+showSrcSpan (RealSrcSpan spn _) = showRealSrcSpan spn
 
 -- | Variant of 'showSrcSpan' for 'RealSrcSpan's
 showRealSrcSpan :: RealSrcSpan -> String
@@ -3465,7 +3465,7 @@ stepLocalCmd arg = withSandboxOnly ":steplocal" $ step arg
         Just loc -> do
            md <- fromMaybe (panic "stepLocalCmd") <$> getCurrentBreakModule
            current_toplevel_decl <- enclosingTickSpan md loc
-           doContinue (`isSubspanOf` RealSrcSpan current_toplevel_decl) GHC.SingleStep
+           doContinue (`isSubspanOf` RealSrcSpan current_toplevel_decl Nothing) GHC.SingleStep
 
 stepModuleCmd :: GhciMonad m => String -> m ()
 stepModuleCmd arg = withSandboxOnly ":stepmodule" $ step arg
@@ -3483,7 +3483,7 @@ stepModuleCmd arg = withSandboxOnly ":stepmodule" $ step arg
 -- | Returns the span of the largest tick containing the srcspan given
 enclosingTickSpan :: GhciMonad m => Module -> SrcSpan -> m RealSrcSpan
 enclosingTickSpan _ (UnhelpfulSpan _) = panic "enclosingTickSpan UnhelpfulSpan"
-enclosingTickSpan md (RealSrcSpan src) = do
+enclosingTickSpan md (RealSrcSpan src _) = do
   ticks <- getTickArray md
   let line = srcSpanStartLine src
   ASSERT(inRange (bounds ticks) line) do
@@ -3710,7 +3710,7 @@ findBreakAndSet md lookupTickTree = do
          (alreadySet, nm) <-
                recordBreak $ BreakLocation
                        { breakModule = md
-                       , breakLoc = RealSrcSpan pan
+                       , breakLoc = RealSrcSpan pan Nothing
                        , breakTick = tick
                        , onBreakCmd = ""
                        , breakEnabled = True
@@ -3755,7 +3755,7 @@ findBreakForBind name modbreaks _ = filter (not . enclosed) ticks
     ticks = [ (index, span)
             | (index, [n]) <- assocs (GHC.modBreaks_decls modbreaks),
               n == occNameString (nameOccName name),
-              RealSrcSpan span <- [GHC.modBreaks_locs modbreaks ! index] ]
+              RealSrcSpan span _ <- [GHC.modBreaks_locs modbreaks ! index] ]
     enclosed (_,sp0) = any subspan ticks
       where subspan (_,sp) = sp /= sp0 &&
                          realSrcSpanStart sp <= realSrcSpanStart sp0 &&
@@ -3772,7 +3772,7 @@ findBreakByCoord mb_file (line, col) arr
         ticks = arr ! line
 
         -- the ticks that span this coordinate
-        contains = [ tick | tick@(_,pan) <- ticks, RealSrcSpan pan `spans` (line,col),
+        contains = [ tick | tick@(_,pan) <- ticks, RealSrcSpan pan Nothing `spans` (line,col),
                             is_correct_file pan ]
 
         is_correct_file pan
@@ -3817,7 +3817,7 @@ listCmd "" = do
    case mb_span of
       Nothing ->
           printForUser $ text "Not stopped at a breakpoint; nothing to list"
-      Just (RealSrcSpan pan) ->
+      Just (RealSrcSpan pan _) ->
           listAround pan True
       Just pan@(UnhelpfulSpan _) ->
           do resumes <- GHC.getResumeContext
@@ -3848,7 +3848,7 @@ list2 [arg] = do
         wantNameFromInterpretedModule noCanDo arg $ \name -> do
         let loc = GHC.srcSpanStart (GHC.nameSrcSpan name)
         case loc of
-            RealSrcLoc l ->
+            RealSrcLoc l _ ->
                do tickArray <- ASSERT( isExternalName name )
                                getTickArray (GHC.nameModule name)
                   let mb_span = findBreakByCoord (Just (GHC.srcLocFile l))
@@ -3970,9 +3970,9 @@ discardTickArrays = modifyGHCiState (\st -> st {tickarrays = emptyModuleEnv})
 mkTickArray :: [(BreakIndex,SrcSpan)] -> TickArray
 mkTickArray ticks
   = accumArray (flip (:)) [] (1, max_line)
-        [ (line, (nm,pan)) | (nm,RealSrcSpan pan) <- ticks, line <- srcSpanLines pan ]
+        [ (line, (nm,pan)) | (nm,RealSrcSpan pan _) <- ticks, line <- srcSpanLines pan ]
     where
-        max_line = foldr max 0 [ GHC.srcSpanEndLine sp | (_, RealSrcSpan sp) <- ticks ]
+        max_line = foldr max 0 [ GHC.srcSpanEndLine sp | (_, RealSrcSpan sp _) <- ticks ]
         srcSpanLines pan = [ GHC.srcSpanStartLine pan ..  GHC.srcSpanEndLine pan ]
 
 -- don't reset the counter back to zero?
diff --git a/ghc/GHCi/UI/Info.hs b/ghc/GHCi/UI/Info.hs
index 5ec1ca76a4..290a11ff2a 100644
--- a/ghc/GHCi/UI/Info.hs
+++ b/ghc/GHCi/UI/Info.hs
@@ -140,7 +140,7 @@ findNameUses infos span0 string =
     locToSpans (modinfo,name',span') =
         stripSurrounding (span' : map toSrcSpan spans)
       where
-        toSrcSpan = RealSrcSpan . spaninfoSrcSpan
+        toSrcSpan s = RealSrcSpan (spaninfoSrcSpan s) Nothing
         spans = filter ((== Just name') . fmap getName . spaninfoVar)
                        (modinfoSpans modinfo)
 
@@ -150,7 +150,7 @@ stripSurrounding xs = filter (not . isRedundant) xs
   where
     isRedundant x = any (x `strictlyContains`) xs
 
-    (RealSrcSpan s1) `strictlyContains` (RealSrcSpan s2)
+    (RealSrcSpan s1 _) `strictlyContains` (RealSrcSpan s2 _)
          = s1 /= s2 && s1 `containsSpan` s2
     _                `strictlyContains` _ = False
 
@@ -371,7 +371,7 @@ processAllTypeCheckedModule tcm = do
 
     -- | Pretty print the types into a 'SpanInfo'.
     toSpanInfo :: (Maybe Id,SrcSpan,Type) -> Maybe SpanInfo
-    toSpanInfo (n,RealSrcSpan spn,typ)
+    toSpanInfo (n,RealSrcSpan spn _,typ)
         = Just $ spanInfoFromRealSrcSpan spn (Just typ) n
     toSpanInfo _ = Nothing
 
diff --git a/ghc/GHCi/UI/Tags.hs b/ghc/GHCi/UI/Tags.hs
index ce85bb30cf..69c92a7aca 100644
--- a/ghc/GHCi/UI/Tags.hs
+++ b/ghc/GHCi/UI/Tags.hs
@@ -103,7 +103,7 @@ listModuleTags m = do
                      , let exported = GHC.modInfoIsExportedName mInfo name
                      , let kind = tyThing2TagKind tyThing
                      , let loc = srcSpanStart (nameSrcSpan name)
-                     , RealSrcLoc realLoc <- [loc]
+                     , RealSrcLoc realLoc _ <- [loc]
                      ]
 
   where