[project @ 1998-12-18 17:40:31 by simonpj]

Another big commit from Simon.  Actually, the last one
didn't all go into the main trunk; because of a CVS glitch it
ended up in the wrong branch.

So this commit includes:

* Scoped type variables
* Warnings for unused variables should work now (they didn't before)
* Simplifier improvements:
	- Much better treatment of strict arguments
	- Better treatment of bottoming Ids
	- No need for w/w split for fns that are merely strict
	- Fewer iterations needed, I hope
* Less gratuitous renaming in interface files and abs C
* OccName is a separate module, and is an abstract data type

I think the whole Prelude and Exts libraries compile correctly.
Something isn't quite right about typechecking existentials though.

15 files changed, 1176 insertions, 750 deletions

diff --git a/ghc/compiler/basicTypes/BasicTypes.lhs b/ghc/compiler/basicTypes/BasicTypes.lhs
index cfd79b1f1b..5045c784e2 100644
--- a/ghc/compiler/basicTypes/BasicTypes.lhs
+++ b/ghc/compiler/basicTypes/BasicTypes.lhs
@@ -16,7 +16,6 @@ types that
 module BasicTypes(
 	Version, Arity, 
 	Unused, unused,
-	Module, moduleString, pprModule,
 	Fixity(..), FixityDirection(..), StrictnessMark(..),
 	NewOrData(..), IfaceFlavour(..), TopLevelFlag(..), RecFlag(..)
    ) where
@@ -66,22 +65,6 @@ type Version = Int
 
 %************************************************************************
 %*									*
-\subsection[Module]{The name of a module}
-%*									*
-%************************************************************************
-
-\begin{code}
-type Module   = FAST_STRING
-
-moduleString :: Module -> String
-moduleString mod = _UNPK_ mod
-
-pprModule :: Module -> SDoc
-pprModule m = ptext m
-\end{code}
-
-%************************************************************************
-%*									*
 \subsection[IfaceFlavour]{IfaceFlavour}
 %*									*
 %************************************************************************
diff --git a/ghc/compiler/basicTypes/DataCon.lhs b/ghc/compiler/basicTypes/DataCon.lhs
index b99ca31a4c..3ecd9689e6 100644
--- a/ghc/compiler/basicTypes/DataCon.lhs
+++ b/ghc/compiler/basicTypes/DataCon.lhs
@@ -51,7 +51,25 @@ data DataCon
 	dcName   :: Name,
 	dcUnique :: Unique, 		-- Cached from Name
 	dcTag    :: ConTag,
-	dcType   :: Type,		-- Type of the constructor (see notes below)
+
+	-- Running example:
+	--
+	--	data Eq a => T a = forall b. Ord b => MkT a [b]
+
+	dcType   :: Type,	-- Type of the constructor 
+				-- 	forall ab . Ord b => a -> [b] -> MkT a
+				-- (this is *not* of the constructor Id: 
+				--  see notes after this data type declaration)
+
+	-- The next six fields express the type of the constructor, in pieces
+	-- e.g.
+	--
+	--	dcTyVars   = [a]
+	-- 	dcTheta    = [Eq a]
+	--	dcExTyVars = [b]
+	--	dcExTheta  = [Ord b]
+	--	dcArgTys   = [a,List b]
+	--	dcTyCon    = T
 
 	dcTyVars :: [TyVar], 		-- Type vars and context for the data type decl
 	dcTheta  ::  ThetaType,
@@ -62,6 +80,7 @@ data DataCon
 	dcArgTys :: [Type],		-- Argument types
 	dcTyCon  :: TyCon,		-- Result tycon 
 
+	-- Now the strictness annotations and field labels of the constructor
 	dcStricts :: [StrictnessMark],	-- Strict args, in the same order as the argument types;
 					-- length = dataConNumFields dataCon
 
@@ -69,6 +88,11 @@ data DataCon
 					-- same order as the argument types; 
 					-- length = 0 (if not a record) or dataConSourceArity.
 
+	-- Finally, the curried function that corresponds to the constructor
+	-- 	mkT :: forall a b. (Eq a, Ord b) => a -> [b] -> T a
+	--	mkT = /\ab. \deq dord p qs. Con MkT [a, b, dord, p, qs]
+	-- This unfolding is built in MkId.mkDataConId
+
 	dcId :: Id			-- The corresponding Id
   }
 
diff --git a/ghc/compiler/basicTypes/Demand.lhs b/ghc/compiler/basicTypes/Demand.lhs
index 0f25717745..f0342165eb 100644
--- a/ghc/compiler/basicTypes/Demand.lhs
+++ b/ghc/compiler/basicTypes/Demand.lhs
@@ -78,9 +78,7 @@ isStrict (WwUnpack NewType _ ds) = isStrict (head ds)
 isStrict (WwUnpack other _ _)    = True
 isStrict WwStrict = True
 isStrict WwEnum	  = True
-isStrict WwPrim	  = False	-- NB: we treat only lifted types as strict.
-				-- Why is this important?  Mostly it doesn't matter
-				-- but it saves a test for lifted-ness in SimplUtils.etaCoreExpr
+isStrict WwPrim	  = True
 isStrict _	  = False
 \end{code}
 
@@ -97,7 +95,42 @@ isLazy _	      = False	-- (as they imply a worker)
 %*									*
 %************************************************************************
 
+
 \begin{code}
+pprDemands demands bot = hcat (map pprDemand demands) <> pp_bot
+		       where
+			 pp_bot | bot       = ptext SLIT("B")
+				| otherwise = empty
+
+
+pprDemand (WwLazy False)  	 = char 'L'
+pprDemand (WwLazy True)   	 = char 'A'
+pprDemand WwStrict	      	 = char 'S'
+pprDemand WwPrim	      	 = char 'P'
+pprDemand WwEnum	      	 = char 'E'
+pprDemand (WwUnpack nd wu args)  = char ch <> parens (hcat (map pprDemand args))
+				      where
+					ch = case nd of
+						DataType | wu        -> 'U'
+							 | otherwise -> 'u'
+						NewType  | wu        -> 'N'
+							 | otherwise -> 'n'
+
+instance Outputable Demand where
+    ppr (WwLazy False) = empty
+    ppr other_demand   = ptext SLIT("__D") <+> pprDemand other_demand
+
+instance Show Demand where
+    showsPrec p d = showsPrecSDoc p (ppr d)
+\end{code}
+
+
+\begin{code}
+{-	------------------- OMITTED NOW -------------------------------
+	-- Reading demands is done in Lex.lhs
+	-- Also note that the (old) code here doesn't take proper
+	-- account of the 'B' suffix for bottoming functions
+
 #ifdef REALLY_HASKELL_1_3
 
 instance Read Demand where
@@ -113,6 +146,8 @@ instance Text Demand where
     showsPrec p d = showsPrecSDoc p (ppr d)
 #endif
 
+readDemands :: String -> 
+
 read_em acc ('L' : xs)	= read_em (WwLazy   False : acc) xs
 read_em acc ('A' : xs)	= read_em (WwLazy   True  : acc) xs
 read_em acc ('S' : xs)	= read_em (WwStrict : acc) xs
@@ -128,25 +163,8 @@ read_em acc rest	= [(reverse acc, rest)]
 do_unpack new_or_data wrapper_unpacks acc xs
 	  = case (read_em [] xs) of
 	      [(stuff, rest)] -> read_em (WwUnpack new_or_data wrapper_unpacks stuff : acc) rest
-	      _ -> pprPanic "Demand.do_unpack:" (ppr acc <+> text ("::"++xs))
-
-
-pprDemands demands = hcat (map pprDemand demands)
-
-pprDemand (WwLazy False)  	 = char 'L'
-pprDemand (WwLazy True)   	 = char 'A'
-pprDemand WwStrict	      	 = char 'S'
-pprDemand WwPrim	      	 = char 'P'
-pprDemand WwEnum	      	 = char 'E'
-pprDemand (WwUnpack nd wu args)  = char ch <> parens (pprDemands args)
-				      where
-					ch = case nd of
-						DataType | wu        -> 'U'
-							 | otherwise -> 'u'
-						NewType  | wu        -> 'N'
-							 | otherwise -> 'n'
+	      _ -> pprPanic "Demand.do_unpack:" (ppr acc <+> dcolon <> text xs)
 
-instance Outputable Demand where
-    ppr (WwLazy False) = empty
-    ppr other_demand   = ptext SLIT("__D") <+> pprDemand other_demand
+-------------------- END OF OMISSION ------------------------------  -}
 \end{code}
+
diff --git a/ghc/compiler/basicTypes/Id.lhs b/ghc/compiler/basicTypes/Id.lhs
index 0ae23a6816..56afa7ae6b 100644
--- a/ghc/compiler/basicTypes/Id.lhs
+++ b/ghc/compiler/basicTypes/Id.lhs
@@ -5,20 +5,19 @@
 
 \begin{code}
 module Id (
-	Id, DictId, GenId,
+	Id, DictId,
 
 	-- Simple construction
 	mkVanillaId, mkImportedId, mkSysLocal, mkUserLocal,
 	mkTemplateLocals, mkWildId, mkUserId,
 
 	-- Taking an Id apart
-	idName, idType, idUnique, idInfo,
+	idName, idType, idUnique, idInfo, idDetails,
 	idPrimRep, isId,
 	recordSelectorFieldLabel,
 
 	-- Modifying an Id
-	setIdName, setIdUnique, setIdType, setIdInfo,
-	setIdVisibility, mkIdVisible,
+	setIdName, setIdUnique, setIdType, setIdInfo, mkIdVisible,
 
 	-- Predicates
 	omitIfaceSigForId,
@@ -34,7 +33,7 @@ module Id (
 	isRecordSelector,
 	isPrimitiveId_maybe, isDataConId_maybe,
 	isConstantId,
-	isBottomingId, 
+	isBottomingId, idAppIsBottom,
 
 	-- IdInfo stuff
 	setIdUnfolding,
@@ -59,25 +58,24 @@ module Id (
 
 import {-# SOURCE #-} CoreUnfold ( Unfolding )
 
-import Var		( Id, GenId, DictId, VarDetails(..), 
+import Var		( Id, DictId, VarDetails(..), 
 			  isId, mkId, 
-			  idName, idType, idUnique, idInfo, varDetails,
+			  idName, idType, idUnique, idInfo, idDetails,
 			  setIdName, setVarType, setIdUnique, setIdInfo, modifyIdInfo,
 			  externallyVisibleId
 			)
 import VarSet
-import Type		( GenType, Type, tyVarsOfType, typePrimRep, addFreeTyVars )
+import Type		( Type, tyVarsOfType, typePrimRep, addFreeTyVars )
 import IdInfo
 import Demand		( Demand )
-import Name	 	( Name, OccName, 
+import Name	 	( Name, OccName, Module,
 			  mkSysLocalName, mkLocalName,
-			  isWiredInName, setNameVisibility, mkNameVisible
+			  isWiredInName, mkNameVisible
 			) 
 import Const		( Con(..) )
 import PrimRep		( PrimRep )
 import PrimOp		( PrimOp )
 import FieldLabel	( FieldLabel(..) )
-import BasicTypes	( Module )
 import Unique		( Unique, mkBuiltinUnique, getBuiltinUniques )
 import Outputable
 
@@ -100,22 +98,22 @@ infixl 	1 `setIdUnfolding`,
 %************************************************************************
 
 \begin{code}
-mkVanillaId :: Name -> (GenType flexi) -> GenId flexi
-mkVanillaId name ty = mkId name ty VanillaId noIdInfo
+mkVanillaId :: Name -> Type -> Id
+mkVanillaId name ty = mkId name (addFreeTyVars ty) VanillaId noIdInfo
 
 mkImportedId :: Name -> Type -> IdInfo -> Id
-mkImportedId name ty info = mkId name ty VanillaId info
+mkImportedId name ty info = mkId name (addFreeTyVars ty) VanillaId info
 
-mkUserId :: Name -> GenType flexi -> GenId flexi
+mkUserId :: Name -> Type -> Id
 mkUserId name ty = mkVanillaId name ty
 
 -- SysLocal: for an Id being created by the compiler out of thin air...
 -- UserLocal: an Id with a name the user might recognize...
-mkUserLocal :: OccName -> Unique -> GenType flexi -> GenId flexi
-mkSysLocal  ::            Unique -> GenType flexi -> GenId flexi
+mkUserLocal :: OccName     -> Unique -> Type -> Id
+mkSysLocal  :: FAST_STRING -> Unique -> Type -> Id
 
-mkSysLocal  uniq ty     = mkVanillaId (mkSysLocalName uniq)  ty
-mkUserLocal occ uniq ty = mkVanillaId (mkLocalName uniq occ) ty
+mkSysLocal  fs uniq ty  = mkVanillaId (mkSysLocalName uniq fs)  ty
+mkUserLocal occ uniq ty = mkVanillaId (mkLocalName    uniq occ) ty
 \end{code}
 
 Make some local @Ids@ for a template @CoreExpr@.  These have bogus
@@ -125,11 +123,11 @@ instantiated before use.
 \begin{code}
 -- "Wild Id" typically used when you need a binder that you don't expect to use
 mkWildId :: Type -> Id
-mkWildId ty = mkSysLocal (mkBuiltinUnique 1) ty
+mkWildId ty = mkSysLocal SLIT("wild") (mkBuiltinUnique 1) ty
 
 -- "Template locals" typically used in unfoldings
 mkTemplateLocals :: [Type] -> [Id]
-mkTemplateLocals tys = zipWith mkSysLocal
+mkTemplateLocals tys = zipWith (mkSysLocal SLIT("tpl"))
 			       (getBuiltinUniques (length tys))
 			       tys
 \end{code}
@@ -142,10 +140,10 @@ mkTemplateLocals tys = zipWith mkSysLocal
 %************************************************************************
 
 \begin{code}
-idFreeTyVars :: (GenId flexi) -> (GenTyVarSet flexi)
+idFreeTyVars :: Id -> TyVarSet
 idFreeTyVars id = tyVarsOfType (idType id)
 
-setIdType :: GenId flexi1 -> GenType flexi2 -> GenId flexi2
+setIdType :: Id -> Type -> Id
 	-- Add free tyvar info to the type
 setIdType id ty = setVarType id (addFreeTyVars ty)
 
@@ -164,7 +162,7 @@ omitIfaceSigForId id
   = True
 
   | otherwise
-  = case varDetails id of
+  = case idDetails id of
 	RecordSelId _  -> True	-- Includes dictionary selectors
         ConstantId _   -> True
 		-- ConstantIds are implied by their type or class decl;
@@ -175,13 +173,7 @@ omitIfaceSigForId id
 	other	       -> False	-- Don't omit!
 \end{code}
 
-See notes with setNameVisibility (Name.lhs)
-
 \begin{code}
-setIdVisibility :: Maybe Module -> Unique -> Id -> Id
-setIdVisibility maybe_mod u id
-  = setIdName id (setNameVisibility maybe_mod u (idName id))
-
 mkIdVisible :: Module -> Unique -> Id -> Id
 mkIdVisible mod u id 
   = setIdName id (mkNameVisible mod u (idName id))
@@ -195,22 +187,22 @@ mkIdVisible mod u id
 
 \begin{code}
 recordSelectorFieldLabel :: Id -> FieldLabel
-recordSelectorFieldLabel id = case varDetails id of
+recordSelectorFieldLabel id = case idDetails id of
 				RecordSelId lbl -> lbl
 
-isRecordSelector id = case varDetails id of
+isRecordSelector id = case idDetails id of
 			RecordSelId lbl -> True
 			other	  	-> False
 
-isPrimitiveId_maybe id = case varDetails id of
+isPrimitiveId_maybe id = case idDetails id of
 			    ConstantId (PrimOp op) -> Just op
 			    other		   -> Nothing
 
-isDataConId_maybe id = case varDetails id of
+isDataConId_maybe id = case idDetails id of
 			  ConstantId (DataCon con) -> Just con
 			  other		           -> Nothing
 
-isConstantId id = case varDetails id of
+isConstantId id = case idDetails id of
 		    ConstantId _ -> True
 		    other	 -> False
 \end{code}
@@ -225,61 +217,65 @@ isConstantId id = case varDetails id of
 \begin{code}
 	---------------------------------
 	-- ARITY
-getIdArity :: GenId flexi -> ArityInfo
+getIdArity :: Id -> ArityInfo
 getIdArity id = arityInfo (idInfo id)
 
-setIdArity :: GenId flexi -> ArityInfo -> GenId flexi
+setIdArity :: Id -> ArityInfo -> Id
 setIdArity id arity = modifyIdInfo id (arity `setArityInfo`)
 
 	---------------------------------
 	-- STRICTNESS
-getIdStrictness :: GenId flexi -> StrictnessInfo
+getIdStrictness :: Id -> StrictnessInfo
 getIdStrictness id = strictnessInfo (idInfo id)
 
-setIdStrictness :: GenId flexi -> StrictnessInfo -> GenId flexi
+setIdStrictness :: Id -> StrictnessInfo -> Id
 setIdStrictness id strict_info = modifyIdInfo id (strict_info `setStrictnessInfo`)
 
-isBottomingId :: GenId flexi -> Bool
-isBottomingId id = bottomIsGuaranteed (strictnessInfo (idInfo id))
+-- isBottomingId returns true if an application to n args would diverge
+isBottomingId :: Id -> Bool
+isBottomingId id = isBottomingStrictness (strictnessInfo (idInfo id))
+
+idAppIsBottom :: Id -> Int -> Bool
+idAppIsBottom id n = appIsBottom (strictnessInfo (idInfo id)) n
 
 	---------------------------------
 	-- UNFOLDING
-getIdUnfolding :: GenId flexi -> Unfolding
+getIdUnfolding :: Id -> Unfolding
 getIdUnfolding id = unfoldingInfo (idInfo id)
 
-setIdUnfolding :: GenId flexi -> Unfolding -> GenId flexi
+setIdUnfolding :: Id -> Unfolding -> Id
 setIdUnfolding id unfolding = modifyIdInfo id (unfolding `setUnfoldingInfo`)
 
 	---------------------------------
 	-- DEMAND
-getIdDemandInfo :: GenId flexi -> Demand
+getIdDemandInfo :: Id -> Demand
 getIdDemandInfo id = demandInfo (idInfo id)
 
-setIdDemandInfo :: GenId flexi -> Demand -> GenId flexi
+setIdDemandInfo :: Id -> Demand -> Id
 setIdDemandInfo id demand_info = modifyIdInfo id (demand_info `setDemandInfo`)
 
 	---------------------------------
 	-- UPDATE INFO
-getIdUpdateInfo :: GenId flexi -> UpdateInfo
+getIdUpdateInfo :: Id -> UpdateInfo
 getIdUpdateInfo id = updateInfo (idInfo id)
 
-setIdUpdateInfo :: GenId flexi -> UpdateInfo -> GenId flexi
+setIdUpdateInfo :: Id -> UpdateInfo -> Id
 setIdUpdateInfo id upd_info = modifyIdInfo id (upd_info `setUpdateInfo`)
 
 	---------------------------------
 	-- SPECIALISATION
-getIdSpecialisation :: GenId flexi -> IdSpecEnv
+getIdSpecialisation :: Id -> IdSpecEnv
 getIdSpecialisation id = specInfo (idInfo id)
 
-setIdSpecialisation :: GenId flexi -> IdSpecEnv -> GenId flexi
+setIdSpecialisation :: Id -> IdSpecEnv -> Id
 setIdSpecialisation id spec_info = modifyIdInfo id (spec_info `setSpecInfo`)
 
 	---------------------------------
 	-- CAF INFO
-getIdCafInfo :: GenId flexi -> CafInfo
+getIdCafInfo :: Id -> CafInfo
 getIdCafInfo id = cafInfo (idInfo id)
 
-setIdCafInfo :: GenId flexi -> CafInfo -> GenId flexi
+setIdCafInfo :: Id -> CafInfo -> Id
 setIdCafInfo id caf_info = modifyIdInfo id (caf_info `setCafInfo`)
 \end{code}
 
@@ -290,16 +286,16 @@ The inline pragma tells us to be very keen to inline this Id, but it's still
 OK not to if optimisation is switched off.
 
 \begin{code}
-getInlinePragma :: GenId flexi -> InlinePragInfo
+getInlinePragma :: Id -> InlinePragInfo
 getInlinePragma id = inlinePragInfo (idInfo id)
 
-setInlinePragma :: GenId flexi -> InlinePragInfo -> GenId flexi
+setInlinePragma :: Id -> InlinePragInfo -> Id
 setInlinePragma id prag = modifyIdInfo id (setInlinePragInfo prag)
 
-modifyInlinePragma :: GenId flexi -> (InlinePragInfo -> InlinePragInfo) -> GenId flexi
+modifyInlinePragma :: Id -> (InlinePragInfo -> InlinePragInfo) -> Id
 modifyInlinePragma id fn = modifyIdInfo id (\info -> setInlinePragInfo (fn (inlinePragInfo info)) info)
 
-idWantsToBeINLINEd :: GenId flexi -> Bool
+idWantsToBeINLINEd :: Id -> Bool
 idWantsToBeINLINEd id = case getInlinePragma id of
 			  IWantToBeINLINEd -> True
 			  IMustBeINLINEd   -> True
diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs
index f2084c8265..c92f94318a 100644
--- a/ghc/compiler/basicTypes/IdInfo.lhs
+++ b/ghc/compiler/basicTypes/IdInfo.lhs
@@ -20,9 +20,10 @@ module IdInfo (
 
 	-- Strictness
 	StrictnessInfo(..),				-- Non-abstract
-	workerExists, mkStrictnessInfo, mkBottomStrictnessInfo, 
-	noStrictnessInfo, bottomIsGuaranteed, strictnessInfo, 
+	workerExists, mkStrictnessInfo,
+	noStrictnessInfo, strictnessInfo,
 	ppStrictnessInfo, setStrictnessInfo, 
+	isBottomingStrictness, appIsBottom,
 
 	-- Unfolding
 	unfoldingInfo, setUnfoldingInfo, 
@@ -302,52 +303,46 @@ it exists); i.e. its calling convention.
 data StrictnessInfo
   = NoStrictnessInfo
 
-  | BottomGuaranteed	-- This Id guarantees never to return;
-			-- it is bottom regardless of its arguments.
-			-- Useful for "error" and other disguised
-			-- variants thereof.
-
   | StrictnessInfo [Demand] 
+		   Bool		-- True <=> the function diverges regardless of its arguments
+				-- Useful for "error" and other disguised variants thereof.  
+				-- BUT NB: f = \x y. error "urk"
+				-- 	   will have info  SI [SS] True
+				-- but still (f) and (f 2) are not bot; only (f 3 2) is bot
+
 		   Bool		-- True <=> there is a worker. There might not be, even for a
 				-- strict function, because:
 				-- 	(a) the function might be small enough to inline, 
 				--	    so no need for w/w split
 				-- 	(b) the strictness info might be "SSS" or something, so no w/w split.
-
-				-- Worker's Id, if applicable, and a list of the constructors
-				-- mentioned by the wrapper.  This is necessary so that the
-				-- renamer can slurp them in.  Without this info, the renamer doesn't
-				-- know which data types to slurp in concretely.  Remember, for
-				-- strict things we don't put the unfolding in the interface file, to save space.
-				-- This constructor list allows the renamer to behave much as if the
-				-- unfolding *was* in the interface file.
 \end{code}
 
 \begin{code}
-mkStrictnessInfo :: [Demand] -> Bool -> StrictnessInfo
+mkStrictnessInfo :: ([Demand], Bool) -> Bool -> StrictnessInfo
 
-mkStrictnessInfo xs has_wrkr
-  | all isLazy xs	 = NoStrictnessInfo		-- Uninteresting
-  | otherwise		 = StrictnessInfo xs has_wrkr
+mkStrictnessInfo (xs, is_bot) has_wrkr
+  | all isLazy xs && not is_bot	= NoStrictnessInfo		-- Uninteresting
+  | otherwise		        = StrictnessInfo xs is_bot has_wrkr
 
 noStrictnessInfo       = NoStrictnessInfo
-mkBottomStrictnessInfo = BottomGuaranteed
 
-bottomIsGuaranteed BottomGuaranteed = True
-bottomIsGuaranteed other    	    = False
+isBottomingStrictness (StrictnessInfo _ bot _) = bot
+isBottomingStrictness NoStrictnessInfo         = False
 
-ppStrictnessInfo NoStrictnessInfo = empty
-ppStrictnessInfo BottomGuaranteed = ptext SLIT("__bot")
+-- appIsBottom returns true if an application to n args would diverge
+appIsBottom (StrictnessInfo ds bot _) n = bot && (n >= length ds)
+appIsBottom  NoStrictnessInfo	      n	= False
 
-ppStrictnessInfo (StrictnessInfo wrapper_args wrkr_maybe)
-  = hsep [ptext SLIT("__S"), pprDemands wrapper_args]
+ppStrictnessInfo NoStrictnessInfo = empty
+ppStrictnessInfo (StrictnessInfo wrapper_args bot wrkr_maybe)
+  = hsep [ptext SLIT("__S"), pprDemands wrapper_args bot]
 \end{code}
 
 
 \begin{code}
 workerExists :: StrictnessInfo -> Bool
-workerExists (StrictnessInfo _ worker_exists) = worker_exists
-workerExists other			      = False
+workerExists (StrictnessInfo _ _ worker_exists) = worker_exists
+workerExists other			        = False
 \end{code}
 
 
diff --git a/ghc/compiler/basicTypes/MkId.lhs b/ghc/compiler/basicTypes/MkId.lhs
index bb9020c7ba..cd0ec9bcc8 100644
--- a/ghc/compiler/basicTypes/MkId.lhs
+++ b/ghc/compiler/basicTypes/MkId.lhs
@@ -30,7 +30,7 @@ import {-# SOURCE #-} CoreUnfold ( mkUnfolding )
 import TysWiredIn	( boolTy )
 import Type		( Type, ThetaType,
 			  mkDictTy, mkTyConApp, mkTyVarTys, mkFunTys, mkFunTy, mkSigmaTy,
-			  isUnLiftedType, substFlexiTheta,
+			  isUnLiftedType, substTopTheta,
 			  splitSigmaTy, splitFunTy_maybe, splitAlgTyConApp,
 			  splitFunTys, splitForAllTys
 			)
@@ -39,11 +39,11 @@ import Class		( Class, classBigSig, classTyCon )
 import Var		( Id, TyVar, VarDetails(..), mkId )
 import VarEnv		( zipVarEnv )
 import Const		( Con(..) )
-import Name		( mkCompoundName, mkWiredInIdName, 
-			  mkWorkerName, mkSuperDictSelName,
+import Name		( mkDerivedName, mkWiredInIdName, 
+			  mkWorkerOcc, mkSuperDictSelOcc,
 			  Name, NamedThing(..),
 			)
-import PrimOp		( PrimOp, primOpType, primOpStr, primOpUniq )
+import PrimOp		( PrimOp, primOpType, primOpOcc, primOpUniq )
 import DataCon		( DataCon, dataConStrictMarks, dataConFieldLabels, 
 			  dataConArgTys, dataConSig
 			)
@@ -86,7 +86,7 @@ mkDefaultMethodId dm_name rec_c ty
   = mkVanillaId dm_name ty
 
 mkWorkerId uniq unwrkr ty
-  = mkVanillaId (mkCompoundName mkWorkerName uniq (getName unwrkr)) ty
+  = mkVanillaId (mkDerivedName mkWorkerOcc (getName unwrkr) uniq) ty
 \end{code}
 
 %************************************************************************
@@ -257,7 +257,7 @@ mkSuperDictSelId :: Unique -> Class -> FieldLabelTag -> Type -> Id
 mkSuperDictSelId uniq clas index ty
   = mkDictSelId name clas ty
   where
-    name   = mkCompoundName (mkSuperDictSelName index) uniq (getName clas)
+    name   = mkDerivedName (mkSuperDictSelOcc index) (getName clas) uniq
 
 	-- For method selectors the clean thing to do is
 	-- to give the method selector the same name as the class op itself.
@@ -315,7 +315,7 @@ mkPrimitiveId :: PrimOp -> Id
 mkPrimitiveId prim_op 
   = id
   where
-    occ_name = primOpStr  prim_op
+    occ_name = primOpOcc  prim_op
     key	     = primOpUniq prim_op
     ty	     = primOpType prim_op
     name    = mkWiredInIdName key pREL_GHC occ_name id
@@ -365,8 +365,7 @@ mkDictFunId dfun_name clas inst_tyvars inst_tys inst_decl_theta
   = mkVanillaId dfun_name dfun_ty
   where
     (class_tyvars, sc_theta, _, _, _) = classBigSig clas
-    sc_theta' = substFlexiTheta (zipVarEnv class_tyvars inst_tys) sc_theta
-			-- Doesn't really need to be flexi
+    sc_theta' = substTopTheta (zipVarEnv class_tyvars inst_tys) sc_theta
 
     dfun_theta = case inst_decl_theta of
 		   []    -> []	-- If inst_decl_theta is empty, then we don't
diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs
index 5fc667cfa3..a84e626f98 100644
--- a/ghc/compiler/basicTypes/Name.lhs
+++ b/ghc/compiler/basicTypes/Name.lhs
@@ -5,33 +5,20 @@
 
 \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
-	mkLocalName, mkSysLocalName, 
-
-	mkCompoundName, mkGlobalName,
-
+	mkLocalName, mkSysLocalName, mkTopName,
+	mkDerivedName, mkGlobalName,
 	mkWiredInIdName,   mkWiredInTyConName,
 	maybeWiredInIdName, maybeWiredInTyConName,
 	isWiredInName,
 
-	nameUnique, changeUnique, setNameProvenance, getNameProvenance,
-	setNameVisibility, mkNameVisible,
-	nameOccName, nameModule,
+	nameUnique, setNameUnique, setNameProvenance, getNameProvenance,
+	tidyTopName, mkNameVisible,
+	nameOccName, nameModule, setNameOcc,
 
 	isExportedName,	nameSrcLoc,
 	isLocallyDefinedName,
@@ -40,14 +27,9 @@ module Name (
 
         pprNameProvenance,
 
-	-- Special Names
-	dictNamePrefix, mkSuperDictSelName, mkWorkerName,
-	mkDefaultMethodName, mkClassTyConStr, mkClassDataConStr,
-
 	-- Misc
-	Provenance(..), pprProvenance,
-	ExportFlag(..), 
-	PrintUnqualified,
+	Provenance(..), ImportReason(..), pprProvenance,
+	ExportFlag(..), PrintUnqualified,
 
 	-- Class NamedThing and overloaded friends
 	NamedThing(..),
@@ -60,177 +42,19 @@ module Name (
 import {-# SOURCE #-} Var   ( Id )
 import {-# SOURCE #-} TyCon ( TyCon )
 
-import CStrings		( identToC )
-import PrelMods		( pREL_BASE, pREL_TUP, pREL_GHC )
+import OccName		-- All of it
 import CmdLineOpts	( opt_PprStyle_NoPrags, opt_OmitInterfacePragmas, opt_EnsureSplittableC )
-import BasicTypes	( Module, IfaceFlavour(..), moduleString, pprModule )
+import BasicTypes	( IfaceFlavour(..) )
 
 import SrcLoc		( noSrcLoc, mkBuiltinSrcLoc, SrcLoc )
 import Unique		( pprUnique, Unique, Uniquable(..) )
 import Outputable
-import Char		( isUpper, isLower, ord )
-import Util		( nOfThem )
 import GlaExts
 \end{code}
 
 
 %************************************************************************
 %*									*
-\subsection{Lexical categories}
-%*									*
-%************************************************************************
-
-These functions test strings to see if they fit the lexical categories
-defined in the Haskell report.
-
-\begin{code}
-isLexCon, isLexVar, isLexId, isLexSym, isLexConId, isLexConSym,
- isLexVarId, isLexVarSym  :: 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
-  | cs == SLIT("[]") = True
-  | c  == '('	     = True	-- (), (,), (,,), ...
-  | 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  == ':'
-	       || cs == SLIT("->")
-  where
-    c = _HEAD_ cs
-
-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
-\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) ',' ++ "#)"))
-\end{code}
-
-
-%************************************************************************
-%*									*
-\subsection[Name-pieces-datatypes]{The @OccName@ datatypes}
-%*									*
-%************************************************************************
-
-\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 }
-
-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
-
-(VarOcc s1) `cmpOcc` (VarOcc s2) = s1 `compare` s2
-(VarOcc s1) `cmpOcc` other2      = LT
-
-(TvOcc s1)  `cmpOcc` (VarOcc s2) = GT
-(TvOcc s1)  `cmpOcc` (TvOcc s2)  = s1 `compare` s2
-(TvOcc s1)  `cmpOcc` other	 = LT
-
-(TCOcc s1) `cmpOcc` (TCOcc s2) = s1 `compare` s2
-(TCOcc s1) `cmpOcc` other      = GT
-
-instance Outputable OccName where
-  ppr = pprOccName
-\end{code}
-
-
-%************************************************************************
-%*									*
 \subsection[Name-datatype]{The @Name@ datatype, and name construction}
 %*									*
 %************************************************************************
@@ -238,7 +62,10 @@ instance Outputable OccName where
 \begin{code}
 data Name
   = Local    Unique
-	     (Maybe OccName)	-- For ones that started life with a user name
+	     OccName		-- How to print it
+	     Bool		-- True <=> this is a "sys-local"
+				-- see notes just below
+
 
   | Global   Unique
 	     Module		-- The defining module
@@ -246,117 +73,103 @@ data Name
              Provenance		-- How it was defined
 \end{code}
 
+Sys-locals 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.  That debug
+printing issue is the ONLY way in which sys-locals are different.  I think.
+
+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 ordinary locals
+If any desugarer sys-locals have survived that far, they get changed to
+"ds1", "ds2", etc.
+
 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
-  = NoProvenance
-
-  | LocalDef			-- Defined locally
-	SrcLoc 			-- Defn site
-	ExportFlag		-- Whether it's exported
-
-  | NonLocalDef  		-- Defined non-locally
-	SrcLoc			-- Defined non-locally; src-loc gives defn site
-	IfaceFlavour		-- Whether the defn site is an .hi-boot file
-	PrintUnqualified
-
-  | WiredInTyCon TyCon			-- There's a wired-in version
-  | WiredInId    Id			-- ...ditto...
-
-type PrintUnqualified = Bool	-- True <=> the unqualified name of this thing is
-				-- in scope in this module, so print it 
-				-- unqualified in error messages
-\end{code}
-
-Something is "Exported" if it may be mentioned by another module without
-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.
-
-Exported things include:
-
-	- explicitly exported Ids, including data constructors, 
-	  class method selectors
-
-	- dfuns from instance decls
-
-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.
-
-\begin{code}
-data ExportFlag = Exported  | NotExported
-\end{code}
 
 \begin{code}
 mkLocalName    :: Unique -> OccName -> Name
-mkLocalName uniq occ = Local uniq (Just occ)
+mkLocalName uniq occ = Local uniq occ False
+	-- NB: You might worry that after lots of huffing and
+	-- puffing we might end up with two local names with distinct
+	-- uniques, but the same OccName.  Indeed we can, but that's ok
+	--	* the insides of the compiler don't care: they use the Unique
+	--	* when printing for -ddump-xxx you can switch on -dppr-debug to get the
+	--	  uniques if you get confused
+	--	* for interface files we tidyCore first, which puts the uniques
+	--	  into the print name (see setNameVisibility below)
 
 mkGlobalName :: Unique -> Module -> OccName -> Provenance -> Name
 mkGlobalName = Global
 
-mkSysLocalName :: Unique -> Name
-mkSysLocalName uniq = Local uniq Nothing
+mkSysLocalName :: Unique -> FAST_STRING -> Name
+mkSysLocalName uniq fs = Local uniq (varOcc fs) 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 
+  | all_toplev_ids_visible = Global uniq mod occ (LocalDef noSrcLoc NotExported)
+  | otherwise		   = Local uniq occ False
+  where
+    occ = varOcc (_PK_ ((_UNPK_ fs) ++ show uniq))
 
-mkWiredInIdName :: Unique -> Module -> FAST_STRING -> Id -> Name
-mkWiredInIdName uniq mod occ id 
-  = Global uniq mod (VarOcc occ) (WiredInId id)
+mkWiredInIdName :: Unique -> Module -> OccName -> Id -> Name
+mkWiredInIdName uniq mod occ id = Global uniq mod occ (WiredInId id)
 
+-- 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 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))
+  = Global uniq mod (tcOcc occ) (WiredInTyCon tycon)
 
-mkCompoundName f uniq (Local _ Nothing)
-  = Local uniq Nothing
+mkDerivedName :: (OccName -> OccName)
+	      -> Name		-- Base name
+	      -> Unique		-- New unique
+	      -> Name		-- Result is always a value name
 
-setNameProvenance :: Name -> Provenance -> Name	
-	-- setNameProvenance used to only change the provenance of 
-	-- Implicit-provenance things, but that gives bad error messages 
-	-- for names defined twice in the same module, so I changed it to 
-	-- set the provenance of *any* global (SLPJ Jun 97)
-setNameProvenance (Global uniq mod occ _) prov = Global uniq mod occ prov
-setNameProvenance other_name 		  prov = other_name
-
-getNameProvenance :: Name -> Provenance
-getNameProvenance (Global uniq mod occ prov) = prov
-getNameProvenance (Local uniq occ)           = LocalDef noSrcLoc NotExported
+mkDerivedName f (Global _ mod occ prov) uniq = Global uniq mod (f occ) prov
+mkDerivedName f (Local _ occ sys)       uniq = Local uniq (f occ) sys
 
 -- 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
+setNameUnique (Local _ occ sys)        u = Local u occ sys
+setNameUnique (Global  _ mod occ prov) u = Global u mod occ prov
+
+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 (Global uniq mod _ prov) occ = Global uniq mod occ prov
+setNameOcc (Local uniq _ sys)	    occ = Local uniq occ False
 \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)
+%************************************************************************
+%*									*
+\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)
 
-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
@@ -384,41 +197,126 @@ are exported.  But also:
     top-level defns externally visible
 
 \begin{code}
-setNameVisibility :: Maybe Module -> Unique -> Name -> Name
+tidyTopName :: Module -> TidyOccEnv -> Name -> (TidyOccEnv, Name)
+tidyTopName mod env name
+  | isExported name = (env, name)	-- Don't fiddle with an exported name
+					-- It should be in the TidyOccEnv already
+  | otherwise       = (env', name')
+  where
+    prov	 = getNameProvenance name
+    uniq         = nameUnique name
+    (env', occ') = tidyOccName env (nameOccName 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
+    name' | all_toplev_ids_visible = Global uniq mod occ' prov
+	  | otherwise		   = Local uniq occ' False
 
-setNameVisibility maybe_mod uniq name@(Global _ _ _ _)
-  = name					-- Otherwise don't fiddle with Global
+all_toplev_ids_visible = 
+	not opt_OmitInterfacePragmas ||  -- Pragmas can make them visible
+	opt_EnsureSplittableC            -- Splitting requires visiblilty
+\end{code}
 
-setNameVisibility (Just mod) uniq (Local _ _)
-  | all_toplev_ids_visible
-  = Global uniq mod	 			-- Globalise Local name
-	   (uniqToOccName uniq)
-	   (LocalDef noSrcLoc NotExported)
+\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 (Global uniq mod occ _) prov = Global uniq mod occ prov
+setNameProvenance other_name 		  prov = other_name
 
-setNameVisibility maybe_mod uniq (Local _ _)
-  = Local uniq Nothing 			-- New unique for Local; zap its occ
+getNameProvenance :: Name -> Provenance
+getNameProvenance (Global uniq mod occ prov) = prov
+getNameProvenance (Local _ _ _)              = LocalDef noSrcLoc NotExported
+\end{code}
 
+\begin{code}
 -- 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)
+mkNameVisible mod occ_uniq nm@(Local uniq occ _)
+ = Global uniq mod occ (LocalDef noSrcLoc Exported)
+\end{code}
 
-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
+%************************************************************************
+%*									*
+\subsection{Provenance and export info}
+%*									*
+%************************************************************************
 
-all_toplev_ids_visible = 
-	not opt_OmitInterfacePragmas ||  -- Pragmas can make them visible
-	opt_EnsureSplittableC            -- Splitting requires visiblilty
+\begin{code}
+data Provenance
+  = NoProvenance 
+
+  | LocalDef			-- Defined locally
+	SrcLoc 			-- Defn site
+	ExportFlag		-- Whether it's exported
+
+  | NonLocalDef  		-- Defined non-locally
+	ImportReason
+	IfaceFlavour		-- Whether the defn site is an .hi-boot file
+	PrintUnqualified
+
+  | WiredInTyCon TyCon			-- There's a wired-in version
+  | WiredInId    Id			-- ...ditto...
+
+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
+
+data ExportFlag = Exported  | NotExported
+\end{code}
+
+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.
+
+Exported things include:
+
+	- explicitly exported Ids, including data constructors, 
+	  class method selectors
+
+	- dfuns from instance decls
+
+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.
+
+
+\begin{code}
+-- pprNameProvenance is used in error messages to say where a name came from
+pprNameProvenance :: Name -> SDoc
+pprNameProvenance name = pprProvenance (getNameProvenance name)
+
+pprProvenance :: Provenance -> SDoc
+pprProvenance NoProvenance	     = ptext SLIT("No provenance")
+pprProvenance (LocalDef loc _)       = ptext SLIT("defined at")    <+> ppr loc
+pprProvenance (WiredInTyCon tc)      = ptext SLIT("Wired-in tycon")
+pprProvenance (WiredInId id)         = ptext SLIT("Wired-in id")
+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}
 
+
 %************************************************************************
 %*									*
 \subsection{Predicates and selectors}
@@ -440,12 +338,11 @@ isExternallyVisibleName :: Name -> Bool
 
 
 
-nameUnique (Local  u _)     = u
+nameUnique (Local  u _ _)   = u
 nameUnique (Global u _ _ _) = u
 
-nameOccName (Local _ (Just occ)) = occ
-nameOccName (Local uniq Nothing) = pprPanic "nameOccName" (ppr uniq)
-nameOccName (Global _ _ occ _)   = occ
+nameOccName (Local _ occ _)    = occ
+nameOccName (Global _ _ occ _) = occ
 
 nameModule (Global _ mod occ _) = mod
 
@@ -454,14 +351,13 @@ nameModAndOcc (Global _ mod occ _) = (mod,occ)
 isExportedName (Global _ _ _ (LocalDef _ Exported)) = True
 isExportedName 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
+nameSrcLoc (Global _ _ _ (LocalDef loc _))         		 = loc        
+nameSrcLoc (Global _ _ _ (NonLocalDef (UserImport _ loc _) _ _)) = loc
+nameSrcLoc (Global _ _ _ (WiredInTyCon _))         		 = mkBuiltinSrcLoc
+nameSrcLoc (Global _ _ _ (WiredInId _))            		 = mkBuiltinSrcLoc
+nameSrcLoc other			           		 = noSrcLoc   
   
-isLocallyDefinedName (Local  _ _)	     	   = True
+isLocallyDefinedName (Local  _ _ _)	     	   = True
 isLocallyDefinedName (Global _ _ _ (LocalDef _ _)) = True
 isLocallyDefinedName other		           = False
 
@@ -482,11 +378,11 @@ maybeWiredInTyConName (Global _ _ _ (WiredInTyCon tc)) = Just tc
 maybeWiredInTyConName other			       = Nothing
 
 
-isLocalName (Local _ _) = True
-isLocalName _ 		= False
+isLocalName (Local _ _ _) = True
+isLocalName _ 		  = False
 
-isSysLocalName (Local _ Nothing) = True
-isSysLocalName other		 = False
+isSysLocalName (Local _ _ sys) = sys
+isSysLocalName other	       = False
 
 isGlobalName (Global _ _ _ _) = True
 isGlobalName other	      = False
@@ -507,10 +403,10 @@ isExternallyVisibleName name = isGlobalName name
 \begin{code}
 cmpName n1 n2 = c n1 n2
   where
-    c (Local  u1 _)   (Local  u2 _)       = compare u1 u2
-    c (Local   _ _)	  _		  = LT
+    c (Local  u1 _ _)   (Local  u2 _ _)   = compare u1 u2
+    c (Local   _ _ _)   _		  = LT
     c (Global u1 _ _ _) (Global u2 _ _ _) = compare u1 u2
-    c (Global  _ _ _ _)   _		  = GT
+    c (Global  _ _ _ _) _		  = GT
 \end{code}
 
 \begin{code}
@@ -535,103 +431,6 @@ instance NamedThing Name where
 
 %************************************************************************
 %*									*
-\subsection[Special-Names]{Special Kinds of names}
-%*									*
-%************************************************************************
-
-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}
-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'
-\end{code}
-
-%************************************************************************
-%*									*
 \subsection{Pretty printing}
 %*									*
 %************************************************************************
@@ -641,76 +440,62 @@ instance Outputable Name where
 	-- When printing interfaces, all Locals have been given nice print-names
     ppr name = pprName name
 
-pprName name
+pprName (Local uniq occ sys_local)
   = 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
+    pp_local_extra sty uniq
+	| sys_local      = underscore <> pprUnique uniq 	-- Must print uniques for sys_locals
+	| debugStyle sty = text "{-" <> pprUnique uniq <> text "-}"
+	| otherwise	 = empty
 
--- 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
 
-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 (Global uniq mod occ prov)
+  = 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
+    pp_mod_dot sty
+      = 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
+      where
+        user_sty  = userStyle sty
+        iface_sty = ifaceStyle sty
+    
+    pp_qual sep omit_qual
+        | omit_qual  = empty
+        | otherwise	 = pprModule mod <> sep
+    
+    pp_hif HiFile     = dot	 -- Vanilla case
+    pp_hif HiBootFile = text "!"  -- M!t indicates a name imported from a .hi-boot interface
+   
+    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 'i'
+pp_prov (NonLocalDef explicitimport _ _) = char 'I'
+pp_prov (WiredInTyCon _)         	 = char 'W'
+pp_prov (WiredInId _)      	 	 = char 'w'
+pp_prov NoProvenance     	 	 = char '?'
 \end{code}
 
 
@@ -739,11 +524,9 @@ modAndOcc	    = nameModAndOcc	   . getName
 isExported	    = isExportedName 	   . getName
 getSrcLoc	    = nameSrcLoc	   . getName
 isLocallyDefined    = isLocallyDefinedName . getName
-getOccString x	    = _UNPK_ (occNameString (getOccName x))
+getOccString x	    = occNameString (getOccName x)
 \end{code}
 
 \begin{code}
-{-# SPECIALIZE isLocallyDefined
-	:: Name	    -> Bool
-  #-}
+{-# SPECIALIZE isLocallyDefined :: Name -> Bool #-}
 \end{code}
diff --git a/ghc/compiler/basicTypes/NameSet.lhs b/ghc/compiler/basicTypes/NameSet.lhs
index 0e2b137546..0f857db309 100644
--- a/ghc/compiler/basicTypes/NameSet.lhs
+++ b/ghc/compiler/basicTypes/NameSet.lhs
@@ -8,7 +8,8 @@ module NameSet (
 	-- Sets of Names
 	NameSet,
 	emptyNameSet, unitNameSet, mkNameSet, unionNameSets, unionManyNameSets,
-	minusNameSet, elemNameSet, nameSetToList, addOneToNameSet, addListToNameSet, isEmptyNameSet,
+	minusNameSet, elemNameSet, nameSetToList, addOneToNameSet, addListToNameSet, 
+	delFromNameSet, delListFromNameSet, isEmptyNameSet,
     ) where
 
 #include "HsVersions.h"
@@ -26,17 +27,19 @@ import UniqSet
 
 \begin{code}
 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
+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
+delFromNameSet	   :: NameSet -> Name -> NameSet
+delListFromNameSet :: NameSet -> [Name] -> NameSet
 
 isEmptyNameSet    = isEmptyUniqSet
 emptyNameSet	  = emptyUniqSet
@@ -49,6 +52,9 @@ unionManyNameSets = unionManyUniqSets
 minusNameSet	  = minusUniqSet
 elemNameSet       = elementOfUniqSet
 nameSetToList     = uniqSetToList
+delFromNameSet    = delOneFromUniqSet
+
+delListFromNameSet set ns = foldl delFromNameSet set ns
 \end{code}
 
 
diff --git a/ghc/compiler/basicTypes/OccName.lhs b/ghc/compiler/basicTypes/OccName.lhs
new file mode 100644
index 0000000000..11244fbbf7
--- /dev/null
+++ b/ghc/compiler/basicTypes/OccName.lhs
@@ -0,0 +1,594 @@
+
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+%
+
+\section[OccName]{@OccName@}
+
+\begin{code}
+module OccName (
+	-- Modules
+	Module,		-- Abstract, instance of Outputable
+	mkModule, mkModuleFS, moduleString, moduleCString, pprModule,
+
+	-- The OccName type
+	OccName, 	-- Abstract, instance of Outputable
+	varOcc,    tcOcc,    tvOcc,	-- Occ constructors
+	srcVarOcc, srcTCOcc, srcTvOcc,	-- For Occs arising from source code
+
+	mkSuperDictSelOcc, mkDFunOcc, 
+	mkDictOcc, mkWorkerOcc, mkDefaultMethodOcc,
+ 	mkClassTyConOcc, mkClassDataConOcc,
+	
+	isTvOcc, isTCOcc, isVarOcc, isConSymOcc, isConOcc, isSymOcc,
+	pprOccName, occNameString, occNameFlavour, 
+
+	-- The basic form of names
+	isLexCon, isLexVar, isLexId, isLexSym,
+	isLexConId, isLexConSym, isLexVarId, isLexVarSym,
+	isLowerISO, isUpperISO,
+	
+	-- Tidying up
+	TidyOccEnv, emptyTidyOccEnv, tidyOccName, initTidyOccEnv,
+
+	-- Junk	
+ 	identToC
+
+    ) where
+
+#include "HsVersions.h"
+
+import Char	( isAlpha, isUpper, isLower, isAlphanum, ord )
+import Util	( thenCmp )
+import FiniteMap ( FiniteMap, emptyFM, lookupFM, addToFM, elemFM )
+import Outputable
+import GlaExts
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection[Module]{The name of a module}
+%*									*
+%************************************************************************
+
+\begin{code}
+data Module = Module FAST_STRING	-- User and interface files
+		     FAST_STRING	-- Print this in C files
+
+	-- The C version has quote chars Z-encoded
+
+instance Outputable Module where
+  ppr = pprModule
+
+instance Eq Module where
+  (Module m1 _) == (Module m2 _) = m1 == m2
+
+instance Ord Module where
+  (Module m1 _) `compare` (Module m2 _) = m1 `compare` m2
+
+pprModule :: Module -> SDoc
+pprModule (Module real code) 
+  = getPprStyle 	$ \ sty ->
+    if codeStyle sty then
+	ptext code
+    else
+	ptext real
+
+mkModule :: String -> Module
+mkModule s = Module (_PK_ s) (identToC s)
+
+mkModuleFS :: FAST_STRING -> Module
+mkModuleFS s = Module s (identFsToC s)
+
+moduleString :: Module -> String
+moduleString (Module mod _) = _UNPK_ mod
+
+moduleCString :: Module -> String
+moduleCString (Module _ code) = _UNPK_ code
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection[Name-pieces-datatypes]{The @OccName@ datatypes}
+%*									*
+%************************************************************************
+
+\begin{code}
+data OccName = OccName
+		  OccSpace
+		  FAST_STRING	-- The 'real name'
+		  FAST_STRING	-- Print this in interface files
+		  FAST_STRING	-- Print this in C/asm code
+
+-- The OccSpace/real-name pair define the OccName
+-- The iface and c/asm versions are simply derived from the
+-- other two.  They are cached here simply to avoid recomputing
+-- them repeatedly when printing
+
+-- The latter two are irrelevant in RdrNames; on the other hand,
+-- the OccSpace field is irrelevant after RdrNames.
+-- So the OccName type might be refined a bit.  
+-- It is now abstract so that's easier than before
+
+
+-- Why three print-names?  
+--	Real	Iface	C
+--	---------------------	
+--	foo	foo	foo
+--
+--	+	+	Zp	Operators OK in interface files;
+--				'Z' is the escape char for C names
+--
+--	x#	x#	xZh	Trailing # lexed ok by GHC -fglasgow-exts
+--
+--	_foo	_ufoo	_ufoo	Leading '_' is the escape char in interface files
+--
+--	_vfoo	_vfoo	_vfoo	Worker for foo
+--
+--	_wp	_wp	_wp	Worker for +
+
+
+data OccSpace = VarOcc  -- Variables and data constructors
+	      | TvOcc	-- Type variables
+	      | TCOcc	-- Type constructors and classes
+	      deriving( Eq, Ord )
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{Printing}
+%*									*
+%************************************************************************
+ 
+\begin{code}
+instance Outputable OccName where
+  ppr = pprOccName
+
+pprOccName :: OccName -> SDoc
+pprOccName (OccName space real iface code)
+  = getPprStyle $ \ sty ->
+    if codeStyle sty then
+	ptext code
+    else if ifaceStyle sty then
+	ptext iface
+    else
+	ptext real
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{Construction}
+%*									*
+%************************************************************************
+ 
+*Source-code* things beginning with '_' are zapped to begin with '_u'
+
+\begin{code}
+mkSrcOcc :: OccSpace -> FAST_STRING -> OccName
+mkSrcOcc occ_sp real
+  = case _UNPK_ real of
+
+	'_' : rest -> OccName occ_sp real (_PK_ zapped_str) (identToC zapped_str)
+		   where
+		      zapped_str = '_' : 'u' : rest
+
+	other	   -> OccName occ_sp real real (identFsToC real)
+
+srcVarOcc, srcTCOcc, srcTvOcc :: FAST_STRING -> OccName
+srcVarOcc = mkSrcOcc VarOcc
+srcTCOcc  = mkSrcOcc TCOcc
+srcTvOcc  = mkSrcOcc TvOcc
+\end{code}
+
+However, things that don't come from Haskell source code aren't
+treated specially.  
+
+\begin{code}
+mkOcc :: OccSpace -> String -> OccName
+mkOcc occ_sp str = OccName occ_sp fs fs (identToC str)
+		 where
+		   fs = _PK_ str
+
+mkFsOcc :: OccSpace -> FAST_STRING -> OccName
+mkFsOcc occ_sp real = OccName occ_sp real real (identFsToC real)
+
+varOcc, tcOcc, tvOcc :: FAST_STRING -> OccName
+varOcc = mkFsOcc VarOcc
+tcOcc  = mkFsOcc TCOcc
+tvOcc  = mkFsOcc TvOcc
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{Making system names}
+%*									*
+%************************************************************************
+
+Here's our convention for splitting up the interface file name space:
+
+	_d...		dictionary identifiers
+
+	_f...		dict-fun identifiers (from inst decls)
+	_g...		ditto, when the tycon has symbols
+
+	_t...		externally visible (non-user visible) names
+
+	_m...		default methods
+	_n...		default methods (encoded symbols, eg. <= becomes _nle)
+
+	_p...		superclass selectors
+
+	_v...		workers
+	_w...		workers (encoded symbols)
+
+	_x...		local variables
+
+	_u...		user-defined names that previously began with '_'
+
+	_T...		compiler-generated tycons for dictionaries
+	_D..		...ditto data cons
+
+	__....		keywords (__export, __letrec etc.)
+
+This knowledge is encoded in the following functions.
+
+
+
+
+@mkDerivedOcc@ generates an @OccName@ from an existing @OccName@;
+	eg: workers, derived methods
+
+We pass a character to use as the prefix.  So, for example, 
+	"f" gets derived to "_vf", if the prefix char is 'v'
+
+\begin{code}
+mk_deriv :: OccSpace -> Char -> String -> OccName
+mk_deriv occ_sp sys_ch str = mkOcc occ_sp ('_' : sys_ch : str)
+\end{code}
+
+Things are a bit more complicated if the thing is an operator; then
+we must encode it into a normal identifier first.  We do this in 
+a simple way, and use a different character prefix (one after the one 
+suggested).  For example
+	"<" gets derived to "_wl", if the prefix char is 'v'
+
+\begin{code}
+mk_enc_deriv :: OccSpace
+	     -> Char	-- The system-name-space character (see list above)
+	     -> OccName	-- The OccName from which we are deriving
+	     -> OccName
+
+mk_enc_deriv occ_sp sys_ch occ
+  | needs_encoding real_str = mk_deriv occ_sp sys_op_ch (encode_operator real_str)
+  | otherwise 		    = mk_deriv occ_sp sys_ch    real_str
+  where
+    real_str  = occNameString occ
+    sys_op_ch = succ sys_ch
+
+
+mkDictOcc, mkWorkerOcc, mkDefaultMethodOcc,
+ 	   mkClassTyConOcc, mkClassDataConOcc
+   :: OccName -> OccName
+
+mkWorkerOcc        = mk_enc_deriv VarOcc 'v'	-- v,w
+mkDefaultMethodOcc = mk_enc_deriv VarOcc 'm'	-- m,n
+mkClassTyConOcc    = mk_enc_deriv TCOcc  'T'	-- not U
+mkClassDataConOcc  = mk_enc_deriv VarOcc 'D'	-- not E
+mkDictOcc	   = mk_enc_deriv VarOcc 'd'	-- not e
+\end{code}
+
+\begin{code}
+mkSuperDictSelOcc :: Int 	-- Index of superclass, eg 3
+		  -> OccName 	-- Class, eg "Ord"
+		  -> OccName	-- eg "p3Ord"
+mkSuperDictSelOcc index cls_occ
+  = mk_deriv VarOcc 'p' (show index ++ occNameString cls_occ)
+\end{code}
+
+
+\begin{code}
+mkDFunOcc :: OccName 	-- class, eg "Ord"
+	  -> OccName 	-- tycon (or something convenient from the instance type)
+			--	eg "Maybe"
+	  -> Int	-- Unique to distinguish dfuns which share the previous two
+			--	eg 3
+	  -> OccName	-- "dOrdMaybe3"
+
+mkDFunOcc cls_occ tycon_occ index
+  | needs_encoding tycon_str  	-- Drat!  Have to encode the tycon
+  = mk_deriv VarOcc 'g' (show_index ++ cls_str ++ encode_operator tycon_str)
+  | otherwise			-- Normal case
+  = mk_deriv VarOcc 'f' (show_index ++ cls_str ++ tycon_str)
+  where
+    cls_str   = occNameString cls_occ
+    tycon_str = occNameString tycon_occ
+	-- NB: if a non-operator the tycon has a trailing # we don't encode.
+    show_index | index == 0 = ""
+   	       | otherwise  = show index
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{Lexical categories}
+%*									*
+%************************************************************************
+
+These functions test strings to see if they fit the lexical categories
+defined in the Haskell report.
+
+\begin{code}
+isLexCon,   isLexVar,    isLexId,    isLexSym    :: FAST_STRING -> Bool
+isLexConId, isLexConSym, isLexVarId, isLexVarSym :: 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				-- Prefix type or data constructors
+  | _NULL_ cs	     = False		-- 	e.g. "Foo", "[]", "(,)" 
+  | cs == SLIT("[]") = True
+  | c  == '('	     = True	-- (), (,), (,,), ...
+  | otherwise	     = isUpper c || isUpperISO c
+  where					
+    c = _HEAD_ cs
+
+isLexVarId cs				-- Ordinary prefix identifiers
+  | _NULL_ cs	 = False		-- 	e.g. "x", "_x"
+  | otherwise    = isLower c || isLowerISO c || c == '_'
+  where
+    c = _HEAD_ cs
+
+isLexConSym cs				-- Infix type or data constructors
+  | _NULL_ cs	= False			--	e.g. ":-:", ":", "->"
+  | otherwise	= c  == ':'
+	       || cs == SLIT("->")
+  where
+    c = _HEAD_ cs
+
+isLexVarSym cs				-- Infix identifiers
+  | _NULL_ cs = False			-- 	e.g. "+"
+  | 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
+\end{code}
+
+%************************************************************************
+%*									*
+\subsection{Predicates and taking them apart}
+%*									*
+%************************************************************************
+
+\begin{code} 
+occNameString :: OccName -> String
+occNameString (OccName _ s _ _) = _UNPK_ 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 (OccName VarOcc s _ _) | isLexConId s = "Data constructor"
+				      | otherwise    = "Value"
+occNameFlavour (OccName TvOcc _ _ _)		     = "Type variable"
+occNameFlavour (OccName TCOcc s _ _)  		     = "Type constructor or class"
+
+isVarOcc, isTCOcc, isTvOcc,
+ isConSymOcc, isSymOcc :: OccName -> Bool
+
+isVarOcc (OccName VarOcc _ _ _) = True
+isVarOcc other                  = False
+
+isTvOcc (OccName TvOcc _ _ _) = True
+isTvOcc other                 = False
+
+isTCOcc (OccName TCOcc _ _ _) = True
+isTCOcc other                 = False
+
+isConSymOcc (OccName _ s _ _) = isLexConSym s
+
+isSymOcc (OccName _ s _ _) = isLexSym s
+
+isConOcc (OccName _ s _ _) = isLexCon s
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{Comparison}
+%*									*
+%************************************************************************
+ 
+Comparison is done by space and 'real' name
+
+\begin{code}
+instance Eq OccName where
+    a == b = case (a `compare` b) of { EQ -> True;  _ -> False }
+    a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
+
+instance Ord OccName where
+    a <= b = case (a `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 (OccName sp1 r1 _ _) (OccName sp2 r2 _ _)
+	= (sp1 `compare` sp2) `thenCmp` (r1 `compare` r2)
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{Tidying them up}
+%*									*
+%************************************************************************
+
+Before we print chunks of code we like to rename it so that
+we don't have to print lots of silly uniques in it.  But we mustn't
+accidentally introduce name clashes!  So the idea is that we leave the
+OccName alone unless it accidentally clashes with one that is already
+in scope; if so, we tack on '1' at the end and try again, then '2', and
+so on till we find a unique one.
+
+There's a wrinkle for operators.  Consider '>>='.  We can't use '>>=1' 
+because that isn't a single lexeme.  So we encode it to 'lle' and *then*
+tack on the '1', if necessary.
+
+\begin{code}
+type TidyOccEnv = FiniteMap FAST_STRING Int	-- The in-scope OccNames
+emptyTidyOccEnv = emptyFM
+
+initTidyOccEnv :: [OccName] -> TidyOccEnv	-- Initialise with names to avoid!
+initTidyOccEnv = foldl (\env (OccName _ fs _ _) -> addToFM env fs 1) emptyTidyOccEnv
+
+tidyOccName :: TidyOccEnv -> OccName -> (TidyOccEnv, OccName)
+
+tidyOccName in_scope occ@(OccName occ_sp real _ _)
+  | not (real `elemFM` in_scope)
+  = (addToFM in_scope real 1, occ)	-- First occurrence
+
+  | otherwise				-- Already occurs
+  = 	-- First encode, to deal with
+	-- 	a) operators, and 
+	--	b) trailing # signs
+	-- so that we can then append '1', '2', etc
+    go in_scope (encode_operator (_UNPK_ real))
+  where
+
+    go in_scope str = case lookupFM in_scope pk_str of
+			Just n  -> go (addToFM in_scope pk_str (n+1)) (str ++ show n)
+				-- Need to go round again, just in case "t3" (say) 
+				-- clashes with a "t3" that's already in scope
+
+			Nothing -> (addToFM in_scope pk_str 1, mkFsOcc occ_sp pk_str)
+				-- str is now unique
+		    where
+		      pk_str = _PK_ str
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{Encoding for operators in derived names}
+%*									*
+%************************************************************************
+
+See comments with mk_enc_deriv
+
+\begin{code}
+needs_encoding :: String -> Bool	-- Needs encoding when embedded in a derived name
+					-- Just look at the first character
+needs_encoding (c:cs) = not (isAlpha c || c == '_')
+
+encode_operator :: String -> String
+encode_operator nm = foldr tran "" nm
+ where 
+    tran c cs = case trChar c of
+		   '\0'  -> '_' : show (ord c) ++ cs  -- No translation
+		   tr_c  -> tr_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'	-- No translation
+\end{code}
+
+
+%************************************************************************
+%*									*
+\subsection{The 'Z' encoding}
+%*									*
+%************************************************************************
+
+We provide two interfaces for efficiency.
+
+\begin{code}
+identToC :: String -> FAST_STRING
+identToC str
+  | all isAlphanum str && not std = _PK_ str
+  | std 			  = _PK_ ("Zs" ++ encode str)
+  | otherwise			  = _PK_ (encode str)
+  where
+    std = has_std_prefix str
+
+identFsToC :: FAST_STRING -> FAST_STRING
+identFsToC fast_str
+  | all isAlphanum str && not std = fast_str
+  | std				  = _PK_ ("Zs" ++ encode str)
+  | otherwise			  = _PK_ (encode str)
+  where
+    std = has_std_prefix str
+    str = _UNPK_ fast_str
+
+-- avoid "stdin", "stdout", and "stderr"...
+has_std_prefix ('s':'t':'d':_) = True
+has_std_prefix _	       = False
+
+encode :: String -> String
+encode [] = []
+encode (c:cs) = encode_ch c ++ encode cs
+
+encode_ch :: Char -> String
+encode_ch c | isAlphanum c = [c]
+	-- Common case first
+encode_ch 'Z'  = "ZZ"
+encode_ch '&'  = "Za"
+encode_ch '|'  = "Zb"
+encode_ch ':'  = "Zc"
+encode_ch '/'  = "Zd"
+encode_ch '='  = "Ze"
+encode_ch '>'  = "Zg"
+encode_ch '#'  = "Zh"
+encode_ch '<'  = "Zl"
+encode_ch '-'  = "Zm"
+encode_ch '!'  = "Zn"
+encode_ch '.'  = "Zd"
+encode_ch '\'' = "Zq"
+encode_ch '*'  = "Zt"
+encode_ch '+'  = "Zp"
+encode_ch '_'  = "_"
+encode_ch c    = 'Z':show (ord c)
+\end{code}
+
+For \tr{modnameToC}, we really only have to worry about \tr{'}s
+(quote chars) in the name.  Rare.
+
+\begin{code}
+modnameToC  :: FAST_STRING -> FAST_STRING
+modnameToC fast_str = identFsToC fast_str
+\end{code}
diff --git a/ghc/compiler/basicTypes/PprEnv.lhs b/ghc/compiler/basicTypes/PprEnv.lhs
index 4e502e05cc..ed06d2ce15 100644
--- a/ghc/compiler/basicTypes/PprEnv.lhs
+++ b/ghc/compiler/basicTypes/PprEnv.lhs
@@ -18,9 +18,9 @@ module PprEnv (
 
 import {-# SOURCE #-} Const ( Con )
 
-import Var		( GenId, GenTyVar )
+import Var		( Id, TyVar )
 import CostCentre	( CostCentre )
-import Type  		( GenType )
+import Type  		( Type )
 import Outputable
 \end{code}
 
@@ -31,16 +31,16 @@ import Outputable
 %************************************************************************
 
 \begin{code}
-data PprEnv bndr flexi
+data PprEnv bndr
   = PE	{
 	pCon :: Con        -> SDoc,
 	pSCC :: CostCentre -> SDoc,
 
-	pTyVarO :: GenTyVar flexi -> SDoc,	-- to print tyvar occurrences
-	pTy     :: GenType flexi -> SDoc,	-- to print types
+	pTyVarO :: TyVar -> SDoc,	-- to print tyvar occurrences
+	pTy     :: Type -> SDoc,	-- to print types
 
 	pBndr :: BindingSite -> bndr -> SDoc,	-- to print value binders
-	pOcc  :: GenId flexi -> SDoc		-- to print value occurrences
+	pOcc  :: Id -> SDoc		-- to print value occurrences
    }
 \end{code}
 
@@ -55,11 +55,11 @@ data BindingSite = LambdaBind | CaseBind | LetBind
 initPprEnv
 	:: Maybe (Con -> SDoc)
 	-> Maybe (CostCentre -> SDoc)
-	-> Maybe (GenTyVar flexi -> SDoc)
-	-> Maybe (GenType flexi -> SDoc)
+	-> Maybe (TyVar -> SDoc)
+	-> Maybe (Type -> SDoc)
 	-> Maybe (BindingSite -> bndr -> SDoc)
-	-> Maybe (GenId flexi -> SDoc)
-	-> PprEnv bndr flexi
+	-> Maybe (Id -> SDoc)
+	-> PprEnv bndr
 
 -- you can specify all the printers individually; if
 -- you don't specify one, you get bottom
diff --git a/ghc/compiler/basicTypes/UniqSupply.lhs b/ghc/compiler/basicTypes/UniqSupply.lhs
index 1ae2133430..4b8a7564f7 100644
--- a/ghc/compiler/basicTypes/UniqSupply.lhs
+++ b/ghc/compiler/basicTypes/UniqSupply.lhs
@@ -23,7 +23,7 @@ module UniqSupply (
 #include "HsVersions.h"
 
 import Unique
-import Util
+import Panic	( panic )
 
 import GlaExts
 
diff --git a/ghc/compiler/basicTypes/Unique.lhs b/ghc/compiler/basicTypes/Unique.lhs
index 1c0dda9bd4..d91bf45e56 100644
--- a/ghc/compiler/basicTypes/Unique.lhs
+++ b/ghc/compiler/basicTypes/Unique.lhs
@@ -51,7 +51,7 @@ module Unique (
 	augmentIdKey,
 	boolTyConKey,
 	boundedClassKey,
-	boxedKindConKey,
+	boxedConKey,
 	buildIdKey,
 	byteArrayPrimTyConKey,
 	cCallableClassKey,
@@ -129,7 +129,7 @@ module Unique (
 	noMethodBindingErrorIdKey,
 	nonExhaustiveGuardsErrorIdKey,
 	numClassKey,
-	openKindConKey,
+	anyBoxConKey,
 	ordClassKey,
 	orderingTyConKey,
 	otherwiseIdKey,
@@ -160,14 +160,16 @@ module Unique (
 	stateTyConKey,
 
 	statePrimTyConKey,
-	superKindConKey,
+	typeConKey,
+	kindConKey,
+	boxityConKey,
 	mVarPrimTyConKey,
 	thenMClassOpKey,
 	threadIdPrimTyConKey,
 	toEnumClassOpKey,
 	traceIdKey,
 	trueDataConKey,
-	unboxedKindConKey,
+	unboxedConKey,
 	unpackCString2IdKey,
 	unpackCStringAppendIdKey,
 	unpackCStringFoldrIdKey,
@@ -200,13 +202,12 @@ module Unique (
 
 #include "HsVersions.h"
 
-import FastString	( uniqueOfFS )
+import FastString	( FastString, uniqueOfFS )
 import GlaExts
 import ST
 import PrelBase ( Char(..), chr, ord )
 
 import Outputable
-import Util
 \end{code}
 
 %************************************************************************
@@ -534,12 +535,13 @@ word32TyConKey				= mkPreludeTyConUnique 61
 word64PrimTyConKey			= mkPreludeTyConUnique 62
 word64TyConKey				= mkPreludeTyConUnique 63
 voidTyConKey				= mkPreludeTyConUnique 64
-boxedKindConKey				= mkPreludeTyConUnique 65
-unboxedKindConKey			= mkPreludeTyConUnique 66
-openKindConKey				= mkPreludeTyConUnique 67
-superKindConKey				= mkPreludeTyConUnique 68
-threadIdPrimTyConKey			= mkPreludeTyConUnique 69
-
+boxedConKey				= mkPreludeTyConUnique 65
+unboxedConKey				= mkPreludeTyConUnique 66
+anyBoxConKey				= mkPreludeTyConUnique 67
+kindConKey				= mkPreludeTyConUnique 68
+boxityConKey				= mkPreludeTyConUnique 69
+typeConKey				= mkPreludeTyConUnique 70
+threadIdPrimTyConKey			= mkPreludeTyConUnique 71
 \end{code}
 
 %************************************************************************
diff --git a/ghc/compiler/basicTypes/Var.lhs b/ghc/compiler/basicTypes/Var.lhs
index fb760e6fca..6bf3a88b00 100644
--- a/ghc/compiler/basicTypes/Var.lhs
+++ b/ghc/compiler/basicTypes/Var.lhs
@@ -8,36 +8,39 @@ module Var (
 	Var, IdOrTyVar,		-- Abstract
 	VarDetails(..), 	-- Concrete
 	varName, varUnique, varDetails, varInfo, varType,
-	setVarName, setVarUnique, setVarType,
+	setVarName, setVarUnique, setVarType,  setVarOcc,
 
 
 	-- TyVars
-	TyVar, GenTyVar,
+	TyVar,
 	tyVarName, tyVarKind,
-	tyVarFlexi, setTyVarFlexi, removeTyVarFlexi, setTyVarName, setTyVarUnique,
-	mkFlexiTyVar, mkTyVar, mkSysTyVar, isTyVar, isFlexiTyVar,
+	setTyVarName, setTyVarUnique,
+	mkTyVar, mkSysTyVar, isTyVar,
+	newMutTyVar, readMutTyVar, writeMutTyVar, isMutTyVar, makeTyVarImmutable,
 
 	-- Ids
-	Id, DictId, GenId,
-	idName, idType, idUnique, idInfo, modifyIdInfo,
+	Id, DictId,
+	idDetails, idName, idType, idUnique, idInfo, modifyIdInfo,
 	setIdName, setIdUnique, setIdInfo,
 	mkId, isId, externallyVisibleId
     ) where
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-}	Type( GenType, Kind )
+import {-# SOURCE #-}	Type( Type, Kind )
 import {-# SOURCE #-}	IdInfo( IdInfo )
 import {-# SOURCE #-}	Const( Con )
 
 import FieldLabel	( FieldLabel )
 import Unique		( Unique, Uniquable(..), mkUniqueGrimily, getKey )
-import Name		( Name, NamedThing(..),
-			  changeUnique, nameUnique, 
+import Name		( Name, OccName, NamedThing(..),
+			  setNameUnique, setNameOcc, nameUnique, 
 			  mkSysLocalName, isExternallyVisibleName
 			)
 import BasicTypes	( Unused )
 import Outputable
+
+import IOExts		( IORef, newIORef, readIORef, writeIORef )
 \end{code}
 
 
@@ -55,46 +58,49 @@ strictness).  The essential info about different kinds of @Vars@ is
 in its @VarDetails@.
 
 \begin{code}
-type IdOrTyVar = Var Unused Unused 
+type IdOrTyVar = Var
 
-data Var flex_self flex_ty 
+data Var
   = Var {
 	varName    :: Name,
 	realUnique :: Int#,		-- Key for fast comparison
 					-- Identical to the Unique in the name,
 					-- cached here for speed
-	varType    :: GenType flex_ty,
-	varDetails :: VarDetails flex_self,
+	varType    :: Type,
+	varDetails :: VarDetails,
 	varInfo    :: IdInfo		-- Only used for Ids at the moment
     }
 
-varUnique Var{realUnique = uniq} = mkUniqueGrimily uniq
-
-data VarDetails flex_self
-  = TyVar
-  | FlexiTyVar flex_self	-- Used during unification
-  | VanillaId 			-- Most Ids are like this
-  | ConstantId Con		-- The Id for a constant (data constructor or primop)
-  | RecordSelId FieldLabel	-- The Id for a record selector
+data VarDetails
+  = VanillaId 				-- Most Ids are like this
+  | ConstantId Con			-- The Id for a constant (data constructor or primop)
+  | RecordSelId FieldLabel		-- The Id for a record selector
+  | TyVar
+  | MutTyVar (IORef (Maybe Type))	-- Used during unification
+
+-- For a long time I tried to keep mutable Vars statically type-distinct
+-- from immutable Vars, but I've finally given up.   It's just too painful.
+-- After type checking there are no MutTyVars left, but there's no static check
+-- of that fact.
 \end{code}
 
 \begin{code}
-instance Outputable (Var fs ft) where
+instance Outputable Var where
   ppr var = ppr (varName var)
 
-instance Show (Var fs ft) where
+instance Show Var where
   showsPrec p var = showsPrecSDoc p (ppr var)
 
-instance NamedThing (Var fs ft) where
+instance NamedThing Var where
   getName = varName
 
-instance Uniquable (Var fs ft) where
+instance Uniquable Var where
   getUnique = varUnique
 
-instance Eq (Var fs ft) where
+instance Eq Var where
     a == b = realUnique a ==# realUnique b
 
-instance Ord (Var fs ft) where
+instance Ord Var where
     a <= b = realUnique a <=# realUnique b
     a <	 b = realUnique a <#  realUnique b
     a >= b = realUnique a >=# realUnique b
@@ -104,15 +110,22 @@ instance Ord (Var fs ft) where
 
 
 \begin{code}
-setVarUnique :: Var fs ft -> Unique -> Var fs ft
+varUnique :: Var -> Unique
+varUnique (Var {realUnique = uniq}) = mkUniqueGrimily uniq
+
+setVarUnique :: Var -> Unique -> Var
 setVarUnique var uniq = var {realUnique = getKey uniq, 
-			     varName = changeUnique (varName var) uniq}
+			     varName = setNameUnique (varName var) uniq}
 
-setVarName :: Var fs ft -> Name -> Var fs ft
+setVarName :: Var -> Name -> Var
 setVarName var new_name
   = var { realUnique = getKey (getUnique new_name), varName = new_name }
 
-setVarType :: Var flex_self flex_ty1 -> GenType flex_ty2 -> Var flex_self flex_ty2
+setVarOcc :: Var -> OccName -> Var
+setVarOcc var new_occ
+  = var { varName = setNameOcc (varName var) new_occ }
+
+setVarType :: Var -> Type -> Var
 setVarType var ty = var {varType = ty}
 \end{code}
 
@@ -124,10 +137,7 @@ setVarType var ty = var {varType = ty}
 %************************************************************************
 
 \begin{code}
-type GenTyVar flex_self = Var flex_self Unused		-- Perhaps a mutable tyvar, but 
-							-- with a fixed Kind
-
-type TyVar		= GenTyVar Unused		-- NOt even mutable
+type TyVar = Var
 \end{code}
 
 \begin{code}
@@ -136,46 +146,47 @@ tyVarKind = varType
 
 setTyVarUnique = setVarUnique
 setTyVarName   = setVarName
-
-tyVarFlexi :: GenTyVar flexi -> flexi
-tyVarFlexi (Var {varDetails = FlexiTyVar flex}) = flex
-tyVarFlexi other_var        = pprPanic "tyVarFlexi" (ppr other_var)
-
-setTyVarFlexi :: GenTyVar flexi1 -> flexi2 -> GenTyVar flexi2
-setTyVarFlexi var flex = var {varDetails = FlexiTyVar flex}
-
-removeTyVarFlexi :: GenTyVar flexi1 -> GenTyVar flexi2
-removeTyVarFlexi var = var {varDetails = TyVar}
 \end{code}
 
 \begin{code}
-mkTyVar :: Name -> Kind -> GenTyVar flexi
+mkTyVar :: Name -> Kind -> TyVar
 mkTyVar name kind = Var { varName = name, realUnique = getKey (nameUnique name),
 			  varType = kind, varDetails = TyVar }
 
-mkSysTyVar :: Unique -> Kind -> GenTyVar flexi
+mkSysTyVar :: Unique -> Kind -> TyVar
 mkSysTyVar uniq kind = Var { varName = name, realUnique = getKey uniq,
 			     varType = kind, varDetails = TyVar }
 		     where
-		       name = mkSysLocalName uniq
+		       name = mkSysLocalName uniq SLIT("t")
+
+newMutTyVar :: Name -> Kind -> IO TyVar
+newMutTyVar name kind = 
+  do loc <- newIORef Nothing
+     return (Var { varName = name, 
+		   realUnique = getKey (nameUnique name),
+		   varType = kind, 
+		   varDetails = MutTyVar loc })
+
+readMutTyVar :: TyVar -> IO (Maybe Type)
+readMutTyVar (Var {varDetails = MutTyVar loc}) = readIORef loc
+
+writeMutTyVar :: TyVar -> Maybe Type -> IO ()
+writeMutTyVar (Var {varDetails = MutTyVar loc}) val = writeIORef loc val
 
-mkFlexiTyVar :: Name -> Kind -> flexi -> GenTyVar flexi
-mkFlexiTyVar name kind flex = Var { varName = name, 
-				    realUnique = getKey (nameUnique name),
-			            varType = kind, 
-				    varDetails = FlexiTyVar flex }
+makeTyVarImmutable :: TyVar -> TyVar
+makeTyVarImmutable tyvar = tyvar { varDetails = TyVar}
 \end{code}
 
 \begin{code}
-isTyVar :: Var fs ft -> Bool
+isTyVar :: Var -> Bool
 isTyVar (Var {varDetails = details}) = case details of
-					TyVar        -> True
-					FlexiTyVar _ -> True
-					other	     -> False
+					TyVar      -> True
+					MutTyVar _ -> True
+					other	   -> False
 
-isFlexiTyVar :: Var fs ft -> Bool
-isFlexiTyVar (Var {varDetails = FlexiTyVar _}) = True
-isFlexiTyVar other			       = False
+isMutTyVar :: Var -> Bool
+isMutTyVar (Var {varDetails = MutTyVar _}) = True
+isMutTyVar other			       = False
 \end{code}
 
 
@@ -188,9 +199,8 @@ isFlexiTyVar other			       = False
 	Most Id-related functions are in Id.lhs and MkId.lhs
 
 \begin{code}
-type GenId flex_ty = Var Unused flex_ty
-type Id 	   = GenId Unused
-type DictId	   = Id
+type Id     = Var
+type DictId = Id
 \end{code}
 
 \begin{code}
@@ -206,22 +216,22 @@ setIdUnique = setVarUnique
 setIdName :: Id -> Name -> Id
 setIdName = setVarName
 
-setIdInfo :: GenId flexi -> IdInfo -> GenId flexi
+setIdInfo :: Id -> IdInfo -> Id
 setIdInfo var info = var {varInfo = info}
 
-modifyIdInfo :: GenId flexi -> (IdInfo -> IdInfo) -> GenId flexi
+modifyIdInfo :: Id -> (IdInfo -> IdInfo) -> Id
 modifyIdInfo var@(Var {varInfo = info}) fn = var {varInfo = fn info}
 \end{code}
 
 \begin{code}
-mkId :: Name -> GenType flex_ty  -> VarDetails Unused -> IdInfo -> GenId flex_ty
+mkId :: Name -> Type -> VarDetails -> IdInfo -> Id
 mkId name ty details info
   = Var {varName = name, realUnique = getKey (nameUnique name), varType = ty, 
 	 varDetails = details, varInfo = info}
 \end{code}
 
 \begin{code}
-isId :: Var fs ft -> Bool
+isId :: Var -> Bool
 isId (Var {varDetails = details}) = case details of
 					VanillaId     -> True
 					ConstantId _  -> True
diff --git a/ghc/compiler/basicTypes/VarEnv.lhs b/ghc/compiler/basicTypes/VarEnv.lhs
index ed0986345a..515025b3ed 100644
--- a/ghc/compiler/basicTypes/VarEnv.lhs
+++ b/ghc/compiler/basicTypes/VarEnv.lhs
@@ -14,12 +14,15 @@ module VarEnv (
 	lookupVarEnv, lookupVarEnv_NF,
 	mapVarEnv, zipVarEnv,
 	modifyVarEnv, modifyVarEnv_Directly,
-	isEmptyVarEnv, foldVarEnv
+	isEmptyVarEnv, foldVarEnv,
+
+	TidyEnv, emptyTidyEnv
     ) where
 
 #include "HsVersions.h"
 
-import Var	( Var, Id )
+import OccName	( TidyOccEnv, emptyTidyOccEnv )
+import Var	( Var, Id, IdOrTyVar )
 import UniqFM
 import Util	( zipEqual )
 \end{code}
@@ -27,6 +30,21 @@ import Util	( zipEqual )
 
 %************************************************************************
 %*									*
+\subsection{Tidying}
+%*									*
+%************************************************************************
+
+When tidying up print names, we keep a mapping of in-scope occ-names
+(the TidyOccEnv) and a Var-to-Var of the current renamings.
+
+\begin{code}
+type TidyEnv = (TidyOccEnv, VarEnv IdOrTyVar)
+emptyTidyEnv = (emptyTidyOccEnv, emptyVarEnv)
+\end{code}
+
+
+%************************************************************************
+%*									*
 \subsection{@VarEnv@s}
 %*									*
 %************************************************************************
@@ -37,24 +55,24 @@ type IdEnv elt    = VarEnv elt
 type TyVarEnv elt = VarEnv elt
 
 emptyVarEnv	  :: VarEnv a
-mkVarEnv	  :: [(Var fs ft, a)] -> VarEnv a
-zipVarEnv	  :: [Var fs ft] -> [a] -> VarEnv a
-unitVarEnv	  :: Var fs ft -> a -> VarEnv a
-extendVarEnv	  :: VarEnv a -> Var fs ft -> a -> VarEnv a
+mkVarEnv	  :: [(Var, a)] -> VarEnv a
+zipVarEnv	  :: [Var] -> [a] -> VarEnv a
+unitVarEnv	  :: Var -> a -> VarEnv a
+extendVarEnv	  :: VarEnv a -> Var -> a -> VarEnv a
 plusVarEnv	  :: VarEnv a -> VarEnv a -> VarEnv a
-extendVarEnvList  :: VarEnv a -> [(Var fs ft, a)] -> VarEnv a
+extendVarEnvList  :: VarEnv a -> [(Var, a)] -> VarEnv a
 		  
-delVarEnvList     :: VarEnv a -> [Var fs ft] -> VarEnv a
-delVarEnv	  :: VarEnv a -> Var fs ft -> VarEnv a
+delVarEnvList     :: VarEnv a -> [Var] -> VarEnv a
+delVarEnv	  :: VarEnv a -> Var -> VarEnv a
 plusVarEnv_C	  :: (a -> a -> a) -> VarEnv a -> VarEnv a -> VarEnv a
 mapVarEnv	  :: (a -> b) -> VarEnv a -> VarEnv b
-modifyVarEnv	  :: (a -> a) -> VarEnv a -> Var fs ft -> VarEnv a
+modifyVarEnv	  :: (a -> a) -> VarEnv a -> Var -> VarEnv a
 rngVarEnv	  :: VarEnv a -> [a]
 		  
 isEmptyVarEnv	  :: VarEnv a -> Bool
-lookupVarEnv	  :: VarEnv a -> Var fs ft -> Maybe a
-lookupVarEnv_NF   :: VarEnv a -> Var fs ft -> a
-elemVarEnv	  :: Var fs ft -> VarEnv a -> Bool
+lookupVarEnv	  :: VarEnv a -> Var -> Maybe a
+lookupVarEnv_NF   :: VarEnv a -> Var -> a
+elemVarEnv	  :: Var -> VarEnv a -> Bool
 foldVarEnv	  :: (a -> b -> b) -> b -> VarEnv a -> b
 \end{code}
 
diff --git a/ghc/compiler/basicTypes/VarSet.lhs b/ghc/compiler/basicTypes/VarSet.lhs
index 217e3a16fa..9091dfe2b7 100644
--- a/ghc/compiler/basicTypes/VarSet.lhs
+++ b/ghc/compiler/basicTypes/VarSet.lhs
@@ -5,7 +5,7 @@
 
 \begin{code}
 module VarSet (
-	VarSet, IdSet, GenIdSet, TyVarSet, GenTyVarSet, IdOrTyVarSet,
+	VarSet, IdSet, TyVarSet, IdOrTyVarSet,
 	emptyVarSet, unitVarSet, mkVarSet,
 	extendVarSet,
 	elemVarSet, varSetElems,
@@ -20,7 +20,7 @@ module VarSet (
 
 #include "HsVersions.h"
 
-import Var		( Var, Id, GenId, TyVar, GenTyVar, IdOrTyVar, setVarUnique )
+import Var		( Var, Id, TyVar, IdOrTyVar, setVarUnique )
 import Unique		( Uniquable(..), incrUnique )
 import UniqSet
 import Outputable
@@ -33,32 +33,30 @@ import Outputable
 %************************************************************************
 
 \begin{code}
-type VarSet fs ft      = UniqSet (Var fs ft)
-type IdSet 	       = UniqSet Id
-type GenIdSet flexi    = UniqSet (GenId flexi)
-type TyVarSet	       = UniqSet TyVar
-type GenTyVarSet flexi = UniqSet (GenTyVar flexi)
-type IdOrTyVarSet      = UniqSet IdOrTyVar
+type VarSet       = UniqSet Var
+type IdSet 	  = UniqSet Id
+type TyVarSet	  = UniqSet TyVar
+type IdOrTyVarSet = UniqSet IdOrTyVar
 
-emptyVarSet	:: VarSet fs ft
-intersectVarSet	:: VarSet fs ft -> VarSet fs ft -> VarSet fs ft
-intersectsVarSet:: VarSet fs ft -> VarSet fs ft -> Bool 	-- True if non-empty intersection
-unionVarSet	:: VarSet fs ft -> VarSet fs ft -> VarSet fs ft
-unionVarSets	:: [VarSet fs ft] -> VarSet fs ft
-varSetElems	:: VarSet fs ft -> [Var fs ft]
-unitVarSet	:: Var fs ft -> VarSet fs ft
-extendVarSet	:: VarSet fs ft -> Var fs ft -> VarSet fs ft
-elemVarSet	:: Var fs ft -> VarSet fs ft -> Bool
-delVarSet	:: VarSet fs ft -> Var fs ft -> VarSet fs ft
-minusVarSet	:: VarSet fs ft -> VarSet fs ft -> VarSet fs ft
-isEmptyVarSet	:: VarSet fs ft -> Bool
-mkVarSet	:: [Var fs ft] -> VarSet fs ft
-foldVarSet	:: (Var fs ft -> a -> a) -> a -> VarSet fs ft -> a
-lookupVarSet	:: VarSet fs ft -> Var fs ft -> Maybe (Var fs ft)
+emptyVarSet	:: VarSet
+intersectVarSet	:: VarSet -> VarSet -> VarSet
+intersectsVarSet:: VarSet -> VarSet -> Bool 	-- True if non-empty intersection
+unionVarSet	:: VarSet -> VarSet -> VarSet
+unionVarSets	:: [VarSet] -> VarSet
+varSetElems	:: VarSet -> [Var]
+unitVarSet	:: Var -> VarSet
+extendVarSet	:: VarSet -> Var -> VarSet
+elemVarSet	:: Var -> VarSet -> Bool
+delVarSet	:: VarSet -> Var -> VarSet
+minusVarSet	:: VarSet -> VarSet -> VarSet
+isEmptyVarSet	:: VarSet -> Bool
+mkVarSet	:: [Var] -> VarSet
+foldVarSet	:: (Var -> a -> a) -> a -> VarSet -> a
+lookupVarSet	:: VarSet -> Var -> Maybe Var
 			-- Returns the set element, which may be
 			-- (==) to the argument, but not the same as
-mapVarSet 	:: (Var fs ft -> Var fs ft) -> VarSet fs ft -> VarSet fs ft
-filterVarSet	:: (Var fs ft -> Bool) -> VarSet fs ft -> VarSet fs ft
+mapVarSet 	:: (Var -> Var) -> VarSet -> VarSet
+filterVarSet	:: (Var -> Bool) -> VarSet -> VarSet
 
 emptyVarSet	= emptyUniqSet
 unitVarSet	= unitUniqSet
@@ -80,7 +78,7 @@ filterVarSet	= filterUniqSet
 \end{code}
 
 \begin{code}
-uniqAway :: VarSet fs ft -> Var fs ft -> Var fs ft
+uniqAway :: VarSet -> Var -> Var
 -- Give the Var a new unique, different to any in the VarSet
 uniqAway set var
   = try 1 (incrUnique (getUnique var))