X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FName.lhs;h=a2b42a278eb153468268c1cdc97ffe6130480b21;hp=f0cb443de184128883d645c54e4b94403a4e8645;hb=0b4324456e472d15a3a124f56387486f71cb765d;hpb=f278f0676579f67075033a4f9857715909c4b71e diff --git a/compiler/basicTypes/Name.lhs b/compiler/basicTypes/Name.lhs index f0cb443..a2b42a2 100644 --- a/compiler/basicTypes/Name.lhs +++ b/compiler/basicTypes/Name.lhs @@ -106,6 +106,7 @@ data Name = Name { --(note later when changing Int# -> FastInt: is that still true about UNPACK?) n_loc :: !SrcSpan -- Definition site } + deriving Typeable -- NOTE: we make the n_loc field strict to eliminate some potential -- (and real!) space leaks, due to the fact that we don't look at @@ -280,7 +281,7 @@ mkSystemVarName :: Unique -> FastString -> Name mkSystemVarName uniq fs = mkSystemName uniq (mkVarOccFS fs) mkSysTvName :: Unique -> FastString -> Name -mkSysTvName uniq fs = mkSystemName uniq (mkOccNameFS tvName fs) +mkSysTvName uniq fs = mkSystemName uniq (mkOccNameFS tvName fs) -- | Make a name for a foreign call mkFCallName :: Unique -> String -> Name @@ -363,8 +364,6 @@ instance Uniquable Name where instance NamedThing Name where getName n = n -INSTANCE_TYPEABLE0(Name,nameTc,"Name") - instance Data Name where -- don't traverse? toConstr _ = abstractConstr "Name" @@ -451,6 +450,9 @@ pprModulePrefix :: PprStyle -> Module -> OccName -> SDoc -- Print the "M." part of a name, based on whether it's in scope or not -- See Note [Printing original names] in HscTypes pprModulePrefix sty mod occ + | opt_SuppressModulePrefixes = empty + + | otherwise = case qualName sty mod occ of -- See Outputable.QualifyName: NameQual modname -> ppr modname <> dot -- Name is in scope NameNotInScope1 -> ppr mod <> dot -- Not in scope @@ -478,12 +480,14 @@ ppr_z_occ_name occ = ftext (zEncodeFS (occNameFS occ)) -- Prints (if mod information is available) "Defined at " or -- "Defined in " information for a Name. pprNameLoc :: Name -> SDoc -pprNameLoc name - | isGoodSrcSpan loc = pprDefnLoc loc - | isInternalName name || isSystemName name - = ptext (sLit "") - | otherwise = ptext (sLit "Defined in ") <> ppr (nameModule name) - where loc = nameSrcSpan name +pprNameLoc name = case nameSrcSpan name of + RealSrcSpan s -> + pprDefnLoc s + UnhelpfulSpan _ + | isInternalName name || isSystemName name -> + ptext (sLit "") + | otherwise -> + ptext (sLit "Defined in ") <> ppr (nameModule name) \end{code} %************************************************************************