X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2FbasicTypes%2FName.lhs;h=615363723ccc9573d0e2d78369959c05e6cfa727;hb=HEAD;hp=f2ae963891b9f114302306c508e7201fdfdcd937;hpb=93b6e53272695a66d97bd2672dd366797176d5c5;p=ghc-hetmet.git diff --git a/compiler/basicTypes/Name.lhs b/compiler/basicTypes/Name.lhs index f2ae963..6153637 100644 --- a/compiler/basicTypes/Name.lhs +++ b/compiler/basicTypes/Name.lhs @@ -64,6 +64,7 @@ module Name ( getSrcLoc, getSrcSpan, getOccString, pprInfixName, pprPrefixName, pprModulePrefix, + getNameDepth, setNameDepth, -- Re-export the OccName stuff module OccName @@ -112,6 +113,12 @@ data Name = Name { -- (and real!) space leaks, due to the fact that we don't look at -- the SrcLoc in a Name all that often. +setNameDepth :: Int -> Name -> Name +setNameDepth depth name = name { n_occ = setOccNameDepth depth (n_occ name) } + +getNameDepth :: Name -> Int +getNameDepth name = getOccNameDepth $ n_occ name + data NameSort = External Module @@ -480,12 +487,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} %************************************************************************