X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FName.lhs;h=ac47387290345745293d1b4295d3b797aca41770;hb=d3e697b8d842bd43329d470f2bc424a6dcb88d89;hp=20c105111f34a568ce161235f3df41eb330e5ede;hpb=1066365e2c309765498a64f26afdd519b28be550;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs index 20c1051..ac47387 100644 --- a/ghc/compiler/basicTypes/Name.lhs +++ b/ghc/compiler/basicTypes/Name.lhs @@ -4,24 +4,22 @@ \section[Name]{@Name@: to transmit name info from renamer to typechecker} \begin{code} -#include "HsVersions.h" - module Name ( -- Re-export the Module type - SYN_IE(Module), + Module, pprModule, moduleString, -- The OccName type OccName(..), pprOccName, occNameString, occNameFlavour, isTvOcc, isTCOcc, isVarOcc, prefixOccName, - quoteInText, parenInCode, + uniqToOccName, -- The Name type Name, -- Abstract mkLocalName, mkSysLocalName, - mkCompoundName, mkGlobalName, mkInstDeclName, + mkCompoundName, mkGlobalName, mkWiredInIdName, mkWiredInTyConName, maybeWiredInIdName, maybeWiredInTyConName, @@ -39,14 +37,14 @@ module Name ( pprNameProvenance, -- Sets of Names - SYN_IE(NameSet), + NameSet, emptyNameSet, unitNameSet, mkNameSet, unionNameSets, unionManyNameSets, minusNameSet, elemNameSet, nameSetToList, addOneToNameSet, addListToNameSet, isEmptyNameSet, -- Misc - DefnInfo(..), Provenance(..), pprProvenance, - ExportFlag(..), + ExportFlag(..), + PrintUnqualified, -- Class NamedThing and overloaded friends NamedThing(..), @@ -54,24 +52,24 @@ module Name ( getSrcLoc, isLocallyDefined, getOccString ) where -IMP_Ubiq() -import TyLoop --( GenId, Id(..), TyCon ) -- Used inside Names -import CStrings ( identToC, modnameToC, cSEP ) -import CmdLineOpts ( opt_OmitInterfacePragmas, opt_EnsureSplittableC ) -import BasicTypes ( SYN_IE(Module), moduleString, pprModule ) - -import Outputable ( Outputable(..), PprStyle(..), codeStyle, ifaceStyle ) -import PrelMods ( gHC__ ) -import Pretty -import Lex ( isLexSym, isLexConId ) -import SrcLoc ( noSrcLoc, SrcLoc ) -import Usage ( SYN_IE(UVar), SYN_IE(Usage) ) -import Unique ( pprUnique, showUnique, Unique ) -import UniqSet ( UniqSet(..), emptyUniqSet, unitUniqSet, unionUniqSets, uniqSetToList, isEmptyUniqSet, - unionManyUniqSets, minusUniqSet, mkUniqSet, elementOfUniqSet, addListToUniqSet, addOneToUniqSet ) -import UniqFM ( UniqFM, SYN_IE(Uniquable) ) -import Util --( cmpPString, panic, assertPanic {-, pprTrace ToDo:rm-} ) +#include "HsVersions.h" +import {-# SOURCE #-} Id ( Id ) +import {-# SOURCE #-} TyCon ( TyCon ) + +import CStrings ( identToC ) +import CmdLineOpts ( opt_PprStyle_All, opt_OmitInterfacePragmas, opt_EnsureSplittableC ) +import BasicTypes ( Module, IfaceFlavour(..), moduleString, pprModule ) + +import Lex ( isLexConId ) +import SrcLoc ( noSrcLoc, mkBuiltinSrcLoc, SrcLoc ) +import Unique ( pprUnique, showUnique, Unique, Uniquable(..) ) +import UniqSet ( UniqSet(..), emptyUniqSet, unitUniqSet, unionUniqSets, uniqSetToList, + isEmptyUniqSet, unionManyUniqSets, minusUniqSet, mkUniqSet, + elementOfUniqSet, addListToUniqSet, addOneToUniqSet + ) +import UniqFM ( UniqFM ) +import Outputable \end{code} @@ -86,10 +84,11 @@ data OccName = VarOcc FAST_STRING -- Variables and data constructors | TvOcc FAST_STRING -- Type variables | TCOcc FAST_STRING -- Type constructors and classes -pprOccName :: PprStyle -> OccName -> Doc -pprOccName sty n = if codeStyle sty - then identToC (occNameString n) - else ptext (occNameString n) +pprOccName :: OccName -> SDoc +pprOccName n = getPprStyle $ \ sty -> + if codeStyle sty + then identToC (occNameString n) + else ptext (occNameString n) occNameString :: OccName -> FAST_STRING occNameString (VarOcc s) = s @@ -120,42 +119,32 @@ isTvOcc other = False isTCOcc (TCOcc s) = True isTCOcc other = False - instance Eq OccName where - a == b = case (a `cmp` b) of { EQ_ -> True; _ -> False } - a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True } + a == b = case (a `compare` b) of { EQ -> True; _ -> False } + a /= b = case (a `compare` b) of { EQ -> False; _ -> True } instance Ord OccName where - a <= b = case (a `cmp` b) of { LT_ -> True; EQ_ -> True; GT__ -> False } - a < b = case (a `cmp` b) of { LT_ -> True; EQ_ -> False; GT__ -> False } - a >= b = case (a `cmp` b) of { LT_ -> False; EQ_ -> True; GT__ -> True } - a > b = case (a `cmp` b) of { LT_ -> False; EQ_ -> False; GT__ -> True } - -instance Ord3 OccName where - cmp = cmpOcc + 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 a b = cmpOcc a b -(VarOcc s1) `cmpOcc` (VarOcc s2) = s1 `_CMP_STRING_` s2 -(VarOcc s1) `cmpOcc` other2 = LT_ +(VarOcc s1) `cmpOcc` (VarOcc s2) = s1 `compare` s2 +(VarOcc s1) `cmpOcc` other2 = LT -(TvOcc s1) `cmpOcc` (VarOcc s2) = GT_ -(TvOcc s1) `cmpOcc` (TvOcc s2) = s1 `_CMP_STRING_` s2 -(TvOcc s1) `cmpOcc` other = LT_ +(TvOcc s1) `cmpOcc` (VarOcc s2) = GT +(TvOcc s1) `cmpOcc` (TvOcc s2) = s1 `compare` s2 +(TvOcc s1) `cmpOcc` other = LT -(TCOcc s1) `cmpOcc` (TCOcc s2) = s1 `_CMP_STRING_` s2 -(TCOcc s1) `cmpOcc` other = GT_ +(TCOcc s1) `cmpOcc` (TCOcc s2) = s1 `compare` s2 +(TCOcc s1) `cmpOcc` other = GT instance Outputable OccName where ppr = pprOccName \end{code} -\begin{code} -parenInCode, quoteInText :: OccName -> Bool -parenInCode occ = isLexSym (occNameString occ) - -quoteInText occ = not (isLexSym (occNameString occ)) -\end{code} - %************************************************************************ %* * \subsection[Name-datatype]{The @Name@ datatype, and name construction} @@ -171,8 +160,7 @@ data Name | Global Unique Module -- The defining module OccName -- Its name in that module - DefnInfo -- How it is defined - Provenance -- How it was brought into scope + Provenance -- How it was defined \end{code} Things with a @Global@ name are given C static labels, so they finally @@ -181,14 +169,24 @@ in the form M.n. If originally-local things have this property they must be made @Global@ first. \begin{code} -data DefnInfo = VanillaDefn - | WiredInTyCon TyCon -- There's a wired-in version - | WiredInId Id -- ...ditto... - data Provenance - = LocalDef ExportFlag SrcLoc -- Locally defined - | Imported Module SrcLoc -- Directly imported from M; gives locn of import statement - | Implicit -- Implicitly imported + = NoProvenance + + | LocalDef -- Defined locally + SrcLoc -- Defn site + ExportFlag -- Whether it's exported + + | NonLocalDef -- Defined non-locally + SrcLoc -- Defined non-locally; src-loc gives defn site + IfaceFlavour -- Whether the defn site is an .hi-boot file or not + PrintUnqualified + + | WiredInTyCon TyCon -- There's a wired-in version + | WiredInId Id -- ...ditto... + +type PrintUnqualified = Bool -- True <=> the unqualified name of this thing is + -- in scope in this module, so print it unqualified + -- in error messages \end{code} Something is "Exported" if it may be mentioned by another module without @@ -213,7 +211,7 @@ data ExportFlag = Exported | NotExported mkLocalName :: Unique -> OccName -> SrcLoc -> Name mkLocalName = Local -mkGlobalName :: Unique -> Module -> OccName -> DefnInfo -> Provenance -> Name +mkGlobalName :: Unique -> Module -> OccName -> Provenance -> Name mkGlobalName = Global mkSysLocalName :: Unique -> FAST_STRING -> SrcLoc -> Name @@ -221,11 +219,11 @@ mkSysLocalName uniq str loc = Local uniq (VarOcc str) loc mkWiredInIdName :: Unique -> Module -> FAST_STRING -> Id -> Name mkWiredInIdName uniq mod occ id - = Global uniq mod (VarOcc occ) (WiredInId id) Implicit + = Global uniq mod (VarOcc occ) (WiredInId id) mkWiredInTyConName :: Unique -> Module -> FAST_STRING -> TyCon -> Name mkWiredInTyConName uniq mod occ tycon - = Global uniq mod (TCOcc occ) (WiredInTyCon tycon) Implicit + = Global uniq mod (TCOcc occ) (WiredInTyCon tycon) mkCompoundName :: (FAST_STRING -> FAST_STRING) -- Occurrence-name modifier @@ -233,59 +231,98 @@ mkCompoundName :: (FAST_STRING -> FAST_STRING) -- Occurrence-name modifier -> Name -- Base name (must be a Global) -> Name -- Result is always a value name -mkCompoundName str_fn uniq (Global _ mod occ defn prov) - = Global uniq mod new_occ defn prov +mkCompoundName str_fn uniq (Global _ mod occ prov) + = Global uniq mod new_occ prov where new_occ = VarOcc (str_fn (occNameString occ)) -- Always a VarOcc mkCompoundName str_fn uniq (Local _ occ loc) = Local uniq (VarOcc (str_fn (occNameString occ))) loc - -- Rather a wierd one that's used for names generated for instance decls -mkInstDeclName :: Unique -> Module -> OccName -> SrcLoc -> Bool -> Name -mkInstDeclName uniq mod occ loc from_here - = Global uniq mod occ VanillaDefn prov - where - prov | from_here = LocalDef Exported loc - | otherwise = Implicit - -setNameProvenance :: Name -> Provenance -> Name -- Implicit Globals only -setNameProvenance (Global uniq mod occ def Implicit) prov = Global uniq mod occ def prov -setNameProvenance other_name prov = other_name +setNameProvenance :: Name -> Provenance -> Name + -- setNameProvenance used to only change the provenance of Implicit-provenance things, + -- but that gives bad error messages for names defined twice in the same + -- module, so I changed it to set the provenance of *any* global (SLPJ Jun 97) +setNameProvenance (Global uniq mod occ _) prov = Global uniq mod occ prov +setNameProvenance other_name prov = other_name getNameProvenance :: Name -> Provenance -getNameProvenance (Global uniq mod occ def prov) = prov -getNameProvenance (Local uniq occ locn) = LocalDef NotExported locn +getNameProvenance (Global uniq mod occ prov) = prov +getNameProvenance (Local uniq occ locn) = LocalDef locn NotExported -- When we renumber/rename things, we need to be -- able to change a Name's Unique to match the cached -- one in the thing it's the name of. If you know what I mean. changeUnique (Local _ n l) u = Local u n l -changeUnique (Global _ mod occ def prov) u = Global u mod occ def prov +changeUnique (Global _ mod occ prov) u = Global u mod occ prov +\end{code} + +setNameVisibility is applied to names in the final program + +The Maybe Module argument is (Just mod) for top-level values, +and Nothing for all others (local values and type variables) + +For top-level things, it globalises Local names + (if all top-level things should be visible) + and localises non-exported Global names + (if only exported things should be visible) -setNameVisibility :: Module -> Name -> Name --- setNameVisibility is applied to top-level names in the final program --- The "visibility" here concerns whether the .o file's symbol table --- mentions the thing; if so, it needs a module name in its symbol, --- otherwise we just use its unique. The Global things are "visible" --- and the local ones are not +For nested things it localises Global names. -setNameVisibility _ (Global uniq mod occ def (LocalDef NotExported loc)) - | not all_toplev_ids_visible - = Local uniq occ loc +In all cases except an exported global, it gives it a new occurrence name. -setNameVisibility mod (Local uniq occ loc) +The "visibility" here concerns whether the .o file's symbol table +mentions the thing; if so, it needs a module name in its symbol. +The Global things are "visible" and the Local ones are not + +Why should things be "visible"? Certainly they must be if they +are exported. But also: + +(a) In certain (prelude only) modules we split up the .hc file into + lots of separate little files, which are separately compiled by the C + compiler. That gives lots of little .o files. The idea is that if + you happen to mention one of them you don't necessarily pull them all + in. (Pulling in a piece you don't need can be v bad, because it may + mention other pieces you don't need either, and so on.) + + Sadly, splitting up .hc files means that local names (like s234) are + now globally visible, which can lead to clashes between two .hc + files. So unlocaliseWhatnot goes through making all the local things + into global things, essentially by giving them full names so when they + are printed they'll have their module name too. Pretty revolting + really. + +(b) When optimisation is on we want to make all the internal + top-level defns externally visible + +\begin{code} +setNameVisibility :: Maybe Module -> Unique -> Name -> Name + +setNameVisibility maybe_mod occ_uniq name@(Global uniq mod occ (LocalDef loc NotExported)) + | not all_toplev_ids_visible || not_top_level maybe_mod + = Local uniq (uniqToOccName occ_uniq) loc -- Localise Global name + +setNameVisibility maybe_mod occ_uniq name@(Global _ _ _ _) + = name -- Otherwise don't fiddle with Global + +setNameVisibility (Just mod) occ_uniq (Local uniq occ loc) | all_toplev_ids_visible - = Global uniq mod - (VarOcc (showUnique uniq)) -- It's local name must be unique! - VanillaDefn (LocalDef NotExported loc) + = Global uniq mod -- Globalise Local name + (uniqToOccName occ_uniq) + (LocalDef loc NotExported) + +setNameVisibility maybe_mod occ_uniq (Local uniq occ loc) + = Local uniq (uniqToOccName occ_uniq) loc -- New OccName for Local + +uniqToOccName uniq = VarOcc (_PK_ ('$':showUnique uniq)) + -- The "$" is to make sure that this OccName is distinct from all user-defined ones -setNameVisibility mod name = name +not_top_level (Just m) = False +not_top_level Nothing = True all_toplev_ids_visible = not opt_OmitInterfacePragmas || -- Pragmas can make them visible opt_EnsureSplittableC -- Splitting requires visiblilty - \end{code} %************************************************************************ @@ -309,45 +346,47 @@ isLocalName :: Name -> Bool nameUnique (Local u _ _) = u -nameUnique (Global u _ _ _ _) = u +nameUnique (Global u _ _ _) = u -nameOccName (Local _ occ _) = occ -nameOccName (Global _ _ occ _ _) = occ +nameOccName (Local _ occ _) = occ +nameOccName (Global _ _ occ _) = occ -nameModule (Global _ mod occ _ _) = mod +nameModule (Global _ mod occ _) = mod -nameModAndOcc (Global _ mod occ _ _) = (mod,occ) +nameModAndOcc (Global _ mod occ _) = (mod,occ) -nameString (Local _ occ _) = occNameString occ -nameString (Global _ mod occ _ _) = mod _APPEND_ SLIT(".") _APPEND_ occNameString occ +nameString (Local _ occ _) = occNameString occ +nameString (Global _ mod occ _) = mod _APPEND_ SLIT(".") _APPEND_ occNameString occ -isExportedName (Global _ _ _ _ (LocalDef Exported _)) = True -isExportedName other = False +isExportedName (Global _ _ _ (LocalDef _ Exported)) = True +isExportedName other = False nameSrcLoc (Local _ _ loc) = loc -nameSrcLoc (Global _ _ _ _ (LocalDef _ loc)) = loc -nameSrcLoc (Global _ _ _ _ (Imported _ loc)) = loc -nameSrcLoc other = noSrcLoc +nameSrcLoc (Global _ _ _ (LocalDef loc _)) = loc +nameSrcLoc (Global _ _ _ (NonLocalDef loc _ _)) = loc +nameSrcLoc (Global _ _ _ (WiredInTyCon _)) = mkBuiltinSrcLoc +nameSrcLoc (Global _ _ _ (WiredInId _)) = mkBuiltinSrcLoc +nameSrcLoc other = noSrcLoc -isLocallyDefinedName (Local _ _ _) = True -isLocallyDefinedName (Global _ _ _ _ (LocalDef _ _)) = True -isLocallyDefinedName other = False +isLocallyDefinedName (Local _ _ _) = True +isLocallyDefinedName (Global _ _ _ (LocalDef _ _)) = True +isLocallyDefinedName other = False -- Things the compiler "knows about" are in some sense -- "imported". When we are compiling the module where -- the entities are defined, we need to be able to pick -- them out, often in combination with isLocallyDefined. -isWiredInName (Global _ _ _ (WiredInTyCon _) _) = True -isWiredInName (Global _ _ _ (WiredInId _) _) = True -isWiredInName _ = False +isWiredInName (Global _ _ _ (WiredInTyCon _)) = True +isWiredInName (Global _ _ _ (WiredInId _)) = True +isWiredInName _ = False maybeWiredInIdName :: Name -> Maybe Id -maybeWiredInIdName (Global _ _ _ (WiredInId id) _) = Just id -maybeWiredInIdName other = Nothing +maybeWiredInIdName (Global _ _ _ (WiredInId id)) = Just id +maybeWiredInIdName other = Nothing maybeWiredInTyConName :: Name -> Maybe TyCon -maybeWiredInTyConName (Global _ _ _ (WiredInTyCon tc) _) = Just tc -maybeWiredInTyConName other = Nothing +maybeWiredInTyConName (Global _ _ _ (WiredInTyCon tc)) = Just tc +maybeWiredInTyConName other = Nothing isLocalName (Local _ _ _) = True @@ -364,25 +403,23 @@ isLocalName _ = False \begin{code} cmpName n1 n2 = c n1 n2 where - c (Local u1 _ _) (Local u2 _ _) = cmp u1 u2 - c (Local _ _ _) _ = LT_ - c (Global u1 _ _ _ _) (Global u2 _ _ _ _) = cmp u1 u2 - c (Global _ _ _ _ _) _ = GT_ + c (Local u1 _ _) (Local u2 _ _) = compare u1 u2 + c (Local _ _ _) _ = LT + c (Global u1 _ _ _) (Global u2 _ _ _) = compare u1 u2 + c (Global _ _ _ _) _ = GT \end{code} \begin{code} instance Eq Name where - a == b = case (a `cmp` b) of { EQ_ -> True; _ -> False } - a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True } + a == b = case (a `compare` b) of { EQ -> True; _ -> False } + a /= b = case (a `compare` b) of { EQ -> False; _ -> True } instance Ord Name where - a <= b = case (a `cmp` b) of { LT_ -> True; EQ_ -> True; GT__ -> False } - a < b = case (a `cmp` b) of { LT_ -> True; EQ_ -> False; GT__ -> False } - a >= b = case (a `cmp` b) of { LT_ -> False; EQ_ -> True; GT__ -> True } - a > b = case (a `cmp` b) of { LT_ -> False; EQ_ -> False; GT__ -> True } - -instance Ord3 Name where - cmp = cmpName + 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 a b = cmpName a b instance Uniquable Name where uniqueOf = nameUnique @@ -401,49 +438,72 @@ instance NamedThing Name where \begin{code} instance Outputable Name where - ppr PprQuote name@(Local _ _ _) = quotes (ppr (PprForUser 1) name) - ppr (PprForUser _) (Local _ n _) = ptext (occNameString n) - - ppr sty (Local u n _) | codeStyle sty || - ifaceStyle sty = pprUnique u - - ppr sty (Local u n _) = hcat [ptext (occNameString n), ptext SLIT("_"), pprUnique u] - - ppr PprQuote name@(Global _ _ _ _ _) = quotes (ppr (PprForUser 1) name) - - ppr sty name@(Global u m n _ _) - | codeStyle sty - = identToC (m _APPEND_ SLIT(".") _APPEND_ occNameString n) - - ppr sty name@(Global u m n _ prov) - = hcat [pp_mod, ptext (occNameString n), pp_debug sty name] - where - pp_mod = case prov of --- Omit home module qualifier - LocalDef _ _ -> empty - other -> pprModule (PprForUser 1) m <> char '.' - - -pp_debug PprDebug (Global uniq m n _ prov) = hcat [text "{-", pprUnique uniq, char ',', - pp_prov prov, text "-}"] - where - pp_prov (LocalDef Exported _) = char 'x' - pp_prov (LocalDef NotExported _) = char 'l' - pp_prov (Imported _ _) = char 'i' - pp_prov Implicit = char 'p' -pp_debug other name = empty + -- When printing interfaces, all Locals have been given nice print-names + ppr name = pprName name + +pprName name + = getPprStyle $ \ sty -> + let + ppr (Local u n _) + | userStyle sty + || ifaceStyle sty = ptext (occNameString n) + | codeStyle sty = pprUnique u + | otherwise = hcat [ptext (occNameString n), ptext SLIT("_"), pprUnique u] + + ppr name@(Global u m n prov) + | codeStyle sty + = identToC (m _APPEND_ SLIT(".") _APPEND_ occNameString n) + + | otherwise + = hcat [pp_mod_dot, ptext (occNameString n), pp_debug sty name] + where + pp_mod_dot + = case prov of -- Omit home module qualifier if its in scope + LocalDef _ _ -> pp_qual dot (user_sty || iface_sty) + NonLocalDef _ hif omit -> pp_qual (pp_hif hif) (omit && user_sty) + WiredInTyCon _ -> pp_qual dot user_sty -- Hack: omit qualifers on wired in things + WiredInId _ -> pp_qual dot user_sty -- in user style only + NoProvenance -> pp_qual dot False + + pp_qual sep omit_qual + | omit_qual = empty + | otherwise = pprModule m <> sep + + dot = text "." + pp_hif HiFile = dot -- Vanilla case + pp_hif HiBootFile = text "!" -- M!t indicates a name imported from a .hi-boot interface + + user_sty = userStyle sty + iface_sty = ifaceStyle sty + in + ppr name + + +pp_debug sty (Global uniq m n prov) + | debugStyle sty = hcat [text "{-", pprUnique uniq, prov_p, text "-}"] + | otherwise = empty + where + prov_p | opt_PprStyle_All = comma <> pp_prov prov + | otherwise = empty + +pp_prov (LocalDef _ Exported) = char 'x' +pp_prov (LocalDef _ NotExported) = char 'l' +pp_prov (NonLocalDef _ _ _) = char 'n' +pp_prov (WiredInTyCon _) = char 'W' +pp_prov (WiredInId _) = char 'w' +pp_prov NoProvenance = char '?' -- pprNameProvenance is used in error messages to say where a name came from -pprNameProvenance :: PprStyle -> Name -> Doc -pprNameProvenance sty (Local _ _ loc) = pprProvenance sty (LocalDef NotExported loc) -pprNameProvenance sty (Global _ _ _ _ prov) = pprProvenance sty prov - -pprProvenance :: PprStyle -> Provenance -> Doc -pprProvenance sty (Imported mod loc) - = sep [ptext SLIT("Imported from"), pprModule sty mod, ptext SLIT("at"), ppr sty loc] -pprProvenance sty (LocalDef _ loc) - = sep [ptext SLIT("Defined at"), ppr sty loc] -pprProvenance sty Implicit - = panic "pprNameProvenance: Implicit" +pprNameProvenance :: Name -> SDoc +pprNameProvenance (Local _ _ loc) = pprProvenance (LocalDef loc NotExported) +pprNameProvenance (Global _ _ _ prov) = pprProvenance prov + +pprProvenance :: Provenance -> SDoc +pprProvenance (LocalDef loc _) = ptext SLIT("Locally defined at") <+> ppr loc +pprProvenance (NonLocalDef loc _ _) = ptext SLIT("Non-locally defined at") <+> ppr loc +pprProvenance (WiredInTyCon tc) = ptext SLIT("Wired-in tycon") +pprProvenance (WiredInId id) = ptext SLIT("Wired-in id") +pprProvenance NoProvenance = ptext SLIT("No provenance") \end{code} @@ -498,14 +558,12 @@ class NamedThing a where \begin{code} modAndOcc :: NamedThing a => a -> (Module, OccName) -getModule :: NamedThing a => a -> Module getSrcLoc :: NamedThing a => a -> SrcLoc isLocallyDefined :: NamedThing a => a -> Bool isExported :: NamedThing a => a -> Bool getOccString :: NamedThing a => a -> String modAndOcc = nameModAndOcc . getName -getModule = nameModule . getName isExported = isExportedName . getName getSrcLoc = nameSrcLoc . getName isLocallyDefined = isLocallyDefinedName . getName