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

2 files changed, 12 insertions, 12 deletions

diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index d6386357ca..cb910d927b 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -297,7 +297,7 @@ enrichHie ts (hsGrp, imports, exports, _) = flip runReaderT initState $ do
       ]
 
 getRealSpan :: SrcSpan -> Maybe Span
-getRealSpan (RealSrcSpan sp) = Just sp
+getRealSpan (RealSrcSpan sp _) = Just sp
 getRealSpan _ = Nothing
 
 grhss_span :: GRHSs p body -> SrcSpan
@@ -307,7 +307,7 @@ grhss_span (XGRHSs _) = panic "XGRHS has no span"
 bindingsOnly :: [Context Name] -> [HieAST a]
 bindingsOnly [] = []
 bindingsOnly (C c n : xs) = case nameSrcSpan n of
-  RealSrcSpan span -> Node nodeinfo span [] : bindingsOnly xs
+  RealSrcSpan span _ -> Node nodeinfo span [] : bindingsOnly xs
     where nodeinfo = NodeInfo S.empty [] (M.singleton (Right n) info)
           info = mempty{identInfo = S.singleton c}
   _ -> bindingsOnly xs
@@ -531,7 +531,7 @@ instance ToHie (TScoped NoExtField) where
   toHie _ = pure []
 
 instance ToHie (IEContext (Located ModuleName)) where
-  toHie (IEC c (L (RealSrcSpan span) mname)) =
+  toHie (IEC c (L (RealSrcSpan span _) mname)) =
       pure $ [Node (NodeInfo S.empty [] idents) span []]
     where details = mempty{identInfo = S.singleton (IEThing c)}
           idents = M.singleton (Left mname) details
@@ -539,7 +539,7 @@ instance ToHie (IEContext (Located ModuleName)) where
 
 instance ToHie (Context (Located Var)) where
   toHie c = case c of
-      C context (L (RealSrcSpan span) name')
+      C context (L (RealSrcSpan span _) name')
         -> do
         m <- asks name_remapping
         let name = case lookupNameEnv m (varName name') of
@@ -557,7 +557,7 @@ instance ToHie (Context (Located Var)) where
 
 instance ToHie (Context (Located Name)) where
   toHie c = case c of
-      C context (L (RealSrcSpan span) name') -> do
+      C context (L (RealSrcSpan span _) name') -> do
         m <- asks name_remapping
         let name = case lookupNameEnv m name' of
               Just var -> varName var
diff --git a/compiler/GHC/Iface/Ext/Utils.hs b/compiler/GHC/Iface/Ext/Utils.hs
index 1e0a241384..0f962c7164 100644
--- a/compiler/GHC/Iface/Ext/Utils.hs
+++ b/compiler/GHC/Iface/Ext/Utils.hs
@@ -227,7 +227,7 @@ getNameScopeAndBinding
   -> M.Map FastString (HieAST a)
   -> Maybe ([Scope], Maybe Span)
 getNameScopeAndBinding n asts = case nameSrcSpan n of
-  RealSrcSpan sp -> do -- @Maybe
+  RealSrcSpan sp _ -> do -- @Maybe
     ast <- M.lookup (srcSpanFile sp) asts
     defNode <- selectLargestContainedBy sp ast
     getFirst $ foldMap First $ do -- @[]
@@ -290,7 +290,7 @@ selectSmallestContaining sp node
 
 definedInAsts :: M.Map FastString (HieAST a) -> Name -> Bool
 definedInAsts asts n = case nameSrcSpan n of
-  RealSrcSpan sp -> srcSpanFile sp `elem` M.keys asts
+  RealSrcSpan sp _ -> srcSpanFile sp `elem` M.keys asts
   _ -> False
 
 isOccurrence :: ContextInfo -> Bool
@@ -406,13 +406,13 @@ simpleNodeInfo :: FastString -> FastString -> NodeInfo a
 simpleNodeInfo cons typ = NodeInfo (S.singleton (cons, typ)) [] M.empty
 
 locOnly :: SrcSpan -> [HieAST a]
-locOnly (RealSrcSpan span) =
+locOnly (RealSrcSpan span _) =
   [Node e span []]
     where e = NodeInfo S.empty [] M.empty
 locOnly _ = []
 
 mkScope :: SrcSpan -> Scope
-mkScope (RealSrcSpan sp) = LocalScope sp
+mkScope (RealSrcSpan sp _) = LocalScope sp
 mkScope _ = NoScope
 
 mkLScope :: Located a -> Scope
@@ -424,7 +424,7 @@ combineScopes _ ModuleScope = ModuleScope
 combineScopes NoScope x = x
 combineScopes x NoScope = x
 combineScopes (LocalScope a) (LocalScope b) =
-  mkScope $ combineSrcSpans (RealSrcSpan a) (RealSrcSpan b)
+  mkScope $ combineSrcSpans (RealSrcSpan a Nothing) (RealSrcSpan b Nothing)
 
 {-# INLINEABLE makeNode #-}
 makeNode
@@ -433,7 +433,7 @@ makeNode
   -> SrcSpan                 -- ^ return an empty list if this is unhelpful
   -> m [HieAST b]
 makeNode x spn = pure $ case spn of
-  RealSrcSpan span -> [Node (simpleNodeInfo cons typ) span []]
+  RealSrcSpan span _ -> [Node (simpleNodeInfo cons typ) span []]
   _ -> []
   where
     cons = mkFastString . show . toConstr $ x
@@ -447,7 +447,7 @@ makeTypeNode
   -> Type                    -- ^ type to associate with the node
   -> m [HieAST Type]
 makeTypeNode x spn etyp = pure $ case spn of
-  RealSrcSpan span ->
+  RealSrcSpan span _ ->
     [Node (NodeInfo (S.singleton (cons,typ)) [etyp] M.empty) span []]
   _ -> []
   where