X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FName.lhs;h=e2f272370b5b3a0c612d40c1f9744e36b528c72f;hb=591f4528375b0a049de6c15fe6d4ab476362f448;hp=6fccb7f6caa5b6b65221b7f1b396cfd57d7e1beb;hpb=ad94d40948668032189ad22a0ad741ac1f645f50;p=ghc-hetmet.git diff --git a/compiler/basicTypes/Name.lhs b/compiler/basicTypes/Name.lhs index 6fccb7f..e2f2723 100644 --- a/compiler/basicTypes/Name.lhs +++ b/compiler/basicTypes/Name.lhs @@ -9,7 +9,7 @@ -- The above warning supression flag is a temporary kludge. -- While working on this module you are encouraged to remove it and fix -- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings -- for details module Name ( @@ -30,7 +30,7 @@ module Name ( tidyNameOcc, hashName, localiseName, - nameSrcLoc, nameSrcSpan, + nameSrcLoc, nameSrcSpan, pprNameLoc, isSystemName, isInternalName, isExternalName, isTyVarName, isTyConName, isWiredInName, isBuiltInSyntax, @@ -367,9 +367,13 @@ pprExternal sty uniq mod occ is_wired is_builtin pprUnique uniq]) | BuiltInSyntax <- is_builtin = ppr_occ_name occ -- never qualify builtin syntax - | Just mod <- qualName sty mod occ = ppr mod <> dot <> ppr_occ_name occ - -- the PrintUnqualified tells us how to qualify this Name, if at all + | NameQual modname <- qual_name = ppr modname <> dot <> ppr_occ_name occ + -- see HscTypes.mkPrintUnqualified and Outputable.QualifyName: + | NameNotInScope1 <- qual_name = ppr mod <> dot <> ppr_occ_name occ + | NameNotInScope2 <- qual_name = ppr (modulePackageId mod) <> char ':' <> + ppr (moduleName mod) <> dot <> ppr_occ_name occ | otherwise = ppr_occ_name occ + where qual_name = qualName sty mod occ pprInternal sty uniq occ | codeStyle sty = pprUnique uniq @@ -397,6 +401,13 @@ ppr_occ_name occ = ftext (occNameFS occ) -- In code style, we Z-encode the strings. The results of Z-encoding each FastString are -- cached behind the scenes in the FastString implementation. ppr_z_occ_name occ = ftext (zEncodeFS (occNameFS occ)) + +-- Prints "Defined at " or "Defined in " information for a Name. +pprNameLoc :: Name -> SDoc +pprNameLoc name + | isGoodSrcSpan loc = pprDefnLoc loc + | otherwise = ptext SLIT("Defined in ") <> ppr (nameModule name) + where loc = nameSrcSpan name \end{code} %************************************************************************