EPA: Use LocatedA for ModuleName

This allows us to use an Anchor with a DeltaPos in it when exact
printing.

9 files changed, 34 insertions, 33 deletions

diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs
index 8167402525..852ff4c0f2 100644
--- a/compiler/GHC/Driver/Backpack.hs
+++ b/compiler/GHC/Driver/Backpack.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE NondecreasingIndentation #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies #-}
 
 
 -- | This is the driver for the 'ghc --backpack' mode, which
@@ -788,7 +789,7 @@ summariseRequirement pn mod_name = do
                 hpm_module = L loc (HsModule {
                         hsmodAnn = noAnn,
                         hsmodLayout = NoLayoutInfo,
-                        hsmodName = Just (L loc mod_name),
+                        hsmodName = Just (L (noAnnSrcSpan loc) mod_name),
                         hsmodExports = Nothing,
                         hsmodImports = [],
                         hsmodDecls = [],
@@ -877,7 +878,7 @@ hsModuleToModSummary pn hsc_src modname
                                          implicit_prelude imps
 
         rn_pkg_qual = renameRawPkgQual (hsc_unit_env hsc_env)
-        convImport (L _ i) = (rn_pkg_qual (ideclPkgQual i), ideclName i)
+        convImport (L _ i) = (rn_pkg_qual (ideclPkgQual i), reLoc $ ideclName i)
 
     extra_sig_imports <- liftIO $ findExtraSigImports hsc_env hsc_src modname
 
diff --git a/compiler/GHC/Hs.hs b/compiler/GHC/Hs.hs
index 0de279e597..fc50346b21 100644
--- a/compiler/GHC/Hs.hs
+++ b/compiler/GHC/Hs.hs
@@ -73,7 +73,7 @@ data HsModule
       hsmodLayout :: LayoutInfo,
         -- ^ Layout info for the module.
         -- For incomplete modules (e.g. the output of parseHeader), it is NoLayoutInfo.
-      hsmodName :: Maybe (Located ModuleName),
+      hsmodName :: Maybe (LocatedA ModuleName),
         -- ^ @Nothing@: \"module X where\" is omitted (in which case the next
         --     field is Nothing too)
       hsmodExports :: Maybe (LocatedL [LIE GhcPs]),
diff --git a/compiler/GHC/Hs/ImpExp.hs b/compiler/GHC/Hs/ImpExp.hs
index 891415c09f..7282b724cf 100644
--- a/compiler/GHC/Hs/ImpExp.hs
+++ b/compiler/GHC/Hs/ImpExp.hs
@@ -124,7 +124,7 @@ type instance XCImportDecl  GhcTc = NoExtField
 
 type instance XXImportDecl  (GhcPass _) = NoExtCon
 
-type instance Anno ModuleName = SrcSpan
+type instance Anno ModuleName = SrcSpanAnnA
 type instance Anno [LocatedA (IE (GhcPass p))] = SrcSpanAnnL
 
 -- ---------------------------------------------------------------------
@@ -146,7 +146,7 @@ simpleImportDecl :: ModuleName -> ImportDecl GhcPs
 simpleImportDecl mn = ImportDecl {
       ideclExt       = noAnn,
       ideclSourceSrc = NoSourceText,
-      ideclName      = noLoc mn,
+      ideclName      = noLocA mn,
       ideclPkgQual   = NoRawPkgQual,
       ideclSource    = NotBoot,
       ideclSafe      = False,
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index fbeaa8ca3a..e47c90a577 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -588,8 +588,8 @@ instance (ToHie a) => ToHie (Bag a) where
 instance (ToHie a) => ToHie (Maybe a) where
   toHie = maybe (pure []) toHie
 
-instance ToHie (IEContext (Located ModuleName)) where
-  toHie (IEC c (L (RealSrcSpan span _) mname)) = do
+instance ToHie (IEContext (LocatedA ModuleName)) where
+  toHie (IEC c (L (SrcSpanAnn _ (RealSrcSpan span _)) mname)) = do
       org <- ask
       pure $ [Node (mkSourcedNodeInfo org $ NodeInfo S.empty [] idents) span []]
     where details = mempty{identInfo = S.singleton (IEThing c)}
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index d3781af3b5..6f05f68fb5 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -790,12 +790,12 @@ msubsts :: { OrdList (LHsModuleSubst PackageName) }
         | msubst             { unitOL $1 }
 
 msubst :: { LHsModuleSubst PackageName }
-        : modid '=' moduleid { sLL $1 $> $ ($1, $3) }
-        | modid VARSYM modid VARSYM { sLL $1 $> $ ($1, sLL $2 $> $ HsModuleVar $3) }
+        : modid '=' moduleid { sLL (reLoc $1) $> $ (reLoc $1, $3) }
+        | modid VARSYM modid VARSYM { sLL (reLoc $1) $> $ (reLoc $1, sLL $2 $> $ HsModuleVar (reLoc $3)) }
 
 moduleid :: { LHsModuleId PackageName }
-          : VARSYM modid VARSYM { sLL $1 $> $ HsModuleVar $2 }
-          | unitid ':' modid    { sLL $1 $> $ HsModuleId $1 $3 }
+          : VARSYM modid VARSYM { sLL $1 $> $ HsModuleVar (reLoc $2) }
+          | unitid ':' modid    { sLL $1 (reLoc $>) $ HsModuleId $1 (reLoc $3) }
 
 pkgname :: { Located PackageName }
         : STRING     { sL1 $1 $ PackageName (getSTRING $1) }
@@ -832,8 +832,8 @@ rns :: { OrdList LRenaming }
         | rn         { unitOL $1 }
 
 rn :: { LRenaming }
-        : modid 'as' modid { sLL $1 $> $ Renaming $1 (Just $3) }
-        | modid            { sL1 $1    $ Renaming $1 Nothing }
+        : modid 'as' modid { sLL (reLoc $1) (reLoc $>) $ Renaming (reLoc $1) (Just (reLoc $3)) }
+        | modid            { sL1 (reLoc $1)            $ Renaming (reLoc $1) Nothing }
 
 unitbody :: { OrdList (LHsUnitDecl PackageName) }
         : '{'     unitdecls '}'   { $2 }
@@ -851,19 +851,19 @@ unitdecl :: { LHsUnitDecl PackageName }
                  (case snd $2 of
                    NotBoot -> HsSrcFile
                    IsBoot  -> HsBootFile)
-                 $3
+                 (reLoc $3)
                  (Just $ sL1 $1 (HsModule noAnn (thdOf3 $7) (Just $3) $5 (fst $ sndOf3 $7) (snd $ sndOf3 $7) $4 Nothing)) }
         | 'signature' modid maybemodwarning maybeexports 'where' body
              { sL1 $1 $ DeclD
                  HsigFile
-                 $2
+                 (reLoc $2)
                  (Just $ sL1 $1 (HsModule noAnn (thdOf3 $6) (Just $2) $4 (fst $ sndOf3 $6) (snd $ sndOf3 $6) $3 Nothing)) }
         | 'module' maybe_src modid
              { sL1 $1 $ DeclD (case snd $2 of
                    NotBoot -> HsSrcFile
-                   IsBoot  -> HsBootFile) $3 Nothing }
+                   IsBoot  -> HsBootFile) (reLoc $3) Nothing }
         | 'signature' modid
-             { sL1 $1 $ DeclD HsigFile $2 Nothing }
+             { sL1 $1 $ DeclD HsigFile (reLoc $2) Nothing }
         | 'dependency' unitid mayberns
              { sL1 $1 $ IncludeD (IncludeDecl { idUnitId = $2
                                               , idModRenaming = $3
@@ -1014,7 +1014,7 @@ exportlist1 :: { OrdList (LIE GhcPs) }
 export  :: { OrdList (LIE GhcPs) }
         : qcname_ext export_subspec  {% mkModuleImpExp (fst $ unLoc $2) $1 (snd $ unLoc $2)
                                           >>= \ie -> fmap (unitOL . reLocA) (return (sLL (reLoc $1) $> ie)) }
-        |  'module' modid            {% fmap (unitOL . reLocA) (acs (\cs -> sLL $1 $> (IEModuleContents (EpAnn (glR $1) [mj AnnModule $1] cs) $2))) }
+        |  'module' modid            {% fmap (unitOL . reLocA) (acs (\cs -> sLL $1 (reLoc $>) (IEModuleContents (EpAnn (glR $1) [mj AnnModule $1] cs) $2))) }
         |  'pattern' qcon            { unitOL (reLocA (sLL $1 (reLocN $>)
                                               (IEVar noExtField (sLLa $1 (reLocN $>) (IEPattern (glAA $1) $2))))) }
 
@@ -1105,7 +1105,7 @@ importdecl :: { LImportDecl GhcPs }
                              , importDeclAnnPackage   = fst $5
                              , importDeclAnnAs        = fst $8
                              }
-                  ; fmap reLocA $ acs (\cs -> L (comb5 $1 $6 $7 (snd $8) $9) $
+                  ; fmap reLocA $ acs (\cs -> L (comb5 $1 (reLoc $6) $7 (snd $8) $9) $
                       ImportDecl { ideclExt = EpAnn (glR $1) anns cs
                                   , ideclSourceSrc = snd $ fst $2
                                   , ideclName = $6, ideclPkgQual = snd $5
@@ -1139,9 +1139,9 @@ optqualified :: { Located (Maybe EpaLocation) }
         : 'qualified'                           { sL1 $1 (Just (glAA $1)) }
         | {- empty -}                           { noLoc Nothing }
 
-maybeas :: { (Maybe EpaLocation,Located (Maybe (Located ModuleName))) }
+maybeas :: { (Maybe EpaLocation,Located (Maybe (LocatedA ModuleName))) }
         : 'as' modid                           { (Just (glAA $1)
-                                                 ,sLL $1 $> (Just $2)) }
+                                                 ,sLL $1 (reLoc $>) (Just $2)) }
         | {- empty -}                          { (Nothing,noLoc Nothing) }
 
 maybeimpspec :: { Located (Maybe (Bool, LocatedL [LIE GhcPs])) }
@@ -3847,9 +3847,9 @@ close :: { () }
 -----------------------------------------------------------------------------
 -- Miscellaneous (mostly renamings)
 
-modid   :: { Located ModuleName }
-        : CONID                 { sL1 $1 $ mkModuleNameFS (getCONID $1) }
-        | QCONID                { sL1 $1 $ let (mod,c) = getQCONID $1 in
+modid   :: { LocatedA ModuleName }
+        : CONID                 { sL1a $1 $ mkModuleNameFS (getCONID $1) }
+        | QCONID                { sL1a $1 $ let (mod,c) = getQCONID $1 in
                                   mkModuleNameFS
                                    (mkFastString
                                      (unpackFS mod ++ '.':unpackFS c))
diff --git a/compiler/GHC/Parser/Header.hs b/compiler/GHC/Parser/Header.hs
index c19c873c91..cb8a5c334e 100644
--- a/compiler/GHC/Parser/Header.hs
+++ b/compiler/GHC/Parser/Header.hs
@@ -97,7 +97,7 @@ getImports popts implicit_prelude buf filename source_filename = do
                 imps = hsmodImports hsmod
                 main_loc = srcLocSpan (mkSrcLoc (mkFastString source_filename)
                                        1 1)
-                mod = mb_mod `orElse` L main_loc mAIN_NAME
+                mod = mb_mod `orElse` L (noAnnSrcSpan main_loc) mAIN_NAME
                 (src_idecls, ord_idecls) = partition ((== IsBoot) . ideclSource . unLoc) imps
 
                -- GHC.Prim doesn't exist physically, so don't go looking for it.
@@ -108,12 +108,12 @@ getImports popts implicit_prelude buf filename source_filename = do
 
                 implicit_imports = mkPrelImports (unLoc mod) main_loc
                                                  implicit_prelude imps
-                convImport (L _ i) = (ideclPkgQual i, ideclName i)
+                convImport (L _ i) = (ideclPkgQual i, reLoc $ ideclName i)
               in
               return (map convImport src_idecls
                      , map convImport (implicit_imports ++ ordinary_imps)
                      , not (null ghc_prim_import)
-                     , mod)
+                     , reLoc mod)
 
 mkPrelImports :: ModuleName
               -> SrcSpan    -- Attribute the "import Prelude" to this location
@@ -146,7 +146,7 @@ mkPrelImports this_mod loc implicit_prelude import_decls
       preludeImportDecl
         = L loc' $ ImportDecl { ideclExt       = noAnn,
                                 ideclSourceSrc = NoSourceText,
-                                ideclName      = L loc pRELUDE_NAME,
+                                ideclName      = L loc' pRELUDE_NAME,
                                 ideclPkgQual   = NoRawPkgQual,
                                 ideclSource    = NotBoot,
                                 ideclSafe      = False,  -- Not a safe import
diff --git a/compiler/GHC/Parser/PostProcess/Haddock.hs b/compiler/GHC/Parser/PostProcess/Haddock.hs
index 5cb81edcdb..f0adba4e6f 100644
--- a/compiler/GHC/Parser/PostProcess/Haddock.hs
+++ b/compiler/GHC/Parser/PostProcess/Haddock.hs
@@ -249,10 +249,10 @@ instance HasHaddock (Located HsModule) where
     -- Only do this when the module header exists.
     headerDocs <-
       for @Maybe (hsmodName mod) $ \(L l_name _) ->
-      extendHdkA l_name $ liftHdkA $ do
+      extendHdkA (locA l_name) $ liftHdkA $ do
         -- todo: register keyword location of 'module', see Note [Register keyword location]
         docs <-
-          inLocRange (locRangeTo (getBufPos (srcSpanStart l_name))) $
+          inLocRange (locRangeTo (getBufPos (srcSpanStart (locA l_name)))) $
           takeHdkComments mkDocNext
         selectDocString docs
 
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index f4fa104f1e..67350973b5 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -606,7 +606,7 @@ warnUnqualifiedImport decl iface =
       addDiagnosticAt loc msg
   where
     mod = mi_module iface
-    loc = getLoc $ ideclName decl
+    loc = getLocA $ ideclName decl
 
     is_qual = isImportDeclQualified (ideclQualified decl)
     has_import_list =
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index 2c425e6eda..cb71508227 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -223,7 +223,7 @@ tcRnModule hsc_env mod_sum save_rn_syntax
     pair :: (Module, SrcSpan)
     pair@(this_mod,_)
       | Just (L mod_loc mod) <- hsmodName this_module
-      = (mkHomeModule home_unit mod, mod_loc)
+      = (mkHomeModule home_unit mod, locA mod_loc)
 
       | otherwise   -- 'module M where' is omitted
       = (mkHomeModule home_unit mAIN_NAME, srcLocSpan (srcSpanStart loc))
@@ -271,7 +271,7 @@ tcRnModuleTcRnM hsc_env mod_sum
         ; -- TODO This is a little skeevy; maybe handle a bit more directly
           let { simplifyImport (L _ idecl) =
                   ( renameRawPkgQual (hsc_unit_env hsc_env) (ideclPkgQual idecl)
-                  , ideclName idecl)
+                  , reLoc $ ideclName idecl)
               }
         ; raw_sig_imports <- liftIO
                              $ findExtraSigImports hsc_env hsc_src