-instance NamedThing Name where
- getExportFlag (Short _ _) = NotExported
- getExportFlag (WiredInTyCon _) = NotExported -- compiler always know about these
- getExportFlag (WiredInVal _) = NotExported
- getExportFlag (ClassOpName _ c _ _) = getExportFlag c
- getExportFlag other = getExportFlag (get_nm "getExportFlag" other)
-
- isLocallyDefined (Short _ _) = True
- isLocallyDefined (WiredInTyCon _) = False
- isLocallyDefined (WiredInVal _) = False
- isLocallyDefined (ClassOpName _ c _ _) = isLocallyDefined c
- isLocallyDefined other = isLocallyDefined (get_nm "isLocallyDefined" other)
-
- getOrigName (Short _ sn) = getOrigName sn
- getOrigName (WiredInTyCon tc) = getOrigName tc
- getOrigName (WiredInVal id) = getOrigName id
- getOrigName (ClassOpName _ c op _) = (fst (getOrigName c), op)
- getOrigName other = getOrigName (get_nm "getOrigName" other)
-
- getOccurrenceName (Short _ sn) = getOccurrenceName sn
- getOccurrenceName (WiredInTyCon tc) = getOccurrenceName tc
- getOccurrenceName (WiredInVal id) = getOccurrenceName id
- getOccurrenceName (ClassOpName _ _ op _) = op
- getOccurrenceName (Unbound s) = s _APPEND_ SLIT("<unbound>")
- getOccurrenceName other = getOccurrenceName (get_nm "getOccurrenceName" other)
-
- getInformingModules thing = panic "getInformingModule:Name"
-
- getSrcLoc (Short _ sn) = getSrcLoc sn
- getSrcLoc (WiredInTyCon tc) = mkBuiltinSrcLoc
- getSrcLoc (WiredInVal id) = mkBuiltinSrcLoc
- getSrcLoc (ClassOpName _ c _ _) = getSrcLoc c
- getSrcLoc (Unbound _) = mkUnknownSrcLoc
- getSrcLoc other = getSrcLoc (get_nm "getSrcLoc" other)
-
- getItsUnique (Short u _) = u
- getItsUnique (WiredInTyCon t) = getItsUnique t
- getItsUnique (WiredInVal i) = getItsUnique i
- getItsUnique (TyConName u _ _ _ _) = u
- getItsUnique (ClassName u _ _) = u
- getItsUnique (ValName u _) = u
- getItsUnique (ClassOpName u _ _ _) = u
-
- fromPreludeCore (WiredInTyCon _) = True
- fromPreludeCore (WiredInVal _) = True
- fromPreludeCore (ClassOpName _ c _ _) = fromPreludeCore c
- fromPreludeCore other = False
+instance Outputable Name where
+ -- When printing interfaces, all Locals have been given nice print-names
+ ppr name = pprName name
+
+pprName name@(Name {n_sort = sort, n_uniq = uniq, n_occ = occ})
+ = getPprStyle $ \ sty ->
+ case sort of
+ Global mod -> pprGlobal sty name uniq mod occ
+ System -> pprSysLocal sty uniq occ
+ Local -> pprLocal sty uniq occ
+
+pprGlobal sty name uniq mod occ
+ | codeStyle sty = ppr (moduleName mod) <> char '_' <> pprOccName occ
+
+ | debugStyle sty = ppr (moduleName mod) <> dot <> pprOccName occ <>
+ text "{-" <> pprUnique uniq <> text "-}"
+
+ | unqualStyle sty name = pprOccName occ
+ | otherwise = ppr (moduleName mod) <> dot <> pprOccName occ
+
+pprLocal sty uniq occ
+ | codeStyle sty = pprUnique uniq
+ | debugStyle sty = pprOccName occ <>
+ text "{-" <> pprUnique uniq <> text "-}"
+ | otherwise = pprOccName occ -- User and Iface styles
+
+-- Like Local, except that we only omit the unique in Iface style
+pprSysLocal sty uniq occ
+ | codeStyle sty = pprUnique uniq
+ | ifaceStyle sty = pprOccName occ -- The tidy phase has ensured that OccNames
+ -- are enough
+ | otherwise = pprOccName occ <> char '_' <> pprUnique uniq
+ -- If the tidy phase hasn't run, the OccName
+ -- is unlikely to be informative (like 's'),
+ -- so print the unique