X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FName.lhs;h=0e4a36124bc0ba2870f0ebdf5ce216892ec8d8a8;hb=106d45f223f43d1565d96fade7293f7a1aeea210;hp=4a2b799acbafe1983fcd1e43e3906e86d6d1c759;hpb=26741ec416bae2c502ef00a2ba0e79050a32cb67;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs
index 4a2b799..0e4a361 100644
--- a/ghc/compiler/basicTypes/Name.lhs
+++ b/ghc/compiler/basicTypes/Name.lhs
@@ -7,327 +7,394 @@
 #include "HsVersions.h"
 
 module Name (
+	-- Re-export the Module type
 	SYN_IE(Module),
+	pprModule, moduleString,
 
-	OrigName(..), -- glorified pair
-	qualToOrigName, -- a Qual to an OrigName
-
-	RdrName(..),
-	preludeQual,
-	moduleNamePair,
-	isUnqual,
-	isQual,
-	isRdrLexCon, isRdrLexConOrSpecial,
-	appendRdr,
-	showRdr,
-	cmpRdr,
-
-	Name,
-	Provenance,
-	mkLocalName, isLocalName, 
-	mkTopLevName, mkImportedName, oddlyImportedName,
-	mkImplicitName,	isImplicitName,
-	mkPrimitiveName, mkWiredInName,
-	mkCompoundName, mkCompoundName2,
-
-	mkFunTyConName, mkTupleDataConName, mkTupleTyConName,
-	mkTupNameStr,
-
-	NamedThing(..), -- class
+	-- The OccName type
+	OccName(..),
+	pprOccName, occNameString, occNameFlavour, 
+	isTvOcc, isTCOcc, isVarOcc, prefixOccName,
+	uniqToOccName,
+
+	-- The Name type
+	Name,					-- Abstract
+	mkLocalName, mkSysLocalName, 
+
+	mkCompoundName, mkGlobalName, mkInstDeclName,
+
+	mkWiredInIdName,   mkWiredInTyConName,
+	maybeWiredInIdName, maybeWiredInTyConName,
+	isWiredInName,
+
+	nameUnique, changeUnique, setNameProvenance, getNameProvenance,
+	setNameVisibility,
+	nameOccName, nameString, nameModule,
+
+	isExportedName,	nameSrcLoc,
+	isLocallyDefinedName,
+
+	isLocalName, 
+
+        pprNameProvenance,
+
+	-- Sets of Names
+	SYN_IE(NameSet),
+	emptyNameSet, unitNameSet, mkNameSet, unionNameSets, unionManyNameSets,
+	minusNameSet, elemNameSet, nameSetToList, addOneToNameSet, addListToNameSet, isEmptyNameSet,
+
+	-- Misc
+	Provenance(..), pprProvenance,
 	ExportFlag(..),
-	isExported{-overloaded-}, exportFlagOn{-not-},
-
-	nameUnique, changeUnique,
-	nameOccName,
---	nameOrigName, : not exported
-	nameExportFlag,
-	nameSrcLoc,
-	nameImpLocs,
-	nameImportFlag,
-	isLocallyDefinedName, isWiredInName,
-
-	origName, moduleOf, nameOf,
-	getOccName, getExportFlag,
-	getSrcLoc, getImpLocs,
-	isLocallyDefined,
-	getLocalName,
-
-	isSymLexeme, pprSym, pprNonSym,
-	isLexCon, isLexVar, isLexId, isLexSym, isLexSpecialSym,
-	isLexConId, isLexConSym, isLexVarId, isLexVarSym
+
+	-- Class NamedThing and overloaded friends
+	NamedThing(..),
+	modAndOcc, isExported, 
+	getSrcLoc, isLocallyDefined, getOccString
     ) where
 
 IMP_Ubiq()
