[project @ 2000-08-07 23:37:19 by qrczak]

[ghc-hetmet.git] / ghc / compiler / basicTypes / Name.lhs

diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs
index 5fc667c..23c3a01 100644 (file)
--- a/ghc/compiler/basicTypes/Name.lhs
+++ b/ghc/compiler/basicTypes/Name.lhs
@@ -5,271 +5,356 @@
 
 \begin{code}
 module Name (
 
 \begin{code}
 module Name (

-       -- Re-export the Module type
-       Module,
-       pprModule, moduleString,
-
-       -- The basic form of names
-       isLexCon, isLexVar, isLexId, isLexSym,
-       isLexConId, isLexConSym, isLexVarId, isLexVarSym,
-       mkTupNameStr, mkUbxTupNameStr, isLowerISO, isUpperISO,
-
-       -- The OccName type
-       OccName(..), varOcc, 
-       pprOccName, occNameString, occNameFlavour, 
-       isTvOcc, isTCOcc, isVarOcc, prefixOccName,
+       -- Re-export the OccName stuff
+       module OccName,

 
        -- The Name type
        Name,                                   -- Abstract
 
        -- The Name type
        Name,                                   -- Abstract

-       mkLocalName, mkSysLocalName, 
-
-       mkCompoundName, mkGlobalName,
-
+       mkLocalName, mkImportedLocalName, mkSysLocalName, mkCCallName,
+       mkTopName, mkIPName,
+       mkDerivedName, mkGlobalName, mkKnownKeyGlobal,

        mkWiredInIdName,   mkWiredInTyConName,
        mkWiredInIdName,   mkWiredInTyConName,

-       maybeWiredInIdName, maybeWiredInTyConName,
-       isWiredInName,
+       mkUnboundName, isUnboundName,

 
 

-       nameUnique, changeUnique, setNameProvenance, getNameProvenance,
-       setNameVisibility, mkNameVisible,
-       nameOccName, nameModule,
+       maybeWiredInIdName, maybeWiredInTyConName,
+       isWiredInName, hashName,

 
 

-       isExportedName, nameSrcLoc,
-       isLocallyDefinedName,
+       nameUnique, setNameUnique, setNameProvenance, getNameProvenance, setNameImportReason,
+       tidyTopName, 
+       nameOccName, nameModule, setNameOcc, nameRdrName, setNameModule, toRdrName,

 
 

-       isSysLocalName, isLocalName, isGlobalName, isExternallyVisibleName,
+       isUserExportedName, isUserImportedName, isUserImportedExplicitlyName, 
+       maybeUserImportedFrom,
+       nameSrcLoc, isLocallyDefinedName, isDllName,

 
 

-        pprNameProvenance,
+       isSystemName, isLocalName, isGlobalName, isExternallyVisibleName,
+       
+       -- Environment
+       NameEnv, mkNameEnv,
+       emptyNameEnv, unitNameEnv, nameEnvElts, 
+       extendNameEnv_C, extendNameEnv, 
+       plusNameEnv, plusNameEnv_C, extendNameEnv, extendNameEnvList,
+       lookupNameEnv, lookupNameEnv_NF, delFromNameEnv, elemNameEnv, 

 
 

-       -- Special Names
-       dictNamePrefix, mkSuperDictSelName, mkWorkerName,
-       mkDefaultMethodName, mkClassTyConStr, mkClassDataConStr,

 
 

-       -- Misc
-       Provenance(..), pprProvenance,
-       ExportFlag(..), 
-       PrintUnqualified,
+       -- Provenance
+       Provenance(..), ImportReason(..), pprProvenance,
+       ExportFlag(..), PrintUnqualified,
+        pprNameProvenance, hasBetterProv,

 
        -- Class NamedThing and overloaded friends
        NamedThing(..),
 
        -- Class NamedThing and overloaded friends
        NamedThing(..),

-       modAndOcc, isExported, 
-       getSrcLoc, isLocallyDefined, getOccString
+       getSrcLoc, isLocallyDefined, getOccString, toRdrName

     ) where
 
 #include "HsVersions.h"
 
     ) where
 
 #include "HsVersions.h"
 

