X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FName.lhs;h=adb1082e49185b5323139a9b3e9390f0514c3733;hb=bb88e732b7383c10496c0f60c3bdea2c22362cc6;hp=7747daf66e765add9309d4b8e5740680f0771f20;hpb=ae45ff0e9831a0dc862a5d68d03e355d7e323c62;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs
index 7747daf..adb1082 100644
--- a/ghc/compiler/basicTypes/Name.lhs
+++ b/ghc/compiler/basicTypes/Name.lhs
@@ -1,313 +1,279 @@
 %
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
 \section[Name]{@Name@: to transmit name info from renamer to typechecker}
 
 \begin{code}
-#include "HsVersions.h"
-
 module Name (
-	Module(..),
-
-	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
-	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
+	-- Re-export the OccName stuff
+	module OccName,
+
+	-- The Name type
+	Name,					-- Abstract
+	BuiltInSyntax(..), 
+	mkInternalName, mkSystemName, 
+	mkSystemNameEncoded, mkSysTvName, 
+	mkFCallName, mkIPName,
+	mkExternalName, mkWiredInName,
+
+	nameUnique, setNameUnique,
+	nameOccName, nameModule, nameModule_maybe, nameModuleName,
+	setNameOcc, 
+	hashName, localiseName,
+
+	nameSrcLoc, nameParent, nameParent_maybe,
+
+	isSystemName, isInternalName, isExternalName,
+	isTyVarName, isDllName, isWiredInName, isBuiltInSyntax,
+	wiredInNameTyThing_maybe, 
+	nameIsLocalOrFrom, isHomePackageName,
+	
+	-- Class NamedThing and overloaded friends
+	NamedThing(..),
+	getSrcLoc, getOccString
     ) where
 
-IMP_Ubiq()
-
-import CmdLineOpts	( maybe_CompilingPrelude )
-import CStrings		( identToC, cSEP )
-import Outputable	( Outputable(..) )
-import PprStyle		( PprStyle(..), codeStyle )
-import PrelMods		( pRELUDE )
-import Pretty
-import SrcLoc		( mkBuiltinSrcLoc, mkUnknownSrcLoc )
-import Unique		( funTyConKey, mkTupleDataConUnique, mkTupleTyConUnique,
-			  pprUnique, Unique
-			)
-import Util		( thenCmp, _CMP_STRING_, nOfThem, panic, assertPanic )
-
-#ifdef REALLY_HASKELL_1_3
-ord = fromEnum :: Char -> Int
-#endif
+#include "HsVersions.h"
+
+import {-# SOURCE #-} TypeRep( TyThing )
+
+import OccName		-- All of it
+import Module		( Module, ModuleName, moduleName, isHomeModule )
+import CmdLineOpts	( opt_Static )
+import SrcLoc		( noSrcLoc, wiredInSrcLoc, SrcLoc )
+import Unique		( Unique, Uniquable(..), getKey, pprUnique )
+import Maybes		( orElse )
+import FastTypes
+import Outputable
 \end{code}
 
 %************************************************************************
 %*									*
-\subsection[RdrName]{The @RdrName@ datatype; names read from files}
+\subsection[Name-datatype]{The @Name@ datatype, and name construction}
 %*									*
 %************************************************************************
-
+ 
 \begin{code}
-type Module = FAST_STRING
-
-data OrigName = OrigName Module FAST_STRING
+data Name = Name {
+		n_sort :: NameSort,	-- What sort of name it is
+		n_occ  :: !OccName,	-- Its occurrence name
+		n_uniq :: Unique,
+		n_loc  :: !SrcLoc	-- Definition site
+	    }
+
+-- NOTE: we make the n_loc field strict to eliminate some potential
+-- (and real!) space leaks, due to the fact that we don't look at
+-- the SrcLoc in a Name all that often.
+
+data NameSort
+  = External Module (Maybe Name)
+	-- (Just parent) => this Name is a subordinate name of 'parent'
+	-- e.g. data constructor of a data type, method of a class
+	-- Nothing => not a subordinate
+ 
+  | WiredIn Module (Maybe Name) TyThing BuiltInSyntax
+	-- A variant of External, for wired-in things
+
+  | Internal		-- A user-defined Id or TyVar
+			-- defined in the module being compiled
+
+  | System		-- A system-defined Id or TyVar.  Typically the
+			-- OccName is very uninformative (like 's')
+
+data BuiltInSyntax = BuiltInSyntax | UserSyntax
+-- BuiltInSyntax is for things like (:), [], tuples etc, 
+-- which have special syntactic forms.  They aren't "in scope"
+-- as such.
+\end{code}
 
-qualToOrigName (Qual m n) = OrigName m n
+Notes about the NameSorts:
 
-data RdrName
-  = Unqual FAST_STRING
-  | Qual   Module FAST_STRING
+1.  Initially, top-level Ids (including locally-defined ones) get External names, 
+    and all other local Ids get Internal names
 
-preludeQual n = Qual pRELUDE n
+2.  Things with a External 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 @External@ first.
 
-moduleNamePair (Qual m n) = (m, n)  -- we make *no* claim whether this
-				    -- constitutes an original name or
-				    -- an occurrence name, or anything else
+3.  In the tidy-core phase, a External that is not visible to an importer
+    is changed to Internal, and a Internal that is visible is changed to External
 
-isUnqual (Unqual _) = True
-isUnqual (Qual _ _) = False
+4.  A System Name differs in the following ways:
+	a) has unique attached when printing dumps
+	b) unifier eliminates sys tyvars in favour of user provs where possible
 
-isQual (Unqual _) = False
-isQual (Qual _ _) = True
+    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.
 
-isRdrLexCon (Unqual n) = isLexCon n
-isRdrLexCon (Qual m n) = isLexCon n
+Built-in syntax => It's a syntactic form, not "in scope" (e.g. [])
 
-isRdrLexConOrSpecial (Unqual n) = isLexCon n || isLexSpecialSym n
-isRdrLexConOrSpecial (Qual m n) = isLexCon n || isLexSpecialSym n
+Wired-in thing  => The thing (Id, TyCon) is fully known to the compiler, 
+		   not read from an interface file. 
+		   E.g. Bool, True, Int, Float, and many others
 
-appendRdr (Unqual n) str = Unqual (n _APPEND_ str)
-appendRdr (Qual m n) str = Qual m (n _APPEND_ str)
+All built-in syntax is for wired-in things.
 
-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}
+nameUnique		:: Name -> Unique
+nameOccName		:: Name -> OccName 
+nameModule		:: Name -> Module
+nameModuleName		:: Name -> ModuleName
+nameSrcLoc		:: Name -> SrcLoc
+
+nameUnique  name = n_uniq name
+nameOccName name = n_occ  name
+nameSrcLoc  name = n_loc  name
+\end{code}
 
-cmpOrig (OrigName m1 n1) (OrigName m2 n2)
-  = _CMP_STRING_ n1 n2 `thenCmp` _CMP_STRING_ m1 m2 -- again; module-names *second*
+\begin{code}
+nameIsLocalOrFrom :: Module -> Name -> Bool
+isInternalName	  :: Name -> Bool
+isExternalName	  :: Name -> Bool
+isSystemName	  :: Name -> Bool
+isHomePackageName :: Name -> Bool
+isWiredInName	  :: Name -> Bool
 
-instance Eq RdrName where
-    a == b = case (a `cmp` b) of { EQ_ -> True;  _ -> False }
-    a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True }
+isWiredInName (Name {n_sort = WiredIn _ _ _ _}) = True
+isWiredInName other			        = False
 
-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  }
+wiredInNameTyThing_maybe :: Name -> Maybe TyThing
+wiredInNameTyThing_maybe (Name {n_sort = WiredIn _ _ thing _}) = Just thing
+wiredInNameTyThing_maybe other				       = Nothing
 
-instance Ord3 RdrName where
-    cmp = cmpRdr
+isBuiltInSyntax (Name {n_sort = WiredIn _ _ _ BuiltInSyntax}) = True
+isBuiltInSyntax other			 		      = False
 
-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"
+isExternalName (Name {n_sort = External _ _})    = True
+isExternalName (Name {n_sort = WiredIn _ _ _ _}) = True
+isExternalName other	                         = False
 
-    getName rdr_name@(Qual m n)
-      = Global u m n prov ex [rdr_name]
-      where
-	u    = panic "NamedThing.RdrName:Unique"
-	prov = panic "NamedThing.RdrName:Provenance"
-	ex   = panic "NamedThing.RdrName:ExportFlag"
+isInternalName name = not (isExternalName name)
 
-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)
+nameParent_maybe :: Name -> Maybe Name
+nameParent_maybe (Name {n_sort = External _ p})    = p
+nameParent_maybe (Name {n_sort = WiredIn _ p _ _}) = p
+nameParent_maybe other	                           = Nothing
 
-pp_mod PprForC             m = ppBesides [identToC m, ppPStr cSEP]
-pp_mod (PprForAsm False _) m = ppBesides [identToC m, ppPStr cSEP]
-pp_mod (PprForAsm True  _) m = ppBesides [ppPStr cSEP, identToC m, ppPStr cSEP]
-pp_mod _                   m = ppBesides [ppPStr m, ppChar '.']
+nameParent :: Name -> Name
+nameParent name = case nameParent_maybe name of
+			Just parent -> parent
+			Nothing     -> name
 
-pp_name sty n | codeStyle sty = identToC n
-              | otherwise     = ppPStr n	      
+nameModule name = nameModule_maybe name `orElse` pprPanic "nameModule" (ppr name)
+nameModuleName name = moduleName (nameModule name)
 
-showRdr sty rdr = ppShow 100 (ppr sty rdr)
+nameModule_maybe (Name { n_sort = External mod _})    = Just mod
+nameModule_maybe (Name { n_sort = WiredIn mod _ _ _}) = Just mod
+nameModule_maybe name				      = Nothing
 
--------------------------
-instance Eq OrigName where
-    a == b = case (a `cmp` b) of { EQ_ -> True;  _ -> False }
-    a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True }
+nameIsLocalOrFrom from name
+  | isExternalName name = from == nameModule name
+  | otherwise		= True
 
-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  }
+isHomePackageName name
+  | isExternalName name = isHomeModule (nameModule name)
+  | otherwise		= True  	-- Internal and system names
 
-instance Ord3 OrigName where
-    cmp = cmpOrig
+isDllName :: Name -> Bool	-- Does this name refer to something in a different DLL?
+isDllName nm = not opt_Static && not (isHomePackageName nm)
 
-instance NamedThing OrigName where -- faking it
-    getName (OrigName m n) = getName (Qual m n)
+isTyVarName :: Name -> Bool
+isTyVarName name = isTvOcc (nameOccName name)
 
-instance Outputable OrigName where -- ditto
-    ppr sty (OrigName m n) = ppr sty (Qual m n)
+isSystemName (Name {n_sort = System}) = True
+isSystemName other		      = False
 \end{code}
 
+
 %************************************************************************
 %*									*
-\subsection[Name-datatype]{The @Name@ datatype}
+\subsection{Making names}
 %*									*
 %************************************************************************
 
 \begin{code}
-data Name
-  = Local    Unique
-             FAST_STRING
-	     Bool	-- True <=> emphasize Unique when
-			-- printing; this is just an esthetic thing...
-             SrcLoc
-
-  | Global   Unique
-             Module	-- original name
-	     FAST_STRING
-             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.
+mkInternalName :: Unique -> OccName -> SrcLoc -> Name
+mkInternalName uniq occ loc = Name { n_uniq = uniq, n_sort = Internal, n_occ = occ, n_loc = loc }
+	-- NB: You might worry that after lots of huffing and
+	-- puffing we might end up with two local names with distinct
+	-- uniques, but the same OccName.  Indeed we can, but that's ok
+	--	* the insides of the compiler don't care: they use the Unique
+	--	* when printing for -ddump-xxx you can switch on -dppr-debug to get the
+	--	  uniques if you get confused
+	--	* for interface files we tidyCore first, which puts the uniques
+	--	  into the print name (see setNameVisibility below)
+
+mkExternalName :: Unique -> Module -> OccName -> Maybe Name -> SrcLoc -> Name
+mkExternalName uniq mod occ mb_parent loc 
+  = Name { n_uniq = uniq, n_sort = External mod mb_parent,
+           n_occ = occ, n_loc = loc }
+
+mkWiredInName :: Module -> OccName -> Unique 
+	      -> Maybe Name -> TyThing -> BuiltInSyntax -> Name
+mkWiredInName mod occ uniq mb_parent thing built_in
+  = Name { n_uniq = uniq,
+	   n_sort = WiredIn mod mb_parent thing built_in,
+	   n_occ = occ, n_loc = wiredInSrcLoc }
+
+mkSystemName :: Unique -> UserFS -> Name
+mkSystemName uniq fs = Name { n_uniq = uniq, n_sort = System, 
+			      n_occ = mkVarOcc fs, n_loc = noSrcLoc }
+
+-- Use this version when the string is already encoded.  Avoids duplicating
+-- the string each time a new name is created.
+mkSystemNameEncoded :: Unique -> EncodedFS -> Name
+mkSystemNameEncoded uniq fs = Name { n_uniq = uniq, n_sort = System, 
+			             n_occ = mkSysOccFS varName fs, 
+				     n_loc = noSrcLoc }
+
+mkSysTvName :: Unique -> EncodedFS -> Name
+mkSysTvName uniq fs = Name { n_uniq = uniq, n_sort = System, 
+		             n_occ = mkSysOccFS tvName fs, 
+			     n_loc = noSrcLoc }
+
+mkFCallName :: Unique -> EncodedString -> Name
+	-- The encoded string completely describes the ccall
+mkFCallName uniq str =  Name { n_uniq = uniq, n_sort = Internal, 
+			       n_occ = mkFCallOcc str, n_loc = noSrcLoc }
+
+mkIPName :: Unique -> OccName -> Name
+mkIPName uniq occ
+  = Name { n_uniq = uniq,
+	   n_sort = Internal,
+	   n_occ  = occ,
+	   n_loc = noSrcLoc }
 \end{code}
 
 \begin{code}
-mkLocalName = Local
+-- 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}
 
-mkTopLevName   u (OrigName m n) locn exp occs = Global u m n (LocalDef locn) exp occs
-mkImportedName u (OrigName m n) imp locn imp_locs exp occs = Global u m n (Imported imp locn imp_locs) exp occs
+setNameOcc :: Name -> OccName -> Name
+setNameOcc name occ = name {n_occ = occ}
 
-mkImplicitName :: Unique -> OrigName -> Name
-mkImplicitName u (OrigName m n) = Global u m n Implicit NotExported []
+localiseName :: Name -> Name
+localiseName n = n { n_sort = Internal }
+\end{code}
 
-mkPrimitiveName :: Unique -> OrigName -> Name
-mkPrimitiveName u (OrigName m n)  = Global u m n Primitive NotExported []
 
-mkWiredInName :: Unique -> OrigName -> Name
-mkWiredInName u (OrigName m n)
-  = Global u m n (WiredIn from_here) (if from_here then ExportAll else NotExported) []
-  where
-    from_here
-      = case maybe_CompilingPrelude 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 (_CONCAT_ (glue ns [str])) prov exp []
-
-glue []                       acc = reverse acc
-glue (Left (OrigName m n):ns) acc = glue ns (_CONS_ '.' n : _CONS_ '.' m : acc)
-glue (Right n            :ns) acc = glue ns (_CONS_ '.' n : acc)
-
--- 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 (_CONCAT_ (glue ns [str]))
-	     (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))
-mkTupleTyConName   arity
-  = mkWiredInName (mkTupleTyConUnique   arity) (OrigName pRELUDE (mkTupNameStr arity))
-
-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
--- "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
-
-isImplicitName (Global _ _ _ Implicit _ _) = True
-isImplicitName _ 		           = False
+%************************************************************************
+%*									*
+\subsection{Predicates and selectors}
+%*									*
+%************************************************************************
+
+\begin{code}
+hashName :: Name -> Int
+hashName name = getKey (nameUnique name)
 \end{code}
 
+
 %************************************************************************
 %*									*
 \subsection[Name-instances]{Instance declarations}
@@ -315,134 +281,79 @@ 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_
+cmpName n1 n2 = n_uniq n1 `compare` n_uniq n2
 \end{code}
 
 \begin{code}
 instance Eq Name where
-    a == b = case (a `cmp` b) of { EQ_ -> True;  _ -> False }
-    a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True }
+    a == b = case (a `compare` b) of { EQ -> True;  _ -> False }
+    a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
 
 instance Ord Name where
-    a <= b = case (a `cmp` b) of { LT_ -> True;	 EQ_ -> True;  GT__ -> False }
-    a <	 b = case (a `cmp` b) of { LT_ -> True;	 EQ_ -> False; GT__ -> False }
-    a >= b = case (a `cmp` b) of { LT_ -> False; EQ_ -> True;  GT__ -> True  }
-    a >	 b = case (a `cmp` b) of { LT_ -> False; EQ_ -> False; GT__ -> True  }
-
-instance Ord3 Name where
-    cmp = cmpName
+    a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
+    a <	 b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
+    a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
+    a >	 b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
+    compare a b = cmpName a b
 
 instance Uniquable Name where
-    uniqueOf = nameUnique
+    getUnique = nameUnique
 
 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 n _ _ _) = OrigName m n
-#ifdef DEBUG
-nameOrigName msg (Local  _ n _ _)     = panic ("nameOrigName:Local:"++msg++":"++ _UNPK_ n)
-#endif
-
-nameOccName (Local  _ n _ _)	     = Unqual n
-nameOccName (Global _ m n _ _ []  )  = Qual m n
-nameOccName (Global _ m n _ _ (o:_)) = o
-
-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}
-
-\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 n  _ _ _)	  = ppBesides [ppr PprDebug (Qual m n), ppStr "{-", pprUnique u, ppStr "-}"]
-    ppr PprForUser (Global   u m n _ _ []  )      = ppr PprForUser (Qual m n)
-    ppr PprForUser (Global   u m n _ _ occs)      = ppr PprForUser (head occs)
-    ppr PprShowAll (Global   u m n prov exp occs) = pp_all (Qual m n) prov exp occs
-    ppr sty        (Global   u m n _ _ _)         = ppr sty (Qual m 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
-\end{code}
 
 %************************************************************************
 %*									*
-\subsection[ExportFlag-datatype]{The @ExportFlag@ datatype}
+\subsection{Pretty printing}
 %*									*
 %************************************************************************
 
-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
-
-isExported a = exportFlagOn (getExportFlag a)
+instance Outputable Name where
+	-- When printing interfaces, all Internals have been given nice print-names
+    ppr name = pprName name
+
+instance OutputableBndr Name where
+    pprBndr _ name = pprName name
+
+pprName (Name {n_sort = sort, n_uniq = uniq, n_occ = occ})
+  = getPprStyle $ \ sty ->
+    case sort of
+      WiredIn mod _ _ BuiltInSyntax -> pprOccName occ	-- Built-in syntax is never qualified
+      WiredIn mod _ _ UserSyntax    -> pprExternal sty uniq mod occ True
+      External mod _  	            -> pprExternal sty uniq mod occ False
+      System   		 	    -> pprSystem sty uniq occ
+      Internal    	 	    -> pprInternal sty uniq occ
+
+pprExternal sty uniq mod occ is_wired
+  | unqualStyle sty mod_name occ = pprOccName occ
+  | codeStyle sty        = ppr mod_name <> char '_' <> pprOccName occ
+  | debugStyle sty       = sep [ppr mod_name <> dot <> pprOccName occ,
+				hsep [text "{-" 
+				     , if is_wired then ptext SLIT("(w)") else empty
+				     , pprUnique uniq
+-- (overkill)			     , case mb_p of
+--				 	 Nothing -> empty
+--					 Just n  -> brackets (ppr n)
+				     , text "-}"]]
+  | otherwise		 	 = ppr mod_name <> dot <> pprOccName occ
+  where
+    mod_name = moduleName mod
+
+pprInternal sty uniq occ
+  | codeStyle sty  = pprUnique uniq
+  | debugStyle sty = pprOccName occ <> text "{-" <> pprUnique uniq <> text "-}"
+  | otherwise      = pprOccName occ	-- User style
+
+-- Like Internal, except that we only omit the unique in Iface style
+pprSystem sty uniq occ
+  | codeStyle sty  = pprUnique uniq
+  | otherwise	   = pprOccName occ <> char '_' <> pprUnique uniq
+				-- If the tidy phase hasn't run, the OccName
+				-- is unlikely to be informative (like 's'),
+				-- so print the unique
 \end{code}
 
 %************************************************************************
@@ -453,119 +364,17 @@ isExported a = exportFlagOn (getExportFlag a)
 
 \begin{code}
 class NamedThing a where
-    getName :: a -> Name
+    getOccName :: a -> OccName
+    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
 getSrcLoc	    :: NamedThing a => a -> SrcLoc
-getImpLocs	    :: NamedThing a => a -> [SrcLoc]
-isLocallyDefined    :: NamedThing a => a -> Bool
-
-origName str n	    = nameOrigName str (getName n)
-
-moduleOf (OrigName m n) = m
-nameOf   (OrigName m n) = n
+getOccString	    :: NamedThing a => a -> String
 
-getLocalName n
-  = case (getName n) of
-      Global _ m n _ _ _ -> n
-      Local  _ n _ _	 -> n
-
-getOccName	    = nameOccName  	   . getName
-getExportFlag	    = nameExportFlag	   . getName
 getSrcLoc	    = nameSrcLoc	   . getName
-getImpLocs	    = nameImpLocs	   . getName
-isLocallyDefined    = isLocallyDefinedName . getName
+getOccString 	    = occNameString	   . getOccName
 \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}