-IMPORT_1_3(Char(isUpper,isLower))
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 201
+IMPORT_DELOOPER(TyLoop)	( GenId, Id(..), TyCon )			-- Used inside Names
+#else
+import {-# SOURCE #-} Id    ( Id )
+import {-# SOURCE #-} TyCon ( TyCon )
+#endif
 
-import CmdLineOpts	( maybe_CompilingGhcInternals )
 import CStrings		( identToC, modnameToC, cSEP )
-import Outputable	( Outputable(..) )
-import PprStyle		( PprStyle(..), codeStyle )
-import PrelMods		( pRELUDE )
+import CmdLineOpts	( opt_OmitInterfacePragmas, opt_EnsureSplittableC, all_toplev_ids_visible )
+import BasicTypes	( SYN_IE(Module), IfaceFlavour(..), moduleString, pprModule )
+
+import Outputable	( Outputable(..), PprStyle(..), codeStyle, ifaceStyle )
+import PrelMods		( gHC__ )
 import Pretty
-import SrcLoc		( mkBuiltinSrcLoc, mkUnknownSrcLoc, SrcLoc )
-import Unique		( funTyConKey, mkTupleDataConUnique, mkTupleTyConUnique,
-			  pprUnique, Unique
-			)
-import Util		( thenCmp, _CMP_STRING_, nOfThem, panic, assertPanic, pprTrace{-ToDo:rm-} )
-import {-hide from mkdependHS-}
-	RnHsSyn		( RnName ) -- instance for specializing only
-
-#ifdef REALLY_HASKELL_1_3
-ord = fromEnum :: Char -> Int
-#endif
+import Lex		( isLexSym, isLexConId )
+import SrcLoc		( noSrcLoc, SrcLoc )
+import Usage            ( SYN_IE(UVar), SYN_IE(Usage) )
+import Unique		( pprUnique, showUnique, Unique, Uniquable(..) )
+import UniqSet		( UniqSet(..), emptyUniqSet, unitUniqSet, unionUniqSets, uniqSetToList, isEmptyUniqSet,
+		 	  unionManyUniqSets, minusUniqSet, mkUniqSet, elementOfUniqSet, addListToUniqSet, addOneToUniqSet )
+import UniqFM		( UniqFM )
+import Util		( Ord3(..), cmpPString, panic, assertPanic {-, pprTrace ToDo:rm-} )
 \end{code}
 
+
 %************************************************************************
 %*									*
-\subsection[RdrName]{The @RdrName@ datatype; names read from files}
+\subsection[Name-pieces-datatypes]{The @OccName@ datatypes}
 %*									*
 %************************************************************************
 
 \begin{code}
-type Module = FAST_STRING
+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)
+
+occNameString :: OccName -> FAST_STRING
+occNameString (VarOcc s)  = s
+occNameString (TvOcc s)   = s
+occNameString (TCOcc s)   = 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 `cmp` b) of { EQ_ -> True;  _ -> False }
+    a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True }
 
-data OrigName = OrigName Module FAST_STRING
+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  }
 
-qualToOrigName (Qual m n) = OrigName m n
+instance Ord3 OccName where
+    cmp = cmpOcc
 
-data RdrName
-  = Unqual FAST_STRING
-  | Qual   Module FAST_STRING
+(VarOcc s1) `cmpOcc` (VarOcc s2) = s1 `_CMP_STRING_` s2
+(VarOcc s1) `cmpOcc` other2      = LT_
 
-preludeQual n = Qual pRELUDE n
+(TvOcc s1)  `cmpOcc` (VarOcc s2) = GT_
+(TvOcc s1)  `cmpOcc` (TvOcc s2)  = s1 `_CMP_STRING_` s2
+(TvOcc s1)  `cmpOcc` other	 = LT_
 
-moduleNamePair (Qual m n) = (m, n)  -- we make *no* claim whether this
-				    -- constitutes an original name or
-				    -- an occurrence name, or anything else
+(TCOcc s1) `cmpOcc` (TCOcc s2) = s1 `_CMP_STRING_` s2
+(TCOcc s1) `cmpOcc` other      = GT_
 
-isUnqual (Unqual _) = True
-isUnqual (Qual _ _) = False
+instance Outputable OccName where
+  ppr = pprOccName
+\end{code}
 
-isQual (Unqual _) = False
-isQual (Qual _ _) = True
 
-isRdrLexCon (Unqual n) = isLexCon n
-isRdrLexCon (Qual m n) = isLexCon n
+%************************************************************************
+%*									*
+\subsection[Name-datatype]{The @Name@ datatype, and name construction}
+%*									*
+%************************************************************************
+ 
+\begin{code}
+data Name
+  = Local    Unique
+             OccName
+             SrcLoc
 
-isRdrLexConOrSpecial (Unqual n) = isLexCon n || isLexSpecialSym n
-isRdrLexConOrSpecial (Qual m n) = isLexCon n || isLexSpecialSym n
+  | Global   Unique
+	     Module		-- The defining module
+	     OccName		-- Its name in that module
+             Provenance		-- How it was defined
+\end{code}
 
-appendRdr (Unqual n) str = Unqual (n _APPEND_ str)
-appendRdr (Qual m n) str = Qual m (n _APPEND_ str)
+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.
 
-cmpRdr (Unqual  n1) (Unqual  n2) = _CMP_STRING_ n1 n2
-cmpRdr (Unqual  n1) (Qual m2 n2) = LT_
-cmpRdr (Qual m1 n1) (Unqual  n2) = GT_
-cmpRdr (Qual m1 n1) (Qual m2 n2) = _CMP_STRING_ n1 n2 `thenCmp` _CMP_STRING_ m1 m2
-				   -- always compare module-names *second*
+\begin{code}
+data Provenance
+  = LocalDef ExportFlag SrcLoc		-- Locally defined
+  | Imported Module SrcLoc IfaceFlavour	-- Directly imported from M; 
+					-- 		gives name of module in import statement
+					--		and locn of import statement
+  | Implicit IfaceFlavour		-- Implicitly imported
+  | WiredInTyCon TyCon			-- There's a wired-in version
+  | WiredInId    Id			-- ...ditto...
+\end{code}
 