-import {-# SOURCE #-} Var   ( Id )
-import {-# SOURCE #-} TyCon ( TyCon )
+import {-# SOURCE #-} Var   ( Id, setIdName )
+import {-# SOURCE #-} TyCon ( TyCon, setTyConName )

 
 

-import CStrings                ( identToC )
-import PrelMods                ( pREL_BASE, pREL_TUP, pREL_GHC )
-import CmdLineOpts     ( opt_PprStyle_NoPrags, opt_OmitInterfacePragmas, opt_EnsureSplittableC )
-import BasicTypes      ( Module, IfaceFlavour(..), moduleString, pprModule )
+import OccName         -- All of it
+import Module          ( Module, moduleName, pprModule, mkVanillaModule, isLocalModule )
+import RdrName         ( RdrName, mkRdrQual, mkRdrUnqual, rdrNameOcc, rdrNameModule )
+import CmdLineOpts     ( opt_Static, opt_PprStyle_NoPrags, opt_OmitInterfacePragmas, opt_EnsureSplittableC )

 
 import SrcLoc          ( noSrcLoc, mkBuiltinSrcLoc, SrcLoc )
 
 import SrcLoc          ( noSrcLoc, mkBuiltinSrcLoc, SrcLoc )

-import Unique          ( pprUnique, Unique, Uniquable(..) )
+import Unique          ( pprUnique, Unique, Uniquable(..), hasKey, unboundKey, u2i )
+import Maybes          ( expectJust )
+import UniqFM

 import Outputable
 import Outputable

-import Char            ( isUpper, isLower, ord )
-import Util            ( nOfThem )

 import GlaExts
 \end{code}
 
 
 %************************************************************************
 %*                                                                     *
 import GlaExts
 \end{code}
 
 
 %************************************************************************
 %*                                                                     *

-\subsection{Lexical categories}
+\subsection[Name-datatype]{The @Name@ datatype, and name construction}

 %*                                                                     *
 %************************************************************************
 %*                                                                     *
 %************************************************************************

+ 
+\begin{code}
+data Name = Name {
+               n_sort :: NameSort,     -- What sort of name it is
+               n_uniq :: Unique,
+               n_occ  :: OccName,      -- Its occurrence name
+               n_prov :: Provenance    -- How it was made
+           }
+
+data NameSort
+  = Local
+  | Global Module
+  | WiredInId Module Id
+  | WiredInTyCon Module TyCon
+\end{code}

 
 

-These functions test strings to see if they fit the lexical categories
-defined in the Haskell report.
+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.

 
 \begin{code}
 
 \begin{code}

-isLexCon, isLexVar, isLexId, isLexSym, isLexConId, isLexConSym,
- isLexVarId, isLexVarSym  :: FAST_STRING -> Bool
+mkLocalName :: Unique -> OccName -> SrcLoc -> Name
+mkLocalName uniq occ loc = Name { n_uniq = uniq, n_sort = Local, n_occ = occ, 
+                                 n_prov = LocalDef loc NotExported }
+       -- 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)
+
+mkImportedLocalName :: Unique -> OccName -> SrcLoc -> Name
+       -- Just the same as mkLocalName, except the provenance is different
+       -- Reason: this flags the name as one that came in from an interface file.
+       -- This is useful when trying to decide which of two type variables
+       -- should 'win' when unifying them.
+       -- NB: this is only for non-top-level names, so we use ImplicitImport
+mkImportedLocalName uniq occ loc = Name { n_uniq = uniq, n_sort = Local, n_occ = occ, 
+                                         n_prov = NonLocalDef ImplicitImport True }

 
 

-isLexCon cs = isLexConId  cs || isLexConSym cs
-isLexVar cs = isLexVarId  cs || isLexVarSym cs

 
 

-isLexId  cs = isLexConId  cs || isLexVarId  cs
-isLexSym cs = isLexConSym cs || isLexVarSym cs
+mkGlobalName :: Unique -> Module -> OccName -> Provenance -> Name
+mkGlobalName uniq mod occ prov = Name { n_uniq = uniq, n_sort = Global mod,
+                                       n_occ = occ, n_prov = prov }
+                               
+
+mkKnownKeyGlobal :: (RdrName, Unique) -> Name
+mkKnownKeyGlobal (rdr_name, uniq)
+  = mkGlobalName uniq (mkVanillaModule (rdrNameModule rdr_name))
+                     (rdrNameOcc rdr_name)
+                     systemProvenance
+
+mkSysLocalName :: Unique -> UserFS -> Name
+mkSysLocalName uniq fs = Name { n_uniq = uniq, n_sort = Local, 
+                               n_occ = mkSrcVarOcc fs, n_prov = systemProvenance }
+
+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_prov = NonLocalDef ImplicitImport True }
+
+mkTopName :: Unique -> Module -> FAST_STRING -> Name
+       -- Make a top-level name; make it Global if top-level
+       -- things should be externally visible; Local otherwise
+       -- This chap is only used *after* the tidyCore phase
+       -- Notably, it is used during STG lambda lifting
+       --
+       -- We have to make sure that the name is globally unique
+       -- and we don't have tidyCore to help us. So we append
+       -- the unique.  Hack!  Hack!
+mkTopName uniq mod fs
+  = Name { n_uniq = uniq, 
+          n_sort = mk_top_sort mod,
+          n_occ  = mkSrcVarOcc (_PK_ ((_UNPK_ fs) ++ show uniq)),
+          n_prov = LocalDef noSrcLoc NotExported }
+
+mkIPName :: Unique -> OccName -> Name
+mkIPName uniq occ
+  = Name { n_uniq = uniq,
+          n_sort = Local,
+          n_occ  = occ,
+          -- ZZ is this an appropriate provinence?
+          n_prov = SystemProv }
+
+------------------------- Wired in names -------------------------
+
+mkWiredInIdName :: Unique -> Module -> OccName -> Id -> Name
+mkWiredInIdName uniq mod occ id = Name { n_uniq = uniq, n_sort = WiredInId mod id,
+                                        n_occ = occ, n_prov = SystemProv }
+
+-- mkWiredInTyConName takes a FAST_STRING instead of
+-- an OccName, which is a bit yukky but that's what the 
+-- clients find easiest.
+mkWiredInTyConName :: Unique -> Module -> FAST_STRING -> TyCon -> Name
+mkWiredInTyConName uniq mod fs tycon
+  = Name { n_uniq = uniq, n_sort = WiredInTyCon mod tycon,
+          n_occ = mkSrcOccFS tcName fs, n_prov = SystemProv }

 
 

--------------

 
 

-isLexConId cs
-  | _NULL_ cs       = False
-  | cs == SLIT("[]") = True
-  | c  == '('       = True     -- (), (,), (,,), ...
-  | otherwise       = isUpper c || isUpperISO c
-  where                                        
-    c = _HEAD_ cs
+---------------------------------------------------------------------
+mkDerivedName :: (OccName -> OccName)
+             -> Name           -- Base name
+             -> Unique         -- New unique
+             -> Name           -- Result is always a value name

 
 

-isLexVarId cs
-  | _NULL_ cs   = False
-  | otherwise    = isLower c || isLowerISO c
-  where
-    c = _HEAD_ cs
+mkDerivedName f name uniq = name {n_uniq = uniq, n_occ = f (n_occ name)}

 
 

-isLexConSym cs
-  | _NULL_ cs  = False
-  | otherwise  = c  == ':'
-              || cs == SLIT("->")
-  where
-    c = _HEAD_ cs
+-- mkUnboundName makes a place-holder Name; it shouldn't be looked at except possibly
+-- during compiler debugging.
+mkUnboundName :: RdrName -> Name
+mkUnboundName rdr_name = mkLocalName unboundKey (rdrNameOcc rdr_name) noSrcLoc

 
 

-isLexVarSym cs
-  | _NULL_ cs = False
-  | otherwise = isSymbolASCII c
-            || isSymbolISO c
-  where
-    c = _HEAD_ cs
-
--------------
-isSymbolASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"
-isSymbolISO   c = ord c `elem` (0xd7 : 0xf7 : [0xa1 .. 0xbf])
-isUpperISO    (C# c#) = c# `geChar#` '\xc0'# && c# `leChar#` '\xde'# && c# `neChar#` '\xd7'#
---0xc0 <= oc && oc <= 0xde && oc /= 0xd7 where oc = ord c
-isLowerISO    (C# c#) = c# `geChar#` '\xdf'# && c# `leChar#` '\xff'# && c# `neChar#` '\xf7'#
---0xdf <= oc && oc <= 0xff && oc /= 0xf7 where oc = ord c
+isUnboundName :: Name -> Bool
+isUnboundName name = name `hasKey` unboundKey

 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}

-mkTupNameStr 0 = (pREL_BASE, SLIT("()"))
-mkTupNameStr 1 = panic "Name.mkTupNameStr: 1 ???"
-mkTupNameStr 2 = (pREL_TUP, _PK_ "(,)")   -- not strictly necessary
-mkTupNameStr 3 = (pREL_TUP, _PK_ "(,,)")  -- ditto
-mkTupNameStr 4 = (pREL_TUP, _PK_ "(,,,)") -- ditto
-mkTupNameStr n = (pREL_TUP, _PK_ ("(" ++ nOfThem (n-1) ',' ++ ")"))
-
-mkUbxTupNameStr 0 = panic "Name.mkUbxTupNameStr: 0 ???"
-mkUbxTupNameStr 1 = (pREL_GHC, _PK_ "(# #)") -- 1 and 0 both make sense!!!
-mkUbxTupNameStr 2 = (pREL_GHC, _PK_ "(#,#)")
-mkUbxTupNameStr 3 = (pREL_GHC, _PK_ "(#,,#)")
-mkUbxTupNameStr 4 = (pREL_GHC, _PK_ "(#,,,#)")
-mkUbxTupNameStr n = (pREL_GHC, _PK_ ("(#" ++ nOfThem (n-1) ',' ++ "#)"))
+-- 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
+       -- Give the thing a new OccName, *and*
+       -- record that it's no longer a sys-local
+       -- This is used by the tidy-up pass
+setNameOcc name occ = name {n_occ = occ}
+
+setNameModule :: Name -> Module -> Name
+setNameModule name mod = name {n_sort = set (n_sort name)}
+                      where
+                        set (Global _)             = Global mod
+                        set (WiredInId _ id)       = WiredInId mod id
+                        set (WiredInTyCon _ tycon) = WiredInTyCon mod tycon

 \end{code}
 
 
 %************************************************************************
 %*                                                                     *
 \end{code}
 
 
 %************************************************************************
 %*                                                                     *

-\subsection[Name-pieces-datatypes]{The @OccName@ datatypes}
+\subsection{Setting provenance and visibility

 %*                                                                     *
 %************************************************************************
 
 %*                                                                     *
 %************************************************************************
 

+tidyTopName is applied to top-level names in the final program
+
+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)
+
+In all cases except an exported global, it gives it a new occurrence name.
+
+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}
 \begin{code}

-data OccName  = VarOcc  FAST_STRING    -- Variables and data constructors
-             | TvOcc   FAST_STRING     -- Type variables
-             | TCOcc   FAST_STRING     -- Type constructors and classes
-
-pprOccName :: OccName -> SDoc
-pprOccName n = getPprStyle $ \ sty ->
-              if codeStyle sty 
-              then identToC (occNameString n)
-              else ptext (occNameString n)
-
-varOcc :: FAST_STRING -> OccName
-varOcc = VarOcc
-
-occNameString :: OccName -> FAST_STRING
-occNameString (VarOcc s)  = s
-occNameString (TvOcc s)   = s
-occNameString (TCOcc s)   = s
-
-mapOccName :: (FAST_STRING -> FAST_STRING) -> OccName -> OccName
-mapOccName f (VarOcc s) = VarOcc (f s)
-mapOccName f (TvOcc s)  = TvOcc  (f s)
-mapOccName f (TCOcc s)  = TCOcc  (f s)
-
-prefixOccName :: FAST_STRING -> OccName -> OccName
-prefixOccName prefix (VarOcc s) = VarOcc (prefix _APPEND_ s)
-prefixOccName prefix (TvOcc s)  = TvOcc (prefix _APPEND_ s)
-prefixOccName prefix (TCOcc s) = TCOcc (prefix _APPEND_ s)
-
--- occNameFlavour is used only to generate good error messages, so it doesn't matter
--- that the VarOcc case isn't mega-efficient.  We could have different Occ constructors for
--- data constructors and values, but that makes everything else a bit more complicated.
-occNameFlavour :: OccName -> String
-occNameFlavour (VarOcc s) | isLexConId s = "Data constructor"
-                         | otherwise    = "Value"
-occNameFlavour (TvOcc s)  = "Type variable"
-occNameFlavour (TCOcc s)  = "Type constructor or class"
-
-isVarOcc, isTCOcc, isTvOcc :: OccName -> Bool
-isVarOcc (VarOcc s) = True
-isVarOcc other     = False
-
-isTvOcc (TvOcc s) = True
-isTvOcc other     = False
-
-isTCOcc (TCOcc s) = True
-isTCOcc other     = False
-
-instance Eq OccName where
-    a == b = case (a `compare` b) of { EQ -> True;  _ -> False }
-    a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
+tidyTopName :: Module -> TidyOccEnv -> Name -> (TidyOccEnv, Name)
+tidyTopName mod env name
+  = (env', name')
+  where
+    (env', occ') = tidyOccName env (n_occ name)

 
 

-instance Ord OccName where
-    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
+    name'        = Name { n_uniq = n_uniq name, n_sort = mk_top_sort mod,
+                         n_occ = occ', n_prov = LocalDef noSrcLoc NotExported }

 
 

-(VarOcc s1) `cmpOcc` (VarOcc s2) = s1 `compare` s2
-(VarOcc s1) `cmpOcc` other2      = LT
+mk_top_sort mod | all_toplev_ids_visible = Global mod
+               | otherwise              = Local

 
 

-(TvOcc s1)  `cmpOcc` (VarOcc s2) = GT
-(TvOcc s1)  `cmpOcc` (TvOcc s2)  = s1 `compare` s2
-(TvOcc s1)  `cmpOcc` other      = LT
+all_toplev_ids_visible = 
+       not opt_OmitInterfacePragmas ||  -- Pragmas can make them visible
+       opt_EnsureSplittableC            -- Splitting requires visiblilty
+\end{code}
+
+
+\begin{code}
+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 name prov = name {n_prov = prov}

 
 

-(TCOcc s1) `cmpOcc` (TCOcc s2) = s1 `compare` s2
-(TCOcc s1) `cmpOcc` other      = GT
+getNameProvenance :: Name -> Provenance
+getNameProvenance name = n_prov name

 
 

-instance Outputable OccName where
-  ppr = pprOccName
+setNameImportReason :: Name -> ImportReason -> Name
+setNameImportReason name reason
+  = name { n_prov = new_prov }
+  where
+       -- It's important that we don't do the pattern matching
+       -- in the top-level clause, else we get a black hole in 
+       -- the renamer.  Rather a yukky constraint.  There's only
+       -- one call, in RnNames
+    old_prov = n_prov name
+    new_prov = case old_prov of
+                 NonLocalDef _ omit -> NonLocalDef reason omit
+                 other              -> old_prov

 \end{code}
 
 
 %************************************************************************
 %*                                                                     *
 \end{code}
 
 
 %************************************************************************
 %*                                                                     *

-\subsection[Name-datatype]{The @Name@ datatype, and name construction}
+\subsection{Provenance and export info}

 %*                                                                     *
 %************************************************************************
 %*                                                                     *
 %************************************************************************

- 
-\begin{code}
-data Name
-  = Local    Unique
-            (Maybe OccName)    -- For ones that started life with a user name
-
-  | Global   Unique
-            Module             -- The defining module
-            OccName            -- Its name in that module
-             Provenance                -- How it was defined
-\end{code}
-
-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.

 
 \begin{code}
 data Provenance
 
 \begin{code}
 data Provenance

-  = NoProvenance
-
-  | LocalDef                   -- Defined locally
+  = LocalDef                   -- Defined locally

        SrcLoc                  -- Defn site
        ExportFlag              -- Whether it's exported
 
   | NonLocalDef                -- Defined non-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
+       ImportReason

        PrintUnqualified
 
        PrintUnqualified
 

-  | WiredInTyCon TyCon                 -- There's a wired-in version
-  | WiredInId    Id                    -- ...ditto...
+  | SystemProv                 -- Either (a) a system-generated local with 
+                               --            a v short name OccName
+                               -- or     (b) a known-key global which should have a proper
+                               --            provenance attached by the renamer
+\end{code}
+
+Sys-provs are only used internally.  When the compiler generates (say)
+a fresh desguar variable it always calls it "ds", and of course it gets
+a fresh unique.  But when printing -ddump-xx dumps, we must print it with
+its unique, because there'll be a lot of "ds" variables.
+
+Names with SystemProv differ in the following ways:
+       a) locals have unique attached when printing dumps
+       b) unifier eliminates sys tyvars in favour of user provs where possible
+       c) renamer replaces SystemProv with a better one
+
+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}
+data ImportReason
+  = UserImport Module SrcLoc Bool      -- Imported from module M on line L
+                                       -- Note the M may well not be the defining module
+                                       -- for this thing!
+       -- The Bool is true iff the thing was named *explicitly* in the import spec,
+       -- rather than being imported as part of a group; e.g.
+       --      import B
+       --      import C( T(..) )
+       -- Here, everything imported by B, and the constructors of T
+       -- are not named explicitly; only T is named explicitly.
+       -- This info is used when warning of unused names.
+
+  | ImplicitImport                     -- Imported implicitly for some other reason
+                       

 
 type PrintUnqualified = Bool   -- True <=> the unqualified name of this thing is
                                -- in scope in this module, so print it 
                                -- unqualified in error messages
 
 type PrintUnqualified = Bool   -- True <=> the unqualified name of this thing is
                                -- in scope in this module, so print it 
                                -- unqualified in error messages

