module RdrName (
RdrName(..),
mkRdrUnqual, mkRdrQual,
mkUnqual, mkVarUnqual, mkQual, mkOrig,
nameRdrName, getRdrName,
rdrNameOcc, rdrNameSpace, setRdrNameSpace, demoteRdrName,
isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isQual_maybe, isUnqual,
isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName,
LocalRdrEnv, emptyLocalRdrEnv, extendLocalRdrEnv, extendLocalRdrEnvList,
lookupLocalRdrEnv, lookupLocalRdrOcc,
elemLocalRdrEnv, inLocalRdrEnvScope,
localRdrEnvElts, delLocalRdrEnvList,
GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv,
lookupGlobalRdrEnv, extendGlobalRdrEnv,
pprGlobalRdrEnv, globalRdrEnvElts,
lookupGRE_RdrName, lookupGRE_Name, getGRE_NameQualifier_maybes,
transformGREs, findLocalDupsRdrEnv, pickGREs,
gresFromAvails, gresFromAvail,
GlobalRdrElt(..), isLocalGRE, unQualOK, qualSpecOK, unQualSpecOK,
Provenance(..), pprNameProvenance,
Parent(..),
ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..),
importSpecLoc, importSpecModule, isExplicitItem
) where
#include "HsVersions.h"
import Module
import Name
import Avail
import NameSet
import Maybes
import SrcLoc
import FastString
import Outputable
import Unique
import Util
import StaticFlags( opt_PprStyle_Debug )
import Data.Data
data RdrName
= Unqual OccName
| Qual ModuleName OccName
| Orig Module OccName
| Exact Name
deriving (Data, Typeable)
instance HasOccName RdrName where
occName = rdrNameOcc
rdrNameOcc :: RdrName -> OccName
rdrNameOcc (Qual _ occ) = occ
rdrNameOcc (Unqual occ) = occ
rdrNameOcc (Orig _ occ) = occ
rdrNameOcc (Exact name) = nameOccName name
rdrNameSpace :: RdrName -> NameSpace
rdrNameSpace = occNameSpace . rdrNameOcc
setRdrNameSpace :: RdrName -> NameSpace -> RdrName
setRdrNameSpace (Unqual occ) ns = Unqual (setOccNameSpace ns occ)
setRdrNameSpace (Qual m occ) ns = Qual m (setOccNameSpace ns occ)
setRdrNameSpace (Orig m occ) ns = Orig m (setOccNameSpace ns occ)
setRdrNameSpace (Exact n) ns
| isExternalName n
= Orig (nameModule n) occ
| otherwise
= Exact $ mkSystemNameAt (nameUnique n) occ (nameSrcSpan n)
where
occ = setOccNameSpace ns (nameOccName n)
demoteRdrName :: RdrName -> Maybe RdrName
demoteRdrName (Unqual occ) = fmap Unqual (demoteOccName occ)
demoteRdrName (Qual m occ) = fmap (Qual m) (demoteOccName occ)
demoteRdrName (Orig _ _) = panic "demoteRdrName"
demoteRdrName (Exact _) = panic "demoteRdrName"
mkRdrUnqual :: OccName -> RdrName
mkRdrUnqual occ = Unqual occ
mkRdrQual :: ModuleName -> OccName -> RdrName
mkRdrQual mod occ = Qual mod occ
mkOrig :: Module -> OccName -> RdrName
mkOrig mod occ = Orig mod occ
mkUnqual :: NameSpace -> FastString -> RdrName
mkUnqual sp n = Unqual (mkOccNameFS sp n)
mkVarUnqual :: FastString -> RdrName
mkVarUnqual n = Unqual (mkVarOccFS n)
mkQual :: NameSpace -> (FastString, FastString) -> RdrName
mkQual sp (m, n) = Qual (mkModuleNameFS m) (mkOccNameFS sp n)
getRdrName :: NamedThing thing => thing -> RdrName
getRdrName name = nameRdrName (getName name)
nameRdrName :: Name -> RdrName
nameRdrName name = Exact name
nukeExact :: Name -> RdrName
nukeExact n
| isExternalName n = Orig (nameModule n) (nameOccName n)
| otherwise = Unqual (nameOccName n)
isRdrDataCon :: RdrName -> Bool
isRdrTyVar :: RdrName -> Bool
isRdrTc :: RdrName -> Bool
isRdrDataCon rn = isDataOcc (rdrNameOcc rn)
isRdrTyVar rn = isTvOcc (rdrNameOcc rn)
isRdrTc rn = isTcOcc (rdrNameOcc rn)
isSrcRdrName :: RdrName -> Bool
isSrcRdrName (Unqual _) = True
isSrcRdrName (Qual _ _) = True
isSrcRdrName _ = False
isUnqual :: RdrName -> Bool
isUnqual (Unqual _) = True
isUnqual _ = False
isQual :: RdrName -> Bool
isQual (Qual _ _) = True
isQual _ = False
isQual_maybe :: RdrName -> Maybe (ModuleName, OccName)
isQual_maybe (Qual m n) = Just (m,n)
isQual_maybe _ = Nothing
isOrig :: RdrName -> Bool
isOrig (Orig _ _) = True
isOrig _ = False
isOrig_maybe :: RdrName -> Maybe (Module, OccName)
isOrig_maybe (Orig m n) = Just (m,n)
isOrig_maybe _ = Nothing
isExact :: RdrName -> Bool
isExact (Exact _) = True
isExact _ = False
isExact_maybe :: RdrName -> Maybe Name
isExact_maybe (Exact n) = Just n
isExact_maybe _ = Nothing
instance Outputable RdrName where
ppr (Exact name) = ppr name
ppr (Unqual occ) = ppr occ
ppr (Qual mod occ) = ppr mod <> dot <> ppr occ
ppr (Orig mod occ) = getPprStyle (\sty -> pprModulePrefix sty mod occ <> ppr occ)
instance OutputableBndr RdrName where
pprBndr _ n
| isTvOcc (rdrNameOcc n) = char '@' <+> ppr n
| otherwise = ppr n
pprInfixOcc rdr = pprInfixVar (isSymOcc (rdrNameOcc rdr)) (ppr rdr)
pprPrefixOcc rdr
| Just name <- isExact_maybe rdr = pprPrefixName name
| otherwise = pprPrefixVar (isSymOcc (rdrNameOcc rdr)) (ppr rdr)
instance Eq RdrName where
(Exact n1) == (Exact n2) = n1==n2
(Exact n1) == r2@(Orig _ _) = nukeExact n1 == r2
r1@(Orig _ _) == (Exact n2) = r1 == nukeExact n2
(Orig m1 o1) == (Orig m2 o2) = m1==m2 && o1==o2
(Qual m1 o1) == (Qual m2 o2) = m1==m2 && o1==o2
(Unqual o1) == (Unqual o2) = o1==o2
_ == _ = False
instance Ord RdrName where
a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
compare (Exact n1) (Exact n2) = n1 `compare` n2
compare (Exact _) _ = LT
compare (Unqual _) (Exact _) = GT
compare (Unqual o1) (Unqual o2) = o1 `compare` o2
compare (Unqual _) _ = LT
compare (Qual _ _) (Exact _) = GT
compare (Qual _ _) (Unqual _) = GT
compare (Qual m1 o1) (Qual m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2)
compare (Qual _ _) (Orig _ _) = LT
compare (Orig m1 o1) (Orig m2 o2) = (o1 `compare` o2) `thenCmp` (m1 `compare` m2)
compare (Orig _ _) _ = GT
data LocalRdrEnv = LRE { lre_env :: OccEnv Name
, lre_in_scope :: NameSet }
instance Outputable LocalRdrEnv where
ppr (LRE {lre_env = env, lre_in_scope = ns})
= hang (ptext (sLit "LocalRdrEnv {"))
2 (vcat [ ptext (sLit "env =") <+> pprOccEnv ppr_elt env
, ptext (sLit "in_scope =") <+> braces (pprWithCommas ppr (nameSetElems ns))
] <+> char '}')
where
ppr_elt name = parens (ppr (getUnique (nameOccName name))) <+> ppr name
emptyLocalRdrEnv :: LocalRdrEnv
emptyLocalRdrEnv = LRE { lre_env = emptyOccEnv, lre_in_scope = emptyNameSet }
extendLocalRdrEnv :: LocalRdrEnv -> Name -> LocalRdrEnv
extendLocalRdrEnv (LRE { lre_env = env, lre_in_scope = ns }) name
= WARN( isExternalName name, ppr name )
LRE { lre_env = extendOccEnv env (nameOccName name) name
, lre_in_scope = extendNameSet ns name }
extendLocalRdrEnvList :: LocalRdrEnv -> [Name] -> LocalRdrEnv
extendLocalRdrEnvList (LRE { lre_env = env, lre_in_scope = ns }) names
= WARN( any isExternalName names, ppr names )
LRE { lre_env = extendOccEnvList env [(nameOccName n, n) | n <- names]
, lre_in_scope = extendNameSetList ns names }
lookupLocalRdrEnv :: LocalRdrEnv -> RdrName -> Maybe Name
lookupLocalRdrEnv (LRE { lre_env = env }) (Unqual occ) = lookupOccEnv env occ
lookupLocalRdrEnv _ _ = Nothing
lookupLocalRdrOcc :: LocalRdrEnv -> OccName -> Maybe Name
lookupLocalRdrOcc (LRE { lre_env = env }) occ = lookupOccEnv env occ
elemLocalRdrEnv :: RdrName -> LocalRdrEnv -> Bool
elemLocalRdrEnv rdr_name (LRE { lre_env = env, lre_in_scope = ns })
= case rdr_name of
Unqual occ -> occ `elemOccEnv` env
Exact name -> name `elemNameSet` ns
Qual {} -> False
Orig {} -> False
localRdrEnvElts :: LocalRdrEnv -> [Name]
localRdrEnvElts (LRE { lre_env = env }) = occEnvElts env
inLocalRdrEnvScope :: Name -> LocalRdrEnv -> Bool
inLocalRdrEnvScope name (LRE { lre_in_scope = ns }) = name `elemNameSet` ns
delLocalRdrEnvList :: LocalRdrEnv -> [OccName] -> LocalRdrEnv
delLocalRdrEnvList (LRE { lre_env = env, lre_in_scope = ns }) occs
= LRE { lre_env = delListFromOccEnv env occs
, lre_in_scope = ns }
type GlobalRdrEnv = OccEnv [GlobalRdrElt]
data GlobalRdrElt
= GRE { gre_name :: Name,
gre_par :: Parent,
gre_prov :: Provenance
}
data Parent = NoParent | ParentIs Name
deriving (Eq)
instance Outputable Parent where
ppr NoParent = empty
ppr (ParentIs n) = ptext (sLit "parent:") <> ppr n
plusParent :: Parent -> Parent -> Parent
plusParent (ParentIs n) p2 = hasParent n p2
plusParent p1 (ParentIs n) = hasParent n p1
plusParent _ _ = NoParent
hasParent :: Name -> Parent -> Parent
#ifdef DEBUG
hasParent n (ParentIs n')
| n /= n' = pprPanic "hasParent" (ppr n <+> ppr n')
#endif
hasParent n _ = ParentIs n
gresFromAvails :: Provenance -> [AvailInfo] -> [GlobalRdrElt]
gresFromAvails prov avails
= concatMap (gresFromAvail (const prov)) avails
gresFromAvail :: (Name -> Provenance) -> AvailInfo -> [GlobalRdrElt]
gresFromAvail prov_fn avail
= [ GRE {gre_name = n,
gre_par = mkParent n avail,
gre_prov = prov_fn n}
| n <- availNames avail ]
where
mkParent :: Name -> AvailInfo -> Parent
mkParent _ (Avail _) = NoParent
mkParent n (AvailTC m _) | n == m = NoParent
| otherwise = ParentIs m
emptyGlobalRdrEnv :: GlobalRdrEnv
emptyGlobalRdrEnv = emptyOccEnv
globalRdrEnvElts :: GlobalRdrEnv -> [GlobalRdrElt]
globalRdrEnvElts env = foldOccEnv (++) [] env
instance Outputable GlobalRdrElt where
ppr gre = hang (ppr (gre_name gre) <+> ppr (gre_par gre))
2 (pprNameProvenance gre)
pprGlobalRdrEnv :: Bool -> GlobalRdrEnv -> SDoc
pprGlobalRdrEnv locals_only env
= vcat [ ptext (sLit "GlobalRdrEnv") <+> ppWhen locals_only (ptext (sLit "(locals only)"))
<+> lbrace
, nest 2 (vcat [ pp (remove_locals gre_list) | gre_list <- occEnvElts env ]
<+> rbrace) ]
where
remove_locals gres | locals_only = filter isLocalGRE gres
| otherwise = gres
pp [] = empty
pp gres = hang (ppr occ
<+> parens (ptext (sLit "unique") <+> ppr (getUnique occ))
<> colon)
2 (vcat (map ppr gres))
where
occ = nameOccName (gre_name (head gres))
lookupGlobalRdrEnv :: GlobalRdrEnv -> OccName -> [GlobalRdrElt]
lookupGlobalRdrEnv env occ_name = case lookupOccEnv env occ_name of
Nothing -> []
Just gres -> gres
lookupGRE_RdrName :: RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
lookupGRE_RdrName rdr_name env
= case lookupOccEnv env (rdrNameOcc rdr_name) of
Nothing -> []
Just gres -> pickGREs rdr_name gres
lookupGRE_Name :: GlobalRdrEnv -> Name -> [GlobalRdrElt]
lookupGRE_Name env name
= [ gre | gre <- lookupGlobalRdrEnv env (nameOccName name),
gre_name gre == name ]
getGRE_NameQualifier_maybes :: GlobalRdrEnv -> Name -> [Maybe [ModuleName]]
getGRE_NameQualifier_maybes env
= map (qualifier_maybe . gre_prov) . lookupGRE_Name env
where
qualifier_maybe LocalDef = Nothing
qualifier_maybe (Imported iss) = Just $ map (is_as . is_decl) iss
isLocalGRE :: GlobalRdrElt -> Bool
isLocalGRE (GRE {gre_prov = LocalDef}) = True
isLocalGRE _ = False
unQualOK :: GlobalRdrElt -> Bool
unQualOK (GRE {gre_prov = LocalDef}) = True
unQualOK (GRE {gre_prov = Imported is}) = any unQualSpecOK is
pickGREs :: RdrName -> [GlobalRdrElt] -> [GlobalRdrElt]
pickGREs rdr_name gres
| (_ : _ : _) <- candidates
, (gre : _) <- internal_candidates
= [gre]
| otherwise
= ASSERT2( isSrcRdrName rdr_name, ppr rdr_name )
candidates
where
candidates = mapMaybe pick gres
internal_candidates = filter (isInternalName . gre_name) candidates
rdr_is_unqual = isUnqual rdr_name
rdr_is_qual = isQual_maybe rdr_name
pick :: GlobalRdrElt -> Maybe GlobalRdrElt
pick gre@(GRE {gre_prov = LocalDef, gre_name = n})
| rdr_is_unqual = Just gre
| Just (mod,_) <- rdr_is_qual
, Just n_mod <- nameModule_maybe n
, mod == moduleName n_mod = Just gre
| otherwise = Nothing
pick gre@(GRE {gre_prov = Imported [is]})
| rdr_is_unqual,
not (is_qual (is_decl is)) = Just gre
| Just (mod,_) <- rdr_is_qual,
mod == is_as (is_decl is) = Just gre
| otherwise = Nothing
pick gre@(GRE {gre_prov = Imported is})
| null filtered_is = Nothing
| otherwise = Just (gre {gre_prov = Imported filtered_is})
where
filtered_is | rdr_is_unqual
= filter (not . is_qual . is_decl) is
| Just (mod,_) <- rdr_is_qual
= filter ((== mod) . is_as . is_decl) is
| otherwise
= []
plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
plusGlobalRdrEnv env1 env2 = plusOccEnv_C (foldr insertGRE) env1 env2
mkGlobalRdrEnv :: [GlobalRdrElt] -> GlobalRdrEnv
mkGlobalRdrEnv gres
= foldr add emptyGlobalRdrEnv gres
where
add gre env = extendOccEnv_Acc insertGRE singleton env
(nameOccName (gre_name gre))
gre
insertGRE :: GlobalRdrElt -> [GlobalRdrElt] -> [GlobalRdrElt]
insertGRE new_g [] = [new_g]
insertGRE new_g (old_g : old_gs)
| gre_name new_g == gre_name old_g
= new_g `plusGRE` old_g : old_gs
| otherwise
= old_g : insertGRE new_g old_gs
plusGRE :: GlobalRdrElt -> GlobalRdrElt -> GlobalRdrElt
plusGRE g1 g2
= GRE { gre_name = gre_name g1,
gre_prov = gre_prov g1 `plusProv` gre_prov g2,
gre_par = gre_par g1 `plusParent` gre_par g2 }
transformGREs :: (GlobalRdrElt -> GlobalRdrElt)
-> [OccName]
-> GlobalRdrEnv -> GlobalRdrEnv
transformGREs trans_gre occs rdr_env
= foldr trans rdr_env occs
where
trans occ env
= case lookupOccEnv env occ of
Just gres -> extendOccEnv env occ (map trans_gre gres)
Nothing -> env
extendGlobalRdrEnv :: Bool -> GlobalRdrEnv -> [AvailInfo] -> GlobalRdrEnv
extendGlobalRdrEnv do_shadowing env avails
= foldl add_avail env1 avails
where
names = concatMap availNames avails
env1 | do_shadowing = foldl shadow_name env names
| otherwise = env
add_avail env avail = foldl (add_name avail) env (availNames avail)
add_name avail env name
= extendOccEnv_Acc (:) singleton env occ gre
where
occ = nameOccName name
gre = GRE { gre_name = name
, gre_par = mkParent name avail
, gre_prov = LocalDef }
shadow_name :: GlobalRdrEnv -> Name -> GlobalRdrEnv
shadow_name env name
= alterOccEnv (fmap alter_fn) env (nameOccName name)
where
alter_fn :: [GlobalRdrElt] -> [GlobalRdrElt]
alter_fn gres = mapMaybe (shadow_with name) gres
shadow_with :: Name -> GlobalRdrElt -> Maybe GlobalRdrElt
shadow_with new_name old_gre@(GRE { gre_name = old_name, gre_prov = LocalDef })
= case (nameModule_maybe old_name, nameModule_maybe new_name) of
(Nothing, _) -> Nothing
(Just old_mod, Just new_mod) | new_mod == old_mod -> Nothing
(Just old_mod, _) -> Just (old_gre { gre_prov = Imported [fake_imp_spec] })
where
fake_imp_spec = ImpSpec id_spec ImpAll
old_mod_name = moduleName old_mod
id_spec = ImpDeclSpec { is_mod = old_mod_name
, is_as = old_mod_name
, is_qual = True
, is_dloc = nameSrcSpan old_name }
shadow_with new_name old_gre@(GRE { gre_prov = Imported imp_specs })
| null imp_specs' = Nothing
| otherwise = Just (old_gre { gre_prov = Imported imp_specs' })
where
imp_specs' = mapMaybe (shadow_is new_name) imp_specs
shadow_is :: Name -> ImportSpec -> Maybe ImportSpec
shadow_is new_name is@(ImpSpec { is_decl = id_spec })
| Just new_mod <- nameModule_maybe new_name
, is_as id_spec == moduleName new_mod
= Nothing
| otherwise
= Just (is { is_decl = id_spec { is_qual = True } })
findLocalDupsRdrEnv :: GlobalRdrEnv -> [Name] -> [[GlobalRdrElt]]
findLocalDupsRdrEnv rdr_env occs
= go rdr_env [] occs
where
go _ dups [] = dups
go rdr_env dups (name:names)
= case filter (pick name) gres of
[] -> go rdr_env dups names
[_] -> go rdr_env dups names
dup_gres -> go rdr_env' (dup_gres : dups) names
where
occ = nameOccName name
gres = lookupOccEnv rdr_env occ `orElse` []
rdr_env' = delFromOccEnv rdr_env occ
pick name (GRE { gre_name = n, gre_prov = LocalDef })
| isInternalName name = isInternalName n
| otherwise = True
pick _ _ = False
data Provenance
= LocalDef
| Imported
[ImportSpec]
data ImportSpec = ImpSpec { is_decl :: ImpDeclSpec,
is_item :: ImpItemSpec }
deriving( Eq, Ord )
data ImpDeclSpec
= ImpDeclSpec {
is_mod :: ModuleName,
is_as :: ModuleName,
is_qual :: Bool,
is_dloc :: SrcSpan
}
data ImpItemSpec
= ImpAll
| ImpSome {
is_explicit :: Bool,
is_iloc :: SrcSpan
}
unQualSpecOK :: ImportSpec -> Bool
unQualSpecOK is = not (is_qual (is_decl is))
qualSpecOK :: ModuleName -> ImportSpec -> Bool
qualSpecOK mod is = mod == is_as (is_decl is)
importSpecLoc :: ImportSpec -> SrcSpan
importSpecLoc (ImpSpec decl ImpAll) = is_dloc decl
importSpecLoc (ImpSpec _ item) = is_iloc item
importSpecModule :: ImportSpec -> ModuleName
importSpecModule is = is_mod (is_decl is)
isExplicitItem :: ImpItemSpec -> Bool
isExplicitItem ImpAll = False
isExplicitItem (ImpSome {is_explicit = exp}) = exp
instance Eq Provenance where
p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
instance Eq ImpDeclSpec where
p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
instance Eq ImpItemSpec where
p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
instance Ord Provenance where
compare LocalDef LocalDef = EQ
compare LocalDef (Imported _) = LT
compare (Imported _ ) LocalDef = GT
compare (Imported is1) (Imported is2) = compare (head is1)
(head is2)
instance Ord ImpDeclSpec where
compare is1 is2 = (is_mod is1 `compare` is_mod is2) `thenCmp`
(is_dloc is1 `compare` is_dloc is2)
instance Ord ImpItemSpec where
compare is1 is2 = is_iloc is1 `compare` is_iloc is2
plusProv :: Provenance -> Provenance -> Provenance
plusProv LocalDef LocalDef = panic "plusProv"
plusProv LocalDef _ = LocalDef
plusProv _ LocalDef = LocalDef
plusProv (Imported is1) (Imported is2) = Imported (is1++is2)
pprNameProvenance :: GlobalRdrElt -> SDoc
pprNameProvenance (GRE {gre_name = name, gre_prov = LocalDef})
= ptext (sLit "defined at") <+> ppr (nameSrcLoc name)
pprNameProvenance (GRE {gre_name = name, gre_prov = Imported whys})
= case whys of
(why:_) | opt_PprStyle_Debug -> vcat (map pp_why whys)
| otherwise -> pp_why why
[] -> panic "pprNameProvenance"
where
pp_why why = sep [ppr why, ppr_defn_site why name]
ppr_defn_site :: ImportSpec -> Name -> SDoc
ppr_defn_site imp_spec name
| same_module && not (isGoodSrcSpan loc)
= empty
| otherwise
= parens $ hang (ptext (sLit "and originally defined") <+> pp_mod)
2 (pprLoc loc)
where
loc = nameSrcSpan name
defining_mod = nameModule name
same_module = importSpecModule imp_spec == moduleName defining_mod
pp_mod | same_module = empty
| otherwise = ptext (sLit "in") <+> quotes (ppr defining_mod)
instance Outputable ImportSpec where
ppr imp_spec
= ptext (sLit "imported") <+> qual
<+> ptext (sLit "from") <+> quotes (ppr (importSpecModule imp_spec))
<+> pprLoc (importSpecLoc imp_spec)
where
qual | is_qual (is_decl imp_spec) = ptext (sLit "qualified")
| otherwise = empty
pprLoc :: SrcSpan -> SDoc
pprLoc (RealSrcSpan s) = ptext (sLit "at") <+> ppr s
pprLoc (UnhelpfulSpan {}) = empty