-cmpOrig (OrigName m1 n1) (OrigName m2 n2)
-  = _CMP_STRING_ n1 n2 `thenCmp` _CMP_STRING_ m1 m2 -- again; module-names *second*
+Something is "Exported" if it may be mentioned by another module without
+warning.  The crucial thing about Exported things is that they must
+never be dropped as dead code, even if they aren't used in this module.
+Furthermore, being Exported means that we can't see all call sites of the thing.
 
-instance Eq RdrName where
-    a == b = case (a `cmp` b) of { EQ_ -> True;  _ -> False }
-    a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True }
+Exported things include:
+	- explicitly exported Ids, including data constructors, class method selectors
+	- dfuns from instance decls
 
-instance Ord RdrName 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  }
+Being Exported is *not* the same as finally appearing in the .o file's 
+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.
 
-instance Ord3 RdrName where
-    cmp = cmpRdr
-
-instance NamedThing RdrName where
-    -- We're sorta faking it here
-    getName (Unqual n)
-      = Local u n True locn
-      where
-	u    = panic "NamedThing.RdrName:Unique1"
-	locn = panic "NamedThing.RdrName:locn"
-
-    getName rdr_name@(Qual m n)
-      = Global u m (Left n) prov ex [rdr_name]
-      where
-	u    = panic "NamedThing.RdrName:Unique"
-	prov = panic "NamedThing.RdrName:Provenance"
-	ex   = panic "NamedThing.RdrName:ExportFlag"
-
-instance Outputable RdrName where
-    ppr sty (Unqual n) = pp_name sty n
-    ppr sty (Qual m n) = ppBeside (pp_mod sty m) (pp_name sty n)
-
-pp_mod sty m
-  = case sty of
-      PprForC		-> pp_code
-      PprForAsm False _ -> pp_code
-      PprForAsm True  _ -> ppBeside (ppPStr cSEP) pp_code
-      _			-> ppBeside (ppPStr m)    (ppChar '.')
-  where
-    pp_code = ppBeside (ppPStr (modnameToC m)) (ppPStr cSEP)
+\begin{code}
+data ExportFlag = Exported  | NotExported
+\end{code}
+
+\begin{code}
+mkLocalName    :: Unique -> OccName -> SrcLoc -> Name
+mkLocalName = Local
+
+mkGlobalName :: Unique -> Module -> OccName -> Provenance -> Name
+mkGlobalName = Global
+
+mkSysLocalName :: Unique -> FAST_STRING -> SrcLoc -> Name
+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)
+
+mkWiredInTyConName :: Unique -> Module -> FAST_STRING -> TyCon -> Name
+mkWiredInTyConName uniq mod occ tycon
+  = Global uniq mod (TCOcc occ) (WiredInTyCon tycon)
 
-pp_name sty n = (if codeStyle sty then identToC else ppPStr) n
 
-pp_name2 sty pieces
-  = ppIntersperse sep (map pp_piece pieces)
+mkCompoundName :: (FAST_STRING -> FAST_STRING)	-- Occurrence-name modifier
+	       -> Unique			-- New unique
+	       -> Name				-- Base name (must be a Global)
+	       -> Name		-- Result is always a value name
+
+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 prov
   where
-    sep = if codeStyle sty then ppPStr cSEP else ppChar '.'
+    prov | from_here = LocalDef Exported loc
+         | otherwise = Implicit HiFile		-- Odd
 
-    pp_piece (Left (OrigName m n)) = ppBeside (pp_mod sty m) (pp_name sty n)
-    pp_piece (Right n)		   = pp_name sty n
 
-showRdr sty rdr = ppShow 100 (ppr sty rdr)
+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 proveance of *any* global (SLPJ Jun 97)
+setNameProvenance (Global uniq mod occ _) prov = Global uniq mod occ prov
+setNameProvenance other_name 		  prov = other_name
 
--------------------------
-instance Eq OrigName where
-    a == b = case (a `cmp` b) of { EQ_ -> True;  _ -> False }
-    a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True }
+getNameProvenance :: Name -> Provenance
+getNameProvenance (Global uniq mod occ prov) = prov
+getNameProvenance (Local uniq occ locn)      = LocalDef NotExported locn
 
-instance Ord OrigName 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  }
+-- 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  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)
+
+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
 