+
+data ExportFlag = Exported  | NotExported

 \end{code}
 
 Something is "Exported" if it may be mentioned by another module without
 \end{code}
 
 Something is "Exported" if it may be mentioned by another module without

@@ -289,135 +374,24 @@ symbol table.  For example, a local Id may be mentioned in an Exported
 Id's unfolding in the interface file, in which case the local Id goes
 out too.
 
 Id's unfolding in the interface file, in which case the local Id goes
 out too.
 

-\begin{code}
-data ExportFlag = Exported  | NotExported
-\end{code}

 
 \begin{code}
 
 \begin{code}

-mkLocalName    :: Unique -> OccName -> Name
-mkLocalName uniq occ = Local uniq (Just occ)
-
-mkGlobalName :: Unique -> Module -> OccName -> Provenance -> Name
-mkGlobalName = Global
-
-mkSysLocalName :: Unique -> Name
-mkSysLocalName uniq = Local uniq Nothing
-
-mkWiredInIdName :: Unique -> Module -> FAST_STRING -> Id -> Name
-mkWiredInIdName uniq mod occ id 
-  = Global uniq mod (VarOcc occ) (WiredInId id)
+systemProvenance :: Provenance
+systemProvenance = SystemProv

 
 

-mkWiredInTyConName :: Unique -> Module -> FAST_STRING -> TyCon -> Name
-mkWiredInTyConName uniq mod occ tycon
-  = Global uniq mod (TCOcc occ) (WiredInTyCon tycon)
-
-
-mkCompoundName :: (OccName -> OccName)
-              -> Unique                -- New unique
-              -> Name                  -- Base name
-              -> Name          -- Result is always a value name
-
-mkCompoundName f uniq (Global _ mod occ prov)
-  = Global uniq mod (f occ) prov
-
-mkCompoundName f uniq (Local _ (Just occ))
-  = Local uniq (Just (f occ))
-
-mkCompoundName f uniq (Local _ Nothing)
-  = Local uniq Nothing
-
-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 prov) = prov
-getNameProvenance (Local uniq occ)           = LocalDef noSrcLoc NotExported
+-- pprNameProvenance is used in error messages to say where a name came from
+pprNameProvenance :: Name -> SDoc
+pprNameProvenance name = pprProvenance (getNameProvenance name)

 
 

