[project @ 2000-12-07 08:28:05 by simonpj]
[ghc-hetmet.git] / ghc / compiler / basicTypes / Name.lhs
index 00fcbab..aef8355 100644 (file)
 %
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
 \section[Name]{@Name@: to transmit name info from renamer to typechecker}
 
 \begin{code}
-#include "HsVersions.h"
-
 module Name (
-       -- things for the Name NON-abstract type
-       Name(..),
-
-       isTyConName, isClassName, isClassOpName,
-       isUnboundName, invisibleName,
-
-       getTagFromClassOpName, getSynNameArity,
-
-       getNameShortName, getNameFullName
-
+       -- Re-export the OccName stuff
+       module OccName,
+
+       -- The Name type
+       Name,                                   -- Abstract
+       mkLocalName, mkSysLocalName, mkCCallName,
+       mkIPName,
+       mkGlobalName, mkKnownKeyGlobal, mkWiredInName,
+
+       nameUnique, setNameUnique,
+       nameOccName, nameModule, nameModule_maybe,
+       setNameOcc, nameRdrName, setNameModuleAndLoc, 
+       toRdrName, hashName, 
+       globaliseName, localiseName,
+
+       nameSrcLoc, nameIsLocallyDefined, isDllName, nameIsFrom, nameIsLocalOrFrom,
+
+       isSystemName, isLocalName, isGlobalName, isExternallyVisibleName,
+       isTyVarName,
+       
+       -- Environment
+       NameEnv, mkNameEnv,
+       emptyNameEnv, unitNameEnv, nameEnvElts, 
+       extendNameEnv_C, extendNameEnv, foldNameEnv, filterNameEnv,
+       plusNameEnv, plusNameEnv_C, extendNameEnv, extendNameEnvList,
+       lookupNameEnv, lookupNameEnv_NF, delFromNameEnv, elemNameEnv, 
+
+
+       -- Class NamedThing and overloaded friends
+       NamedThing(..),
+       getSrcLoc, getOccString, toRdrName,
+       isFrom, isLocalOrFrom
     ) where
 
-import Ubiq{-uitous-}
-
-import NameLoop                -- break Name/Id loop, Name/PprType/Id loop
+#include "HsVersions.h"
 