-instance Ord3 OrigName where
-    cmp = cmpOrig
+\begin{code}
+setNameVisibility :: Maybe Module -> Unique -> Name -> Name
+
+setNameVisibility maybe_mod occ_uniq name@(Global uniq mod occ (LocalDef NotExported loc))
+  | 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	 			-- Globalise Local name
+	   (uniqToOccName occ_uniq)
+	   (LocalDef NotExported loc)
+
+setNameVisibility maybe_mod occ_uniq (Local uniq occ loc)
+  = Local uniq (uniqToOccName occ_uniq) loc	-- New OccName for Local
 
-instance NamedThing OrigName where -- faking it
-    getName (OrigName m n) = getName (Qual m n)
+uniqToOccName uniq = VarOcc (_PK_ ('$':showUnique 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
 
-instance Outputable OrigName where -- ditto
-    ppr sty (OrigName m n) = ppr sty (Qual m n)
 \end{code}
 
 %************************************************************************
 %*									*
-\subsection[Name-datatype]{The @Name@ datatype}
+\subsection{Predicates and selectors}
 %*									*
 %************************************************************************
 
 \begin{code}
-data Name
-  = Local    Unique
-             FAST_STRING
-	     Bool	-- True <=> emphasize Unique when
-			-- printing; this is just an esthetic thing...
-             SrcLoc
+nameUnique		:: Name -> Unique
+nameModAndOcc		:: Name -> (Module, OccName)	-- Globals only
+nameOccName		:: Name -> OccName 
+nameModule		:: Name -> Module
+nameString		:: Name -> FAST_STRING		-- A.b form
+nameSrcLoc		:: Name -> SrcLoc
+isLocallyDefinedName	:: Name -> Bool
+isExportedName		:: Name -> Bool
+isWiredInName		:: Name -> Bool
+isLocalName		:: Name -> Bool
 
-  | Global   Unique
-             Module	-- original name
-	     (Either
-		FAST_STRING -- just an ordinary M.n name... or...
-		([Either OrigName FAST_STRING]))
-			    -- "dot" these bits of name together...
-             Provenance -- where it came from
-             ExportFlag -- is it exported?
-             [RdrName]  -- ordered occurrence names (usually just one);
-			-- first may be *un*qual.
 
-data Provenance
-  = LocalDef SrcLoc     -- locally defined; give its source location
-			
-  | Imported ExportFlag	-- how it was imported
-	     SrcLoc     -- *original* source location
-             [SrcLoc]   -- any import source location(s)
-
-  | Implicit
-  | Primitive		-- really and truly primitive thing (not
-			-- definable in Haskell)
-  | WiredIn  Bool	-- something defined in Haskell; True <=>
-			-- definition is in the module in question;
-			-- this probably comes from the -fcompiling-prelude=...
-			-- flag.
-\end{code}
 
-\begin{code}
-mkLocalName = Local
+nameUnique (Local  u _ _)   = u
+nameUnique (Global u _ _ _) = u
 
-mkTopLevName   u (OrigName m n) locn exp occs = Global u m (Left n) (LocalDef locn) exp occs
-mkImportedName u (OrigName m n) imp locn imp_locs exp occs = Global u m (Left n) (Imported imp locn imp_locs) exp occs
+nameOccName (Local _ occ _)    = occ
+nameOccName (Global _ _ occ _) = occ
 
-mkImplicitName :: Unique -> OrigName -> Name
-mkImplicitName u (OrigName m n) = Global u m (Left n) Implicit NotExported []
+nameModule (Global _ mod occ _) = mod
 
-mkPrimitiveName :: Unique -> OrigName -> Name
-mkPrimitiveName u (OrigName m n)  = Global u m (Left n) Primitive NotExported []
+nameModAndOcc (Global _ mod occ _) = (mod,occ)
 
-mkWiredInName :: Unique -> OrigName -> ExportFlag -> Name
-mkWiredInName u (OrigName m n) exp
-  = Global u m (Left n) (WiredIn from_here) exp []
-  where
-    from_here
-      = case maybe_CompilingGhcInternals of
-          Nothing  -> False
-	  Just mod -> mod == _UNPK_ m
-
-mkCompoundName :: Unique
-	       -> Module
-	       -> FAST_STRING	-- indicates what kind of compound thing it is (e.g., "sdsel")
-	       -> [Either OrigName FAST_STRING]	-- "dot" these names together
-	       -> Name		-- from which we get provenance, etc....
-	       -> Name		-- result!
-
-mkCompoundName u m str ns (Local _ _ _ _) = panic "mkCompoundName:Local?"
-mkCompoundName u m str ns (Global _ _ _ prov exp _)
-  = Global u m (Right (Right str : ns)) prov exp []
-
-glue = glue1
-glue1 (Left (OrigName m n):ns) = m : _CONS_ '.' n : glue2 ns
-glue1 (Right n            :ns) = n 		  : glue2 ns
-glue2 []		       = []
-glue2 (Left (OrigName m n):ns) = _CONS_ '.' m : _CONS_ '.' n : glue2 ns
-glue2 (Right n            :ns) = _CONS_ '.' n		     : glue2 ns
-
--- this ugly one is used for instance-y things
-mkCompoundName2 :: Unique
-		-> Module
-		-> FAST_STRING	-- indicates what kind of compound thing it is
-		-> [Either OrigName FAST_STRING] -- "dot" these names together
-		-> Bool		-- True <=> defined in this module
-		-> SrcLoc	
-		-> Name		-- result!
-
-mkCompoundName2 u m str ns from_here locn
-  = Global u m (Right (Right str : ns))
-	     (if from_here then LocalDef locn else Imported ExportAll locn [])
-	     ExportAll{-instances-}
-	     []
-
-mkFunTyConName
-  = mkPrimitiveName funTyConKey		       (OrigName pRELUDE SLIT("->"))
-mkTupleDataConName arity
-  = mkWiredInName (mkTupleDataConUnique arity) (OrigName pRELUDE (mkTupNameStr arity)) ExportAll
-mkTupleTyConName   arity
-  = mkWiredInName (mkTupleTyConUnique   arity) (OrigName pRELUDE (mkTupNameStr arity)) ExportAll
-
-mkTupNameStr 0 = SLIT("()")
-mkTupNameStr 1 = panic "Name.mkTupNameStr: 1 ???"
-mkTupNameStr 2 = SLIT("(,)")   -- not strictly necessary
-mkTupNameStr 3 = SLIT("(,,)")  -- ditto
-mkTupNameStr 4 = SLIT("(,,,)") -- ditto
-mkTupNameStr n
-  = _PK_ ("(" ++ nOfThem (n-1) ',' ++ ")")
-
-	-- ToDo: what about module ???
-	-- ToDo: exported when compiling builtin ???
-
-isLocalName (Local _ _ _ _) = True
-isLocalName _ 		    = False
-
--- things the compiler "knows about" are in some sense
+nameString (Local _ occ _)      = occNameString occ
+nameString (Global _ mod occ _) = mod _APPEND_ SLIT(".") _APPEND_ occNameString occ
+
+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
+  
+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.
-oddlyImportedName (Global _ _ _ Primitive   _ _) = True
-oddlyImportedName (Global _ _ _ (WiredIn _) _ _) = True
-oddlyImportedName _				 = False
+isWiredInName (Global _ _ _ (WiredInTyCon _)) = True
+isWiredInName (Global _ _ _ (WiredInId    _)) = True
+isWiredInName _				          = False
+
+maybeWiredInIdName :: Name -> Maybe Id
+maybeWiredInIdName (Global _ _ _ (WiredInId id)) = Just id
+maybeWiredInIdName other			 = Nothing
+
+maybeWiredInTyConName :: Name -> Maybe TyCon
+maybeWiredInTyConName (Global _ _ _ (WiredInTyCon tc)) = Just tc
+maybeWiredInTyConName other			       = Nothing
 
-isImplicitName (Global _ _ _ Implicit _ _) = True
-isImplicitName _ 		           = False
+
+isLocalName (Local _ _ _) = True
+isLocalName _ 		  = False
 \end{code}
 
+
 %************************************************************************
 %*									*
 \subsection[Name-instances]{Instance declarations}
@@ -337,10 +404,10 @@ isImplicitName _ 		           = 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 _ _)   = cmp u1 u2
+    c (Local   _ _ _)	  _		  = LT_
+    c (Global u1 _ _ _) (Global u2 _ _ _) = cmp u1 u2
+    c (Global  _ _ _ _)   _		  = GT_
 \end{code}
 
 \begin{code}
@@ -364,123 +431,106 @@ instance NamedThing Name where
     getName n = n
 \end{code}
 
-\begin{code}
-nameUnique (Local  u _ _ _)     = u
-nameUnique (Global u _ _ _ _ _) = u
 
--- 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 b l)    u = Local u n b l
-changeUnique (Global   _ m n p e os) u = Global u m n p e os
-
-nameOrigName msg (Global _ m (Left  n) _ _ _) = OrigName m n
-nameOrigName msg (Global _ m (Right n) _ _ _) = let str = _CONCAT_ (glue n) in
-						pprTrace ("nameOrigName:"++msg) (ppPStr str) $
-						OrigName m str
-#ifdef DEBUG
-nameOrigName msg (Local  _ n _ _)     = panic ("nameOrigName:Local:"++msg++":"++ _UNPK_ n)
-#endif
 