--- 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 )          u = Local u n
-changeUnique (Global   _ mod occ  prov) u = Global u mod occ prov
+pprProvenance :: Provenance -> SDoc
+pprProvenance SystemProv            = ptext SLIT("System")
+pprProvenance (LocalDef loc _)       = ptext SLIT("defined at")    <+> ppr loc
+pprProvenance (NonLocalDef ImplicitImport _)
+  = ptext SLIT("implicitly imported")
+pprProvenance (NonLocalDef (UserImport mod loc _) _) 
+  =  ptext SLIT("imported from") <+> ppr mod <+> ptext SLIT("at") <+> ppr loc

 \end{code}
 
 \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)
-
-For nested things it localises Global names.
-
-In all cases except an exported global, it gives it a new occurrence name.
-
-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 uniq name@(Global _ mod occ (LocalDef loc NotExported))
-  | not all_toplev_ids_visible || not_top_level maybe_mod
-  = Local uniq Nothing                         -- Localise Global name
-
-setNameVisibility maybe_mod uniq name@(Global _ _ _ _)
-  = name                                       -- Otherwise don't fiddle with Global
-
-setNameVisibility (Just mod) uniq (Local _ _)
-  | all_toplev_ids_visible
-  = Global uniq mod                            -- Globalise Local name
-          (uniqToOccName uniq)
-          (LocalDef noSrcLoc NotExported)
-
-setNameVisibility maybe_mod uniq (Local _ _)
-  = Local uniq Nothing                         -- New unique for Local; zap its occ
-
--- make the Name globally visible regardless.
-mkNameVisible :: Module -> Unique -> Name -> Name
-mkNameVisible mod occ_uniq nm@(Global _ _ _ _) = nm
-mkNameVisible mod occ_uniq nm@(Local uniq occ)
- = Global uniq mod (uniqToOccName occ_uniq) (LocalDef noSrcLoc Exported)
-
-uniqToOccName uniq = VarOcc (_PK_ ('_':show uniq))
-       -- The "_" is to make sure that this OccName is distinct from all user-defined ones
-
-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}

 
 %************************************************************************
 %*                                                                     *
 
 %************************************************************************
 %*                                                                     *