-import NameTypes
-import Outputable      ( ExportFlag(..) )
-import Pretty
-import PprStyle                ( PprStyle(..) )
-import SrcLoc          ( mkBuiltinSrcLoc, mkUnknownSrcLoc )
-import TyCon           ( TyCon, getSynTyConArity )
-import TyVar           ( GenTyVar )
-import Unique          ( pprUnique, Unique )
-import Util            ( panic, panic#, pprPanic )
+import OccName         -- All of it
+import Module          ( Module, moduleName, mkVanillaModule, isHomeModule )
+import RdrName         ( RdrName, mkRdrOrig, mkRdrUnqual, rdrNameOcc, rdrNameModule )
+import CmdLineOpts     ( opt_Static )
+import SrcLoc          ( builtinSrcLoc, noSrcLoc, SrcLoc )
+import Unique          ( Unique, Uniquable(..), u2i, pprUnique, pprUnique10 )
+import FastTypes
+import Maybes          ( expectJust )
+import UniqFM
+import Outputable
 \end{code}
 
 %************************************************************************
 %*                                                                     *
-\subsection[Name-datatype]{The @Name@ datatype}
+\subsection[Name-datatype]{The @Name@ datatype, and name construction}
 %*                                                                     *
 %************************************************************************
-
 \begin{code}
-data Name
-  = Short          Unique      -- Local ids and type variables
-                   ShortName
-
-       -- Nano-prelude things; truly wired in.
-       -- Includes all type constructors and their associated data constructors
-  | WiredInTyCon    TyCon
-  | WiredInVal     Id
-
-  | TyConName      Unique      -- TyCons other than Prelude ones; need to
-                   FullName    -- separate these because we want to pin on
-                   Arity       -- their arity.
-                   Bool        -- False <=> `type',
-                               -- True <=> `data' or `newtype'
-                   [Name]      -- List of user-visible data constructors;
-                               -- NB: for `data' types only.
-                               -- Used in checking import/export lists.
-
-  | ClassName      Unique
-                   FullName
-                   [Name]      -- List of class methods; used for checking
-                               -- import/export lists.
-
-  | ValName        Unique      -- Top level id
-                   FullName
-
-  | ClassOpName            Unique
-                   Name        -- Name associated w/ the defined class
-                               -- (can get unique and export info, etc., from this)
-                   FAST_STRING -- The class operation
-                   Int         -- Unique tag within the class
-
-       -- Miscellaneous
-  | Unbound        FAST_STRING -- Placeholder for a name which isn't in scope
-                               -- Used only so that the renamer can carry on after
-                               -- finding an unbound identifier.
-                               -- The string is grabbed from the unbound name, for
-                               -- debugging information only.
+data Name = Name {
+               n_sort :: NameSort,     -- What sort of name it is
+               n_occ  :: OccName,      -- Its occurrence name
+               n_uniq :: Unique,
+               n_loc  :: SrcLoc        -- Definition site
+           }
+
+data NameSort
+  = Global Module      -- (a) TyCon, Class, their derived Ids, dfun Id
+                       -- (b) Imported Id
+                       -- (c) Top-level Id in the original source, even if
+                       --      locally defined
+
+  | Local              -- A user-defined Id or TyVar
+                       -- defined in the module being compiled
+
+  | System             -- A system-defined Id or TyVar.  Typically the
+                       -- OccName is very uninformative (like 's')
 \end{code}
 
-These @is..@ functions are used in the renamer to check that (eg) a tycon
-is seen in a context which demands one.
+Notes about the NameSorts:
+
+1.  Initially, top-level Ids (including locally-defined ones) get Global names, 
+    and all other local Ids get Local names
+
+2.  Things with a @Global@ name are given C static labels, so they finally
+    appear in the .o file's symbol table.  They appear in the symbol table
+    in the form M.n.  If originally-local things have this property they
+    must be made @Global@ first.
+
+3.  In the tidy-core phase, a Global that is not visible to an importer
+    is changed to Local, and a Local that is visible is changed to Global
+
+4.  A System Name differs in the following ways:
+       a) has unique attached when printing dumps
+       b) unifier eliminates sys tyvars in favour of user provs where possible
+
+    Before anything gets printed in interface files or output code, it's
+    fed through a 'tidy' processor, which zaps the OccNames to have
+    unique names; and converts all sys-locals to user locals
+    If any desugarer sys-locals have survived that far, they get changed to
+    "ds1", "ds2", etc.
 
 \begin{code}
-isTyConName, isClassName, isUnboundName :: Name -> Bool
+nameUnique             :: Name -> Unique
+nameOccName            :: Name -> OccName 
+nameModule             :: Name -> Module
+nameSrcLoc             :: Name -> SrcLoc
 
-isTyConName (TyConName _ _ _ _ _) = True
-isTyConName (WiredInTyCon _)     = True
-isTyConName other                = False
+nameUnique  name = n_uniq name
+nameOccName name = n_occ  name
+nameSrcLoc  name = n_loc  name
 
-isClassName (ClassName _ _ _) = True
-isClassName other            = False
+nameModule (Name { n_sort = Global mod }) = mod
+nameModule name                                  = pprPanic "nameModule" (ppr name)
 
-isUnboundName (Unbound _) = True
-isUnboundName other      = False
+nameModule_maybe (Name { n_sort = Global mod }) = Just mod
+nameModule_maybe name                          = Nothing
 \end{code}
 
-@isClassOpName@ is a little cleverer: it checks to see whether the
-class op comes from the correct class.
-
 \begin{code}
-isClassOpName :: Name  -- The name of the class expected for this op
-             -> Name   -- The name of the thing which should be a class op
-             -> Bool
+nameIsLocallyDefined   :: Name -> Bool
+nameIsFrom             :: Module -> Name -> Bool
+nameIsLocalOrFrom      :: Module -> Name -> Bool
+isLocalName            :: Name -> Bool         -- Not globals
+isGlobalName           :: Name -> Bool
+isSystemName           :: Name -> Bool
+isExternallyVisibleName :: Name -> Bool
+
+isGlobalName (Name {n_sort = Global _}) = True
+isGlobalName other                     = False
+
+isLocalName name = not (isGlobalName name)
 
-isClassOpName (ClassName uniq1 _ _) (ClassOpName _ (ClassName uniq2 _ _) _ _)
-  = uniq1 == uniq2
-isClassOpName other_class other_op = False
+nameIsLocallyDefined name = isLocalName name
+
+nameIsLocalOrFrom from (Name {n_sort = Global mod}) = mod == from
+nameIsLocalOrFrom from other                       = True
+
+nameIsFrom from (Name {n_sort = Global mod}) = mod == from
+nameIsFrom from other                       = pprPanic "nameIsFrom" (ppr other)
+
+-- Global names are by definition those that are visible
+-- outside the module, *as seen by the linker*.  Externally visible
+-- does not mean visible at the source level
+isExternallyVisibleName name = isGlobalName name
+
+isSystemName (Name {n_sort = System}) = True
+isSystemName other                   = False
 \end{code}
 
-A Name is ``invisible'' if the user has no business seeing it; e.g., a
-data-constructor for an abstract data type (but whose constructors are
-known because of a pragma).
+
+%************************************************************************
+%*                                                                     *
+\subsection{Making names}
+%*                                                                     *
+%************************************************************************
+
 \begin{code}
-invisibleName :: Name -> Bool
+mkLocalName :: Unique -> OccName -> SrcLoc -> Name
+mkLocalName uniq occ loc = Name { n_uniq = uniq, n_sort = Local, n_occ = occ, n_loc = loc }
+       -- NB: You might worry that after lots of huffing and
+       -- puffing we might end up with two local names with distinct
+       -- uniques, but the same OccName.  Indeed we can, but that's ok
+       --      * the insides of the compiler don't care: they use the Unique
+       --      * when printing for -ddump-xxx you can switch on -dppr-debug to get the
+       --        uniques if you get confused
+       --      * for interface files we tidyCore first, which puts the uniques
+       --        into the print name (see setNameVisibility below)
+
+mkGlobalName :: Unique -> Module -> OccName -> SrcLoc -> Name
+mkGlobalName uniq mod occ loc = Name { n_uniq = uniq, n_sort = Global mod,
+                                      n_occ = occ, n_loc = loc }
+
+mkKnownKeyGlobal :: RdrName -> Unique -> Name
+mkKnownKeyGlobal rdr_name uniq
+  = mkGlobalName uniq (mkVanillaModule (rdrNameModule rdr_name))
+                     (rdrNameOcc rdr_name)
+                     builtinSrcLoc
+
+mkWiredInName :: Module -> OccName -> Unique -> Name
+mkWiredInName mod occ uniq = mkGlobalName uniq mod occ builtinSrcLoc
+
+mkSysLocalName :: Unique -> UserFS -> Name
+mkSysLocalName uniq fs = Name { n_uniq = uniq, n_sort = System, 
+                               n_occ = mkVarOcc fs, n_loc = noSrcLoc }
+
+mkCCallName :: Unique -> EncodedString -> Name
+       -- The encoded string completely describes the ccall
+mkCCallName uniq str =  Name { n_uniq = uniq, n_sort = Local, 
+                              n_occ = mkCCallOcc str, n_loc = noSrcLoc }
+
+mkIPName :: Unique -> OccName -> Name
+mkIPName uniq occ
+  = Name { n_uniq = uniq,
+          n_sort = Local,
+          n_occ  = occ,
+          n_loc = noSrcLoc }
+\end{code}
 
-invisibleName (TyConName _ n _ _ _) = invisibleFullName n
-invisibleName (ClassName _ n _)     = invisibleFullName n
-invisibleName (ValName   _ n)      = invisibleFullName n
-invisibleName _                            = False
+\begin{code}
+-- 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.
+setNameUnique name uniq = name {n_uniq = uniq}
+
+setNameOcc :: Name -> OccName -> Name
+setNameOcc name occ = name {n_occ = occ}
+
+globaliseName :: Name -> Module -> Name
+globaliseName n mod = n { n_sort = Global mod }
+                               
+localiseName :: Name -> Name
+localiseName n = n { n_sort = Local }
+                               
+setNameModuleAndLoc :: Name -> Module -> SrcLoc -> Name
+setNameModuleAndLoc name mod loc = name {n_sort = set (n_sort name), n_loc = loc}
+                      where
+                        set (Global _) = Global mod
 \end{code}
 
+
+%************************************************************************
+%*                                                                     *
+\subsection{Predicates and selectors}
+%*                                                                     *
+%************************************************************************
+
 \begin{code}
-getTagFromClassOpName :: Name -> Int
-getTagFromClassOpName (ClassOpName _ _ _ tag)  = tag
+hashName :: Name -> Int
+hashName name = iBox (u2i (nameUnique name))
+
+
+nameRdrName :: Name -> RdrName
+-- Makes a qualified name for top-level (Global) names, whether locally defined or not
+-- and an unqualified name just for Locals
+nameRdrName (Name { n_occ = occ, n_sort = Global mod }) = mkRdrOrig (moduleName mod) occ
+nameRdrName (Name { n_occ = occ })                     = mkRdrUnqual occ
 
-getSynNameArity :: Name -> Maybe Arity
-getSynNameArity (TyConName _ _ arity False{-syn-} _) = Just arity
-getSynNameArity (WiredInTyCon tycon)                = getSynTyConArity tycon
-getSynNameArity other_name                          = Nothing
+isDllName :: Name -> Bool
+       -- Does this name refer to something in a different DLL?
+isDllName nm = not opt_Static &&
+              not (isLocalName nm) &&                          -- isLocalName test needed 'cos
+              not (isHomeModule (nameModule nm))       -- nameModule won't work on local names
 
-getNameShortName :: Name -> ShortName
-getNameShortName (Short _ sn) = sn
 
-getNameFullName :: Name -> FullName
-getNameFullName n = get_nm "getNameFullName" n
+
+isTyVarName :: Name -> Bool
+isTyVarName name = isTvOcc (nameOccName name)
 \end{code}
 
 
@@ -147,149 +259,144 @@ getNameFullName n = get_nm "getNameFullName" n
 %************************************************************************
 
 \begin{code}
-cmpName n1 n2 = c n1 n2
-  where
-    c (Short u1 _)          (Short u2 _)               = cmp u1 u2
-                             
-    c (WiredInTyCon tc1)     (WiredInTyCon tc2)                = cmp tc1 tc2
-    c (WiredInVal   id1)     (WiredInVal   id2)                = cmp id1 id2
-                             
-    c (TyConName u1 _ _ _ _) (TyConName u2 _ _ _ _)    = cmp u1 u2
-    c (ClassName u1 _ _)     (ClassName u2 _ _)                = cmp u1 u2
-    c (ValName   u1 _)      (ValName   u2 _)           = cmp u1 u2
-                             
-    c (ClassOpName u1 _ _ _) (ClassOpName u2 _ _ _)    = cmp u1 u2
-    c (Unbound a)           (Unbound b)                = panic# "Eq.Name.Unbound"
-
-    c other_1 other_2          -- the tags *must* be different
-      = let tag1 = tag_Name n1
-           tag2 = tag_Name n2
-       in
-       if tag1 _LT_ tag2 then LT_ else GT_
-
-    tag_Name (Short _ _)               = (ILIT(1) :: FAST_INT)
-    tag_Name (WiredInTyCon _)          = ILIT(2)
-    tag_Name (WiredInVal _)            = ILIT(3)
-    tag_Name (TyConName _ _ _ _ _)     = ILIT(7)
-    tag_Name (ClassName _ _ _)         = ILIT(8)
-    tag_Name (ValName _ _)             = ILIT(9)
-    tag_Name (ClassOpName _ _ _ _)     = ILIT(10)
-    tag_Name (Unbound _)               = ILIT(11)
+cmpName n1 n2 = n_uniq n1 `compare` n_uniq n2
 \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  }
+    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 Ord3 Name where
-    cmp = cmpName
-\end{code}
+instance Uniquable Name where
+    getUnique = nameUnique
 
-\begin{code}
 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
+    getName n = n
 \end{code}
 
-A useful utility; most emphatically not for export! (but see
-@getNameFullName@...):
+
+%************************************************************************
+%*                                                                     *
+\subsection{Name environment}
+%*                                                                     *
+%************************************************************************
+
 \begin{code}
-get_nm :: String -> Name -> FullName
-
-get_nm msg (TyConName _ n _ _ _) = n
-get_nm msg (ClassName _ n _)    = n
-get_nm msg (ValName   _ n)      = n
-#ifdef DEBUG
-get_nm msg other = pprPanic ("get_nm:"++msg) (ppr PprShowAll other)
--- If match failure, probably on a ClassOpName or Unbound :-(
-#endif
+type NameEnv a = UniqFM a      -- Domain is Name
+
+emptyNameEnv            :: NameEnv a
+mkNameEnv       :: [(Name,a)] -> NameEnv a
+nameEnvElts             :: NameEnv a -> [a]
+extendNameEnv_C  :: (a->a->a) -> NameEnv a -> Name -> a -> NameEnv a
+extendNameEnv           :: NameEnv a -> Name -> a -> NameEnv a
+plusNameEnv             :: NameEnv a -> NameEnv a -> NameEnv a
+plusNameEnv_C           :: (a->a->a) -> NameEnv a -> NameEnv a -> NameEnv a
+extendNameEnvList:: NameEnv a -> [(Name,a)] -> NameEnv a
+delFromNameEnv          :: NameEnv a -> Name -> NameEnv a
+elemNameEnv             :: Name -> NameEnv a -> Bool
+unitNameEnv             :: Name -> a -> NameEnv a
+lookupNameEnv           :: NameEnv a -> Name -> Maybe a
+lookupNameEnv_NF :: NameEnv a -> Name -> a
+mapNameEnv      :: (a->b) -> NameEnv a -> NameEnv b
+foldNameEnv     :: (a -> b -> b) -> b -> NameEnv a -> b
+filterNameEnv   :: (elt -> Bool) -> NameEnv elt -> NameEnv elt
+
+emptyNameEnv            = emptyUFM
+foldNameEnv     = foldUFM
+mkNameEnv       = listToUFM
+nameEnvElts             = eltsUFM
+extendNameEnv_C  = addToUFM_C
+extendNameEnv           = addToUFM
+plusNameEnv             = plusUFM
+plusNameEnv_C           = plusUFM_C
+extendNameEnvList= addListToUFM
+delFromNameEnv          = delFromUFM
+elemNameEnv             = elemUFM
+mapNameEnv      = mapUFM
+unitNameEnv             = unitUFM
+filterNameEnv   = filterUFM
+
+lookupNameEnv                 = lookupUFM
+lookupNameEnv_NF env n = expectJust "lookupNameEnv_NF" (lookupUFM env n)
 \end{code}
 
+
+%************************************************************************
+%*                                                                     *
+\subsection{Pretty printing}
+%*                                                                     *
+%************************************************************************
+
 \begin{code}
 instance Outputable Name where
-#ifdef DEBUG
-    ppr PprDebug (Short u s)       = pp_debug u s
-
-    ppr PprDebug (TyConName u n _ _ _) = pp_debug u n
-    ppr PprDebug (ClassName u n _)     = pp_debug u n
-    ppr PprDebug (ValName u n)         = pp_debug u n
-#endif
-    ppr sty (Short u s)                  = ppr sty s
-
-    ppr sty (WiredInTyCon tc)    = ppr sty tc
-    ppr sty (WiredInVal   id)    = ppr sty id
-
-    ppr sty (TyConName u n a b c) = ppr sty n
-    ppr sty (ClassName u n c)    = ppr sty n
-    ppr sty (ValName   u n)      = ppr sty n
-
-    ppr sty (ClassOpName u c s i)
-      = let
-           ps = ppPStr s
-       in
-       case sty of
-         PprForUser   -> ps
-         PprInterface -> ps
-         PprDebug     -> ps
-         other        -> ppBesides [ps, ppChar '{',
-                                      ppSep [pprUnique u,
-                                             ppStr "op", ppInt i,
-                                             ppStr "cls", ppr sty c],
-                                      ppChar '}']
-
-    ppr sty (Unbound s) = ppStr ("*UNBOUND*"++ _UNPK_ s)
-
-pp_debug uniq thing
-  = ppBesides [ppr PprDebug thing, ppStr "{-", pprUnique uniq, ppStr "-}" ]
+       -- 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 "{-" <> pprUnique10 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
+\end{code}
+
+%************************************************************************
+%*                                                                     *
+\subsection{Overloaded functions related to Names}
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+class NamedThing a where
+    getOccName :: a -> OccName
+    getName    :: a -> Name
+
+    getOccName n = nameOccName (getName n)     -- Default method
 \end{code}
+
+\begin{code}
+getSrcLoc          :: NamedThing a => a -> SrcLoc
+getOccString       :: NamedThing a => a -> String
+toRdrName          :: NamedThing a => a -> RdrName
+isFrom             :: NamedThing a => Module -> a -> Bool
+isLocalOrFrom      :: NamedThing a => Module -> a -> Bool
+
+getSrcLoc          = nameSrcLoc           . getName
+getOccString       = occNameString        . getOccName
+toRdrName          = nameRdrName          . getName
+isFrom mod x       = nameIsFrom mod (getName x)
+isLocalOrFrom mod x = nameIsLocalOrFrom mod ( getName x)
+\end{code}
+