-nameOccName (Local  _ n _ _)	     = Unqual n
-nameOccName (Global _ m (Left  n) _ _ []  )  = Qual m n
-nameOccName (Global _ m (Right n) _ _ []  )  =  let str = _CONCAT_ (glue n) in
-						pprTrace "nameOccName:" (ppPStr str) $
-						Qual m str
-nameOccName (Global _ m (Left  _) _ _ (o:_)) = o
-nameOccName (Global _ m (Right _) _ _ (o:_)) = panic "nameOccName:compound name"
-
-nameExportFlag (Local  _ _ _ _)       = NotExported
-nameExportFlag (Global _ _ _ _ exp _) = exp
-
-nameSrcLoc (Local  _ _ _ loc)	                 = loc
-nameSrcLoc (Global _ _ _ (LocalDef loc)     _ _) = loc
-nameSrcLoc (Global _ _ _ (Imported _ loc _) _ _) = loc
-nameSrcLoc (Global _ _ _ Implicit           _ _) = mkUnknownSrcLoc
-nameSrcLoc (Global _ _ _ Primitive          _ _) = mkBuiltinSrcLoc
-nameSrcLoc (Global _ _ _ (WiredIn _)        _ _) = mkBuiltinSrcLoc
-  
-nameImpLocs (Global _ _ _ (Imported _ _ locs) _ _) = locs
-nameImpLocs _ 					   = []
-
-nameImportFlag (Local  _ _ _ _)                      = NotExported
-nameImportFlag (Global _ _ _ (LocalDef _)       _ _) = ExportAll
-nameImportFlag (Global _ _ _ (Imported exp _ _) _ _) = exp
-nameImportFlag (Global _ _ _ Implicit           _ _) = ExportAll
-nameImportFlag (Global _ _ _ Primitive          _ _) = ExportAll
-nameImportFlag (Global _ _ _ (WiredIn _)        _ _) = ExportAll
-
-isLocallyDefinedName (Local  _ _ _ _)	            	    = True
-isLocallyDefinedName (Global _ _ _ (LocalDef _)        _ _) = True
-isLocallyDefinedName (Global _ _ _ (Imported _ _ _)    _ _) = False
-isLocallyDefinedName (Global _ _ _ Implicit            _ _) = False
-isLocallyDefinedName (Global _ _ _ Primitive           _ _) = False
-isLocallyDefinedName (Global _ _ _ (WiredIn from_here) _ _) = from_here
-
-isWiredInName (Global _ _ _ (WiredIn _) _ _) = True
-isWiredInName _				     = False
-\end{code}
+%************************************************************************
+%*									*
+\subsection{Pretty printing}
+%*									*
+%************************************************************************
 
 \begin{code}
 instance Outputable Name where
-    ppr sty (Local u n emph_uniq _)
-      | codeStyle sty = pprUnique u
-      | emph_uniq     = ppBesides [pprUnique u, ppStr "{-", ppPStr n, ppStr "-}"]
-      | otherwise     = ppBesides [ppPStr n, ppStr "{-", pprUnique u, ppStr "-}"]
-
-    ppr PprDebug   (Global   u m (Left  n) _ _ _) = ppBesides [pp_mod PprDebug m, pp_name  PprDebug n, ppStr "{-", pprUnique u, ppStr "-}"]
-    ppr PprDebug   (Global   u m (Right n) _ _ _) = ppBesides [pp_mod PprDebug m, pp_name2 PprDebug n, ppStr "{-", pprUnique u, ppStr "-}"]
-
-    ppr PprForUser (Global   u m (Left  n) _ _ []  ) = ppBeside (pp_mod PprForUser m) (pp_name  PprForUser n)
-    ppr PprForUser (Global   u m (Right n) _ _ []  ) = ppBeside (pp_mod PprForUser m) (pp_name2 PprForUser n)
-    ppr PprForUser (Global   u m (Left  _) _ _ occs) = ppr PprForUser (head occs)
-
--- LATER:?
---  ppr PprShowAll (Global   u m n prov exp occs) = pp_all (Qual m n) prov exp occs
-
-    ppr sty (Global u m (Left  n) _ _ _) = ppBeside (pp_mod sty m) (pp_name  sty n)
-    ppr sty (Global u m (Right n) _ _ _) = ppBeside (pp_mod sty m) (pp_name2 sty n)
-
-pp_all orig prov exp occs
-  = ppBesides [ppr PprShowAll orig, ppr PprShowAll occs, pp_prov prov, pp_exp exp]
-
-pp_exp NotExported = ppNil
-pp_exp ExportAll   = ppPStr SLIT("/EXP(..)")
-pp_exp ExportAbs   = ppPStr SLIT("/EXP")
-
-pp_prov Implicit    = ppPStr SLIT("/IMPLICIT")
-pp_prov Primitive   = ppPStr SLIT("/PRIMITIVE")
-pp_prov (WiredIn _) = ppPStr SLIT("/WIREDIN")
-pp_prov _           = ppNil
+    ppr PprQuote name@(Local _ _ _)  = quotes (ppr (PprForUser 1) name)
+
+	-- When printing interfaces, all Locals have been given nice print-names
+    ppr (PprForUser _) (Local _ n _) = ptext (occNameString n)
+    ppr PprInterface   (Local _ n _) = ptext (occNameString n)
+
+    ppr sty (Local u n _) | codeStyle 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_dot, ptext (occNameString n), pp_debug sty name]
+	where
+	  pp_mod = pprModule (PprForUser 1) m 
+	  pp_mod_dot = case prov of				--- Omit home module qualifier
+			LocalDef _ _     -> empty
+			Imported _ _ hif -> pp_mod <> pp_dot hif
+			Implicit hif     -> pp_mod <> pp_dot hif
+			other		 -> pp_mod <> text "."
+
+	  pp_dot HiFile     = text "."		-- Vanilla case
+	  pp_dot HiBootFile = text "!"		-- M!t indicates a name imported from a .hi-boot interface
+
+
+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_prov (WiredInTyCon _) = char 'W'
+						pp_prov (WiredInId _)    = char 'w'
+pp_debug other    name 		        = empty
+
+-- 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"
+pprProvenance sty (WiredInTyCon tc) = ptext SLIT("Wired-in tycon")
+pprProvenance sty (WiredInId id)    = ptext SLIT("Wired-in id")
 \end{code}
 
+
 %************************************************************************
 %*									*
-\subsection[ExportFlag-datatype]{The @ExportFlag@ datatype}
+\subsection[Sets of names}
 %*									*
 %************************************************************************
 
-The export flag @ExportAll@ means `export all there is', so there are
-times when it is attached to a class or data type which has no
-ops/constructors (if the class/type was imported abstractly).  In
-fact, @ExportAll@ is attached to everything except to classes/types
-which are being {\em exported} abstractly, regardless of how they were
-imported.
-
 \begin{code}
-data ExportFlag
-  = ExportAll		-- export with all constructors/methods
-  | ExportAbs		-- export abstractly (tycons/classes only)
-  | NotExported
-
-exportFlagOn NotExported = False
-exportFlagOn _		 = True
+type NameSet = UniqSet Name
+emptyNameSet	  :: NameSet
+unitNameSet	  :: Name -> NameSet
+addListToNameSet  :: NameSet -> [Name] -> NameSet
+addOneToNameSet   :: NameSet -> Name -> NameSet
+mkNameSet         :: [Name] -> NameSet
+unionNameSets	  :: NameSet -> NameSet -> NameSet
+unionManyNameSets :: [NameSet] -> NameSet
+minusNameSet 	  :: NameSet -> NameSet -> NameSet
+elemNameSet	  :: Name -> NameSet -> Bool
+nameSetToList	  :: NameSet -> [Name]
+isEmptyNameSet	  :: NameSet -> Bool
+
+isEmptyNameSet    = isEmptyUniqSet
+emptyNameSet	  = emptyUniqSet
+unitNameSet	  = unitUniqSet
+mkNameSet         = mkUniqSet
+addListToNameSet  = addListToUniqSet
+addOneToNameSet	  = addOneToUniqSet
+unionNameSets     = unionUniqSets
+unionManyNameSets = unionManyUniqSets
+minusNameSet	  = minusUniqSet
+elemNameSet       = elementOfUniqSet
+nameSetToList     = uniqSetToList
+\end{code}
 
--- Be very wary about using "isExported"; perhaps you
--- really mean "externallyVisibleId"?
 
-isExported a = exportFlagOn (getExportFlag a)
-\end{code}
 
 %************************************************************************
 %*									*
@@ -490,140 +540,30 @@ isExported a = exportFlagOn (getExportFlag a)
 
 \begin{code}
 class NamedThing a where
-    getName :: a -> Name
+    getOccName :: a -> OccName		-- Even RdrNames can do this!
+    getName    :: a -> Name
+
+    getOccName n = nameOccName (getName n)	-- Default method
 \end{code}
 
 \begin{code}
-origName	    :: NamedThing a => String -> a -> OrigName
-moduleOf	    :: OrigName -> Module
-nameOf		    :: OrigName -> FAST_STRING
-
-getOccName	    :: NamedThing a => a -> RdrName
-getLocalName	    :: NamedThing a => a -> FAST_STRING
-getExportFlag	    :: NamedThing a => a -> ExportFlag
+modAndOcc	    :: NamedThing a => a -> (Module, OccName)
+getModule	    :: NamedThing a => a -> Module
 getSrcLoc	    :: NamedThing a => a -> SrcLoc
-getImpLocs	    :: NamedThing a => a -> [SrcLoc]
 isLocallyDefined    :: NamedThing a => a -> Bool
+isExported	    :: NamedThing a => a -> Bool
+getOccString	    :: NamedThing a => a -> String
 
-origName str n	    = nameOrigName str (getName n)
-
-moduleOf (OrigName m n) = m
-nameOf   (OrigName m n) = n
-
-getLocalName n
-  = case (getName n) of
-      Local  _ n _ _	         -> n
-      Global _ m (Left  n) _ _ _ -> n
-      Global _ m (Right n) _ _ _ -> let str = _CONCAT_ (glue n) in
-				    -- pprTrace "getLocalName:" (ppPStr str) $
-				    str
-
-getOccName	    = nameOccName  	   . getName
-getExportFlag	    = nameExportFlag	   . getName
+modAndOcc	    = nameModAndOcc	   . getName
+getModule	    = nameModule	   . getName
+isExported	    = isExportedName 	   . getName
 getSrcLoc	    = nameSrcLoc	   . getName
-getImpLocs	    = nameImpLocs	   . getName
 isLocallyDefined    = isLocallyDefinedName . getName
+getOccString x	    = _UNPK_ (occNameString (getOccName x))
 \end{code}
 
 \begin{code}
-{-# SPECIALIZE getLocalName
-	:: Name     -> FAST_STRING
-	 , OrigName -> FAST_STRING
-	 , RdrName  -> FAST_STRING
-	 , RnName   -> FAST_STRING
-  #-}
 {-# SPECIALIZE isLocallyDefined
 	:: Name	    -> Bool
-	 , RnName   -> Bool
-  #-}
-{-# SPECIALIZE origName
-	:: String -> Name     -> OrigName
-	 , String -> RdrName  -> OrigName
-	 , String -> RnName   -> OrigName
   #-}
 \end{code}
-
-These functions test strings to see if they fit the lexical categories
-defined in the Haskell report.  Normally applied as in e.g. @isCon
-(getLocalName foo)@.
-
-\begin{code}
-isLexCon, isLexVar, isLexId, isLexSym, isLexConId, isLexConSym,
- isLexVarId, isLexVarSym, isLexSpecialSym :: FAST_STRING -> Bool
-
-isLexCon cs = isLexConId  cs || isLexConSym cs
-isLexVar cs = isLexVarId  cs || isLexVarSym cs
-
-isLexId  cs = isLexConId  cs || isLexVarId  cs
-isLexSym cs = isLexConSym cs || isLexVarSym cs
-
--------------
-
-isLexConId cs
-  | _NULL_ cs	= False
-  | otherwise	= isUpper c || isUpperISO c
-  where					
-    c = _HEAD_ cs
-
-isLexVarId cs
-  | _NULL_ cs	 = False
-  | otherwise    = isLower c || isLowerISO c
-  where
-    c = _HEAD_ cs
-
-isLexConSym cs
-  | _NULL_ cs	= False
-  | otherwise	= c  == ':'
---	       || c  == '('	-- (), (,), (,,), ...
-	       || cs == SLIT("->")
---	       || cs == SLIT("[]")
-  where
-    c = _HEAD_ cs
-
-isLexVarSym cs
-  | _NULL_ cs = False
-  | otherwise = isSymbolASCII c
-	     || isSymbolISO c
---	     || c  == '('	-- (), (,), (,,), ...
---	     || cs == SLIT("[]")
-  where
-    c = _HEAD_ cs
-
-isLexSpecialSym cs
-  | _NULL_ cs = False
-  | otherwise = c  == '('	-- (), (,), (,,), ...
-	     || cs == SLIT("[]")
-  where
-    c = _HEAD_ cs
-
--------------
-isSymbolASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"
-isSymbolISO   c = ord c `elem` (0xd7 : 0xf7 : [0xa1 .. 0xbf])
-isUpperISO    c = 0xc0 <= oc && oc <= 0xde && oc /= 0xd7 where oc = ord c
-isLowerISO    c = 0xdf <= oc && oc <= 0xff && oc /= 0xf7 where oc = ord c
-\end{code}
-
-And one ``higher-level'' interface to those:
-
-\begin{code}
-isSymLexeme :: NamedThing a => a -> Bool
-
-isSymLexeme v
-  = let str = getLocalName v in isLexSym str
-
--- print `vars`, (op) correctly
-pprSym, pprNonSym :: (NamedThing name, Outputable name) => PprStyle -> name -> Pretty
-
-pprSym sty var
-  = let
-	str = getLocalName var
-    in
-    if isLexSym str && not (isLexSpecialSym str)
-    then ppr sty var
-    else ppBesides [ppChar '`', ppr sty var, ppChar '`']
-
-pprNonSym sty var
-  = if isSymLexeme var
-    then ppParens (ppr sty var)
-    else ppr sty var
-\end{code}