@@ -427,12 +401,11 @@ all_toplev_ids_visible =
 
 \begin{code}
 nameUnique             :: Name -> Unique
 
 \begin{code}
 nameUnique             :: Name -> Unique

-nameModAndOcc          :: Name -> (Module, OccName)    -- Globals only

 nameOccName            :: Name -> OccName 
 nameModule             :: Name -> Module
 nameSrcLoc             :: Name -> SrcLoc
 isLocallyDefinedName   :: Name -> Bool
 nameOccName            :: Name -> OccName 
 nameModule             :: Name -> Module
 nameSrcLoc             :: Name -> SrcLoc
 isLocallyDefinedName   :: Name -> Bool

-isExportedName         :: Name -> Bool
+isUserExportedName     :: Name -> Bool

 isWiredInName          :: Name -> Bool
 isLocalName            :: Name -> Bool
 isGlobalName           :: Name -> Bool
 isWiredInName          :: Name -> Bool
 isLocalName            :: Name -> Bool
 isGlobalName           :: Name -> Bool

@@ -440,61 +413,102 @@ isExternallyVisibleName :: Name -> Bool
 
 
 
 
 
 

-nameUnique (Local  u _)     = u
-nameUnique (Global u _ _ _) = u
+hashName :: Name -> Int
+hashName name = IBOX( u2i (nameUnique name) )
+
+nameUnique name = n_uniq name
+nameOccName name = n_occ name
+
+nameModule name =
+  case n_sort name of
+    Local -> pprPanic "nameModule" (ppr name)
+    x     -> nameSortModule x

 
 

-nameOccName (Local _ (Just occ)) = occ
-nameOccName (Local uniq Nothing) = pprPanic "nameOccName" (ppr uniq)
-nameOccName (Global _ _ occ _)   = occ
+nameSortModule (Global       mod)   = mod
+nameSortModule (WiredInId    mod _) = mod
+nameSortModule (WiredInTyCon mod _) = mod

 
 

-nameModule (Global _ mod occ _) = mod
+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_sort = Local, n_occ = occ }) = mkRdrUnqual occ
+nameRdrName (Name { n_sort = sort,  n_occ = occ }) = mkRdrQual (moduleName (nameSortModule sort)) occ

 
 

-nameModAndOcc (Global _ mod occ _) = (mod,occ)
+ifaceNameRdrName :: Name -> RdrName
+-- Makes a qualified naem for imported things, 
+-- and an unqualified one for local things
+ifaceNameRdrName n | isLocallyDefined n = mkRdrUnqual (nameOccName n)
+                  | otherwise          = mkRdrQual   (moduleName (nameModule n)) (nameOccName n) 

 
 

-isExportedName (Global _ _ _ (LocalDef _ Exported)) = True
-isExportedName other                               = False
+isUserExportedName (Name { n_prov = LocalDef _ Exported }) = True
+isUserExportedName other                                  = False

 
 

-nameSrcLoc (Local _ _)                         = noSrcLoc
-nameSrcLoc (Global _ _ _ (LocalDef loc _))      = loc
-nameSrcLoc (Global _ _ _ (NonLocalDef loc _ _)) = loc
-nameSrcLoc (Global _ _ _ (WiredInTyCon _))      = mkBuiltinSrcLoc
-nameSrcLoc (Global _ _ _ (WiredInId _))         = mkBuiltinSrcLoc
-nameSrcLoc other                               = noSrcLoc
+isUserImportedExplicitlyName (Name { n_prov = NonLocalDef (UserImport _ _ explicit) _ }) = explicit
+isUserImportedExplicitlyName other                                                      = False
+
+isUserImportedName (Name { n_prov = NonLocalDef (UserImport _ _ _) _ }) = True
+isUserImportedName other                                               = False
+
+maybeUserImportedFrom (Name { n_prov = NonLocalDef (UserImport m _ _) _ }) = Just m
+maybeUserImportedFrom other                                               = Nothing
+
+isDllName :: Name -> Bool
+       -- Does this name refer to something in a different DLL?
+isDllName nm = not opt_Static &&
+              not (isLocalModule (nameModule nm))
+
+nameSrcLoc name = provSrcLoc (n_prov name)
+
+provSrcLoc (LocalDef loc _)                    = loc        
+provSrcLoc (NonLocalDef (UserImport _ loc _) _) = loc
+provSrcLoc other                               = noSrcLoc   

   
   

-isLocallyDefinedName (Local  _ _)                 = True
-isLocallyDefinedName (Global _ _ _ (LocalDef _ _)) = True
-isLocallyDefinedName other                        = False
+isLocallyDefinedName (Name {n_sort = Local})        = True     -- Local (might have SystemProv)
+isLocallyDefinedName (Name {n_prov = LocalDef _ _}) = True     -- Global, but defined here
+isLocallyDefinedName other                         = False     -- Other

 
 -- 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.
 
 -- 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 (Name {n_sort = WiredInTyCon _ _}) = True
+isWiredInName (Name {n_sort = WiredInId    _ _}) = True
+isWiredInName _                                         = False

 
 maybeWiredInIdName :: Name -> Maybe Id
 
 maybeWiredInIdName :: Name -> Maybe Id

-maybeWiredInIdName (Global _ _ _ (WiredInId id)) = Just id
-maybeWiredInIdName other                        = Nothing
+maybeWiredInIdName (Name {n_sort = WiredInId _ id}) = Just id
+maybeWiredInIdName other                           = Nothing

 
 maybeWiredInTyConName :: Name -> Maybe TyCon
 
 maybeWiredInTyConName :: Name -> Maybe TyCon

-maybeWiredInTyConName (Global _ _ _ (WiredInTyCon tc)) = Just tc
-maybeWiredInTyConName other                           = Nothing
-
+maybeWiredInTyConName (Name {n_sort = WiredInTyCon _ tc}) = Just tc
+maybeWiredInTyConName other                              = Nothing

 
 

-isLocalName (Local _ _) = True
-isLocalName _          = False

 
 

-isSysLocalName (Local _ Nothing) = True
-isSysLocalName other            = False
+isLocalName (Name {n_sort = Local}) = True
+isLocalName _                      = False

 
 

-isGlobalName (Global _ _ _ _) = True
-isGlobalName other           = False
+isGlobalName (Name {n_sort = Local}) = False
+isGlobalName other                  = True

 
 -- 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 (that's isExported).
 isExternallyVisibleName name = isGlobalName name
 
 -- 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 (that's isExported).
 isExternallyVisibleName name = isGlobalName name

+
+hasBetterProv :: Name -> Name -> Bool
+-- Choose 
+--     a local thing                 over an   imported thing
+--     a user-imported thing         over a    non-user-imported thing
+--     an explicitly-imported thing  over an   implicitly imported thing
+hasBetterProv n1 n2
+  = case (n_prov n1, n_prov n2) of
+       (LocalDef _ _,                        _                           ) -> True
+       (NonLocalDef (UserImport _ _ True) _, _                           ) -> True
+       (NonLocalDef (UserImport _ _ _   ) _, NonLocalDef ImplicitImport _) -> True
+       other                                                               -> False
+
+isSystemName (Name {n_prov = SystemProv}) = True
+isSystemName other                       = False

 \end{code}
 
 
 \end{code}
 
 

@@ -505,12 +519,7 @@ isExternallyVisibleName name = isGlobalName name
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}

-cmpName n1 n2 = c n1 n2
-  where
-    c (Local  u1 _)   (Local  u2 _)       = compare u1 u2
-    c (Local   _ _)      _               = LT
-    c (Global u1 _ _ _) (Global u2 _ _ _) = compare u1 u2
-    c (Global  _ _ _ _)   _              = GT
+cmpName n1 n2 = n_uniq n1 `compare` n_uniq n2

 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}

@@ -519,8 +528,8 @@ instance Eq Name where
     a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
 
 instance Ord Name where
     a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
 
 instance Ord Name where

-    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 -> 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
     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

@@ -535,101 +544,44 @@ instance NamedThing Name where
 
 %************************************************************************
 %*                                                                     *
 
 %************************************************************************
 %*                                                                     *

-\subsection[Special-Names]{Special Kinds of names}
+\subsection{Name environment}

 %*                                                                     *
 %************************************************************************
 
 %*                                                                     *
 %************************************************************************
 

-Here's our convention for splitting up the object file name space:
-
-       _d...           dictionary identifiers
-       _g...           externally visible (non-user visible) names
-
-       _m...           default methods
-       _n...           default methods (encoded symbols, eg. <= becomes _nle)
-
-       _p...           superclass selectors
-
-       _w...           workers
-       _v...           workers (encoded symbols)
-
-       _x...           local variables
-
-       _u...           user-defined names that previously began with '_'
-
-       _[A-Z]...       compiler-generated tycons/datacons (namely dictionary
-                       constructors)
-
-       __....          keywords (__export, __letrec etc.)
-
-This knowledge is encoded in the following functions.
-

 \begin{code}
 \begin{code}

-dictNamePrefix :: FAST_STRING
-dictNamePrefix = SLIT("_d")
-
-mkSuperDictSelName :: Int -> OccName -> OccName
-mkSuperDictSelName index = prefixOccName (_PK_ ("_p" ++ show index ++ "_"))
-
-mkWorkerName :: OccName -> OccName
-mkWorkerName nm
-  | isLexSym nm_str = 
-       prefixOccName SLIT("_v") (mapOccName trName nm)
-  | otherwise               = 
-       prefixOccName SLIT("_w") nm
-  where nm_str = occNameString nm
-
-mkDefaultMethodName :: OccName -> OccName
-mkDefaultMethodName nm
-  | isLexSym nm_str = 
-       prefixOccName SLIT("_n") (mapOccName trName nm)
-  | otherwise               = 
-       prefixOccName SLIT("_m") nm
-  where nm_str = occNameString nm
-
--- not used yet:
---mkRecordSelectorName     :: Name -> Name
---mkMethodSelectorName     :: Name -> Name
-
-mkClassTyConStr, mkClassDataConStr :: FAST_STRING -> FAST_STRING
-
-mkClassTyConStr   s = SLIT("_") _APPEND_ s
-mkClassDataConStr s = SLIT("_") _APPEND_ s
-
--- translate a string such that it can occur as *part* of an identifer.  This
--- is used when we prefix identifiers to create new names, for example the
--- name of a default method.
-
-trName :: FAST_STRING -> FAST_STRING
-trName nm = _PK_ (foldr tran "" (_UNPK_ nm))
- where 
-    tran c cs = case trChar c of
-                  '\0' -> '_' : show (ord c) ++ cs
-                  c'   -> c' : cs
-    trChar '&'  = 'a'
-    trChar '|'  = 'b'
-    trChar ':'  = 'c'
-    trChar '/'  = 'd'
-    trChar '='  = 'e'
-    trChar '>'  = 'g'
-    trChar '#'  = 'h'
-    trChar '@'  = 'i'
-    trChar '<'  = 'l'
-    trChar '-'  = 'm'
-    trChar '!'  = 'n'
-    trChar '+'  = 'p'
-    trChar '\'' = 'q'
-    trChar '$'  = 'r'
-    trChar '?'  = 's'
-    trChar '*'  = 't'
-    trChar '_'  = 'u'
-    trChar '.'  = 'v'
-    trChar '\\' = 'w'
-    trChar '%'  = 'x'
-    trChar '~'  = 'y'
-    trChar '^'  = 'z'
-    trChar _    = '\0'
+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
+
+emptyNameEnv            = emptyUFM
+mkNameEnv       = listToUFM
+nameEnvElts             = eltsUFM
+extendNameEnv_C  = addToUFM_C
+extendNameEnv           = addToUFM
+plusNameEnv             = plusUFM
+plusNameEnv_C           = plusUFM_C
+extendNameEnvList= addListToUFM
+delFromNameEnv          = delFromUFM
+elemNameEnv             = elemUFM
+unitNameEnv             = unitUFM
+
+lookupNameEnv                 = lookupUFM
+lookupNameEnv_NF env n = expectJust "lookupNameEnv_NF" (lookupUFM env n)

 \end{code}
 
 \end{code}
 

+

 %************************************************************************
 %*                                                                     *
 \subsection{Pretty printing}
 %************************************************************************
 %*                                                                     *
 \subsection{Pretty printing}

@@ -641,76 +593,73 @@ instance Outputable Name where
        -- When printing interfaces, all Locals have been given nice print-names
     ppr name = pprName name
 
        -- When printing interfaces, all Locals have been given nice print-names
     ppr name = pprName name
 

-pprName name
+pprName (Name {n_sort = Local, n_uniq = uniq, n_occ = occ, n_prov = prov})
+       -- Locals

   = getPprStyle $ \ sty ->
   = getPprStyle $ \ sty ->

-    let
-       -- when printing local names for interface files, prepend the '_'
-       -- to avoid clashes with user-defined names.  In fact, these names
-       -- will always begin with 'g' for top-level ids and 'x' otherwise,
-       -- because these are the unique supplies going into the tidy phase.
-       ppr (Local u n) | codeStyle sty   = pprUnique u
-                      | ifaceStyle sty  = char '_' <> pprUnique u
-
-       ppr (Local u Nothing)   = pprUnique u
-       ppr (Local u (Just occ))        | userStyle sty = ptext (occNameString occ)
-                               | otherwise     = ptext (occNameString occ) <> char '_' <> 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 in scope 
-                  LocalDef _ _          -> pp_qual dot (user_sty || iface_sty)
-                  NonLocalDef _ hif omit -> pp_qual (pp_hif hif) (omit && user_sty)
-                                -- Hack: omit qualifers on wired in things
-                                -- in user style only
-                  WiredInTyCon _       -> pp_qual dot user_sty
-                  WiredInId _          -> pp_qual dot user_sty
-                  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_NoPrags = empty
-                           | otherwise            = comma <> pp_prov prov
-
-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 '?'
+    if codeStyle sty then
+       pprUnique uniq          -- When printing in code we required all names to 
+                               -- be globally unique; for example, we use this identifier
+                               -- for the closure name.  So we just print the unique alone.
+    else
+       pprOccName occ <> pp_local_extra sty uniq
+  where
+    sys_local = case prov of
+                 SystemProv -> True
+                 other      -> False

 
 

--- pprNameProvenance is used in error messages to say where a name came from
-pprNameProvenance :: Name -> SDoc
-pprNameProvenance (Local _ _)         = pprProvenance (LocalDef noSrcLoc NotExported)
-pprNameProvenance (Global _ _ _ prov) = pprProvenance prov
+    pp_local_extra sty uniq
+       | sys_local      = underscore <> pprUnique uniq         -- Must print uniques for sys_locals
+       | debugStyle sty = text "{-" <> pprUnique uniq <> text "-}"
+       | otherwise      = empty

 
 

-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")
+
+pprName (Name {n_sort = sort, n_uniq = uniq, n_occ = occ, n_prov = prov})
+       -- Globals, and wired in things
+  = getPprStyle $ \ sty ->
+    if codeStyle sty then
+       ppr mod <> underscore <> ppr occ
+    else
+       pp_mod_dot sty <> ppr occ <> pp_global_debug sty uniq prov
+  where
+    mod = nameSortModule sort
+
+    pp_mod_dot sty
+      = case prov of
+          SystemProv                                -> pp_qual mod user_sty
+               -- Hack alert!  Omit the qualifier on SystemProv things in user style
+                -- I claim such SystemProv things will also be WiredIn things.
+               -- We can't get the omit flag right
+               -- on wired in tycons etc (sigh) so we just leave it out in user style, 
+               -- and hope that leaving it out isn't too consfusing.
+               -- (e.g. if the programmer hides Bool and  redefines it.  If so, use -dppr-debug.)
+
+          LocalDef _ _                              -> pp_qual mod (user_sty || iface_sty)
+
+          NonLocalDef (UserImport imp_mod _ _) omit 
+               | user_sty                           -> pp_qual imp_mod omit
+               | otherwise                          -> pp_qual mod     False
+          NonLocalDef ImplicitImport           omit -> pp_qual mod     (user_sty && omit)
+      where
+        user_sty  = userStyle sty
+        iface_sty = ifaceStyle sty
+    
+    pp_qual mod omit_qual
+        | omit_qual  = empty
+        | otherwise  = pprModule mod <> dot
+    
+    pp_global_debug sty uniq prov
+      | debugStyle sty = hcat [text "{-", pprUnique uniq, prov_p prov, text "-}"]
+      | otherwise      = empty
+
+    prov_p prov | opt_PprStyle_NoPrags = empty
+               | otherwise            = comma <> pp_prov prov
+
+pp_prov (LocalDef _ Exported)          = char 'x'
+pp_prov (LocalDef _ NotExported)       = char 'l'
+pp_prov (NonLocalDef ImplicitImport _) = char 'j'
+pp_prov (NonLocalDef (UserImport _ _ True ) _) = char 'I'      -- Imported by name
+pp_prov (NonLocalDef (UserImport _ _ False) _) = char 'i'      -- Imported by ..
+pp_prov SystemProv                    = char 's'

 \end{code}
 
 
 \end{code}
 
 

@@ -722,28 +671,24 @@ pprProvenance NoProvenance            = ptext SLIT("No provenance")
 
 \begin{code}
 class NamedThing a where
 
 \begin{code}
 class NamedThing a where

-    getOccName :: a -> OccName         -- Even RdrNames can do this!
+    getOccName :: a -> OccName

     getName    :: a -> Name
 
     getOccName n = nameOccName (getName n)     -- Default method
 \end{code}
 
 \begin{code}
     getName    :: a -> Name
 
     getOccName n = nameOccName (getName n)     -- Default method
 \end{code}
 
 \begin{code}

-modAndOcc          :: NamedThing a => a -> (Module, OccName)

 getSrcLoc          :: NamedThing a => a -> SrcLoc
 isLocallyDefined    :: NamedThing a => a -> Bool
 getSrcLoc          :: NamedThing a => a -> SrcLoc
 isLocallyDefined    :: NamedThing a => a -> Bool

-isExported         :: NamedThing a => a -> Bool

 getOccString       :: NamedThing a => a -> String
 getOccString       :: NamedThing a => a -> String

+toRdrName          :: NamedThing a => a -> RdrName

 
 

-modAndOcc          = nameModAndOcc        . getName
-isExported         = isExportedName       . getName

 getSrcLoc          = nameSrcLoc           . getName
 isLocallyDefined    = isLocallyDefinedName . getName
 getSrcLoc          = nameSrcLoc           . getName
 isLocallyDefined    = isLocallyDefinedName . getName

-getOccString x     = _UNPK_ (occNameString (getOccName x))
+getOccString x     = occNameString (getOccName x)
+toRdrName          = ifaceNameRdrName     . getName

 \end{code}
 
 \begin{code}
 \end{code}
 
 \begin{code}

-{-# SPECIALIZE isLocallyDefined
-       :: Name     -> Bool
-  #-}
+{-# SPECIALIZE isLocallyDefined :: Name -> Bool #-}

 \end{code}
 \end{code}