Remove HasSrcSpan (#17494)wip/no-hassrcspan

Metric Decrease:
    haddock.compiler

4 files changed, 41 insertions, 47 deletions

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 53c7680302..80131c6329 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -257,9 +257,6 @@ module GHC (
         getLoc, unLoc,
         getRealSrcSpan, unRealSrcSpan,
 
-        -- ** HasSrcSpan
-        HasSrcSpan(..), SrcSpanLess, dL, cL,
-
         -- *** Combining and comparing Located values
         eqLocated, cmpLocated, combineLocs, addCLoc,
         leftmost_smallest, leftmost_largest, rightmost,
@@ -1392,7 +1389,7 @@ getRichTokenStream mod = do
 addSourceToTokens :: RealSrcLoc -> StringBuffer -> [Located Token]
                   -> [(Located Token, String)]
 addSourceToTokens _ _ [] = []
-addSourceToTokens loc buf (t@(dL->L span _) : ts)
+addSourceToTokens loc buf (t@(L span _) : ts)
     = case span of
       UnhelpfulSpan _ -> (t,"") : addSourceToTokens loc buf ts
       RealSrcSpan s   -> (t,str) : addSourceToTokens newLoc newBuf ts
@@ -1418,7 +1415,7 @@ showRichTokenStream ts = go startLoc ts ""
           getFile (RealSrcSpan s : _) = srcSpanFile s
           startLoc = mkRealSrcLoc sourceFile 1 1
           go _ [] = id
-          go loc ((dL->L span _, str):ts)
+          go loc ((L span _, str):ts)
               = case span of
                 UnhelpfulSpan _ -> go loc ts
                 RealSrcSpan s
diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs
index bd984618a4..96361591e9 100644
--- a/compiler/main/HeaderInfo.hs
+++ b/compiler/main/HeaderInfo.hs
@@ -85,7 +85,7 @@ getImports dflags buf filename source_filename = do
                 imps = hsmodImports hsmod
                 main_loc = srcLocSpan (mkSrcLoc (mkFastString source_filename)
                                        1 1)
-                mod = mb_mod `orElse` cL main_loc mAIN_NAME
+                mod = mb_mod `orElse` L main_loc mAIN_NAME
                 (src_idecls, ord_idecls) = partition (ideclSource.unLoc) imps
 
                -- GHC.Prim doesn't exist physically, so don't go looking for it.
@@ -96,8 +96,7 @@ getImports dflags buf filename source_filename = do
                 implicit_prelude = xopt LangExt.ImplicitPrelude dflags
                 implicit_imports = mkPrelImports (unLoc mod) main_loc
                                                  implicit_prelude imps
-                convImport (dL->L _ i) = (fmap sl_fs (ideclPkgQual i)
-                                         , ideclName i)
+                convImport (L _ i) = (fmap sl_fs (ideclPkgQual i), ideclName i)
               in
               return (map convImport src_idecls,
                       map convImport (implicit_imports ++ ordinary_imps),
@@ -120,23 +119,23 @@ mkPrelImports this_mod loc implicit_prelude import_decls
   | otherwise = [preludeImportDecl]
   where
       explicit_prelude_import
-       = notNull [ () | (dL->L _ (ImportDecl { ideclName = mod
-                                        , ideclPkgQual = Nothing }))
+       = notNull [ () | L _ (ImportDecl { ideclName = mod
+                                        , ideclPkgQual = Nothing })
                           <- import_decls
                       , unLoc mod == pRELUDE_NAME ]
 
       preludeImportDecl :: LImportDecl GhcPs
       preludeImportDecl
-        = cL loc $ ImportDecl { ideclExt       = noExtField,
-                                ideclSourceSrc = NoSourceText,
-                                ideclName      = cL loc pRELUDE_NAME,
-                                ideclPkgQual   = Nothing,
-                                ideclSource    = False,
-                                ideclSafe      = False,  -- Not a safe import
-                                ideclQualified = NotQualified,
-                                ideclImplicit  = True,   -- Implicit!
-                                ideclAs        = Nothing,
-                                ideclHiding    = Nothing  }
+        = L loc $ ImportDecl { ideclExt       = noExtField,
+                               ideclSourceSrc = NoSourceText,
+                               ideclName      = L loc pRELUDE_NAME,
+                               ideclPkgQual   = Nothing,
+                               ideclSource    = False,
+                               ideclSafe      = False,  -- Not a safe import
+                               ideclQualified = NotQualified,
+                               ideclImplicit  = True,   -- Implicit!
+                               ideclAs        = Nothing,
+                               ideclHiding    = Nothing  }
 
 --------------------------------------------------------------
 -- Get options
@@ -192,7 +191,7 @@ lazyGetToks dflags filename handle = do
                   _other -> do rest <- lazyLexBuf handle state' eof size
                                return (t : rest)
       _ | not eof   -> getMore handle state size
-        | otherwise -> return [cL (RealSrcSpan (last_loc state)) ITeof]
+        | otherwise -> return [L (RealSrcSpan (last_loc state)) ITeof]
                          -- parser assumes an ITeof sentinel at the end
 
   getMore :: Handle -> PState -> Int -> IO [Located Token]
@@ -214,9 +213,9 @@ getToks dflags filename buf = lexAll (pragState dflags buf loc)
   loc  = mkRealSrcLoc (mkFastString filename) 1 1
 
   lexAll state = case unP (lexer False return) state of
-                   POk _      t@(dL->L _ ITeof) -> [t]
+                   POk _      t@(L _ ITeof) -> [t]
                    POk state' t -> t : lexAll state'
-                   _ -> [cL (RealSrcSpan (last_loc state)) ITeof]
+                   _ -> [L (RealSrcSpan (last_loc state)) ITeof]
 
 
 -- | Parse OPTIONS and LANGUAGE pragmas of the source file.
@@ -245,16 +244,16 @@ getOptions' dflags toks
               = case toArgs str of
                   Left _err -> optionsParseError str dflags $   -- #15053
                                  combineSrcSpans (getLoc open) (getLoc close)
-                  Right args -> map (cL (getLoc open)) args ++ parseToks xs
+                  Right args -> map (L (getLoc open)) args ++ parseToks xs
           parseToks (open:close:xs)
               | ITinclude_prag str <- unLoc open
               , ITclose_prag       <- unLoc close
-              = map (cL (getLoc open)) ["-#include",removeSpaces str] ++
+              = map (L (getLoc open)) ["-#include",removeSpaces str] ++
                 parseToks xs
           parseToks (open:close:xs)
               | ITdocOptions str <- unLoc open
               , ITclose_prag     <- unLoc close
-              = map (cL (getLoc open)) ["-haddock-opts", removeSpaces str]
+              = map (L (getLoc open)) ["-haddock-opts", removeSpaces str]
                 ++ parseToks xs
           parseToks (open:xs)
               | ITlanguage_prag <- unLoc open
@@ -263,12 +262,12 @@ getOptions' dflags toks
               | isComment (unLoc comment)
               = parseToks xs
           parseToks _ = []
-          parseLanguage ((dL->L loc (ITconid fs)):rest)
-              = checkExtension dflags (cL loc fs) :
+          parseLanguage ((L loc (ITconid fs)):rest)
+              = checkExtension dflags (L loc fs) :
                 case rest of
-                  (dL->L _loc ITcomma):more -> parseLanguage more
-                  (dL->L _loc ITclose_prag):more -> parseToks more
-                  (dL->L loc _):_ -> languagePragParseError dflags loc
+                  (L _loc ITcomma):more -> parseLanguage more
+                  (L _loc ITclose_prag):more -> parseToks more
+                  (L loc _):_ -> languagePragParseError dflags loc
                   [] -> panic "getOptions'.parseLanguage(1) went past eof token"
           parseLanguage (tok:_)
               = languagePragParseError dflags (getLoc tok)
@@ -296,7 +295,7 @@ checkProcessArgsResult :: MonadIO m => DynFlags -> [Located String] -> m ()
 checkProcessArgsResult dflags flags
   = when (notNull flags) $
       liftIO $ throwIO $ mkSrcErr $ listToBag $ map mkMsg flags
-    where mkMsg (dL->L loc flag)
+    where mkMsg (L loc flag)
               = mkPlainErrMsg dflags loc $
                   (text "unknown flag in  {-# OPTIONS_GHC #-} pragma:" <+>
                    text flag)
@@ -304,11 +303,11 @@ checkProcessArgsResult dflags flags
 -----------------------------------------------------------------------------
 
 checkExtension :: DynFlags -> Located FastString -> Located String
-checkExtension dflags (dL->L l ext)
+checkExtension dflags (L l ext)
 -- Checks if a given extension is valid, and if so returns
 -- its corresponding flag. Otherwise it throws an exception.
   = if ext' `elem` supported
-    then cL l ("-X"++ext')
+    then L l ("-X"++ext')
     else unsupportedExtnError dflags l ext'
   where
     ext' = unpackFS ext
@@ -336,11 +335,11 @@ optionsErrorMsgs :: DynFlags -> [String] -> [Located String] -> FilePath -> Mess
 optionsErrorMsgs dflags unhandled_flags flags_lines _filename
   = (emptyBag, listToBag (map mkMsg unhandled_flags_lines))
   where unhandled_flags_lines :: [Located String]
-        unhandled_flags_lines = [ cL l f
+        unhandled_flags_lines = [ L l f
                                 | f <- unhandled_flags
-                                , (dL->L l f') <- flags_lines
+                                , L l f' <- flags_lines
                                 , f == f' ]
-        mkMsg (dL->L flagSpan flag) =
+        mkMsg (L flagSpan flag) =
             ErrUtils.mkPlainErrMsg dflags flagSpan $
                     text "unknown flag in  {-# OPTIONS_GHC #-} pragma:" <+> text flag
 
diff --git a/compiler/main/HscStats.hs b/compiler/main/HscStats.hs
index 27f192227f..a5072a7690 100644
--- a/compiler/main/HscStats.hs
+++ b/compiler/main/HscStats.hs
@@ -22,7 +22,7 @@ import Data.Char
 
 -- | Source Statistics
 ppSourceStats :: Bool -> Located (HsModule GhcPs) -> SDoc
-ppSourceStats short (dL->L _ (HsModule _ exports imports ldecls _ _))
+ppSourceStats short (L _ (HsModule _ exports imports ldecls _ _))
   = (if short then hcat else vcat)
         (map pp_val
             [("ExportAll        ", export_all), -- 1 if no export list
@@ -84,7 +84,7 @@ ppSourceStats short (dL->L _ (HsModule _ exports imports ldecls _ _))
     default_ds = count (\ x -> case x of { DefD{} -> True; _ -> False}) decls
     val_decls  = [d | ValD _ d <- decls]
 
-    real_exports = case exports of { Nothing -> []; Just (dL->L _ es) -> es }
+    real_exports = case exports of { Nothing -> []; Just (L _ es) -> es }
     n_exports    = length real_exports
     export_ms    = count (\ e -> case unLoc e of { IEModuleContents{} -> True
                                                  ; _ -> False})
@@ -104,7 +104,7 @@ ppSourceStats short (dL->L _ (HsModule _ exports imports ldecls _ _))
     (inst_method_ds, method_specs, method_inlines, inst_type_ds, inst_data_ds)
         = sum5 (map inst_info inst_decls)
 
-    count_bind (PatBind { pat_lhs = (dL->L _ (VarPat{})) }) = (1,0,0)
+    count_bind (PatBind { pat_lhs = L _ (VarPat{}) }) = (1,0,0)
     count_bind (PatBind {})                           = (0,1,0)
     count_bind (FunBind {})                           = (0,1,0)
     count_bind (PatSynBind {})                        = (0,0,1)
@@ -119,12 +119,10 @@ ppSourceStats short (dL->L _ (HsModule _ exports imports ldecls _ _))
     sig_info (ClassOpSig {}) = (0,0,0,0,1)
     sig_info _               = (0,0,0,0,0)
 
-    import_info (dL->L _ (ImportDecl { ideclSafe = safe, ideclQualified = qual
-                                     , ideclAs = as, ideclHiding = spec }))
+    import_info (L _ (ImportDecl { ideclSafe = safe, ideclQualified = qual
+                                 , ideclAs = as, ideclHiding = spec }))
         = add7 (1, safe_info safe, qual_info qual, as_info as, 0,0,0) (spec_info spec)
-    import_info (dL->L _ (XImportDecl nec)) = noExtCon nec
-    import_info _ = panic " import_info: Impossible Match"
-                             -- due to #15884
+    import_info (L _ (XImportDecl nec)) = noExtCon nec
 
     safe_info False = 0
     safe_info True = 1
@@ -138,7 +136,7 @@ ppSourceStats short (dL->L _ (HsModule _ exports imports ldecls _ _))
 
     data_info (DataDecl { tcdDataDefn = HsDataDefn
                                           { dd_cons = cs
-                                          , dd_derivs = (dL->L _ derivs)}})
+                                          , dd_derivs = L _ derivs}})
         = ( length cs
           , foldl' (\s dc -> length (deriv_clause_tys $ unLoc dc) + s)
                    0 derivs )
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index 3a5a0bbee1..d1e0603088 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -386,7 +386,7 @@ handleFlagWarnings dflags warns = do
       -- It would be nicer if warns :: [Located MsgDoc], but that
       -- has circular import problems.
       bag = listToBag [ mkPlainWarnMsg dflags loc (text warn)
-                      | Warn _ (dL->L loc warn) <- warns' ]
+                      | Warn _ (L loc warn) <- warns' ]
 
   printOrThrowWarnings dflags bag