[project @ 1996-12-19 09:10:02 by simonpj]

SLPJ new renamer and lots more

7 files changed, 610 insertions, 425 deletions

diff --git a/ghc/compiler/prelude/PrelInfo.lhs b/ghc/compiler/prelude/PrelInfo.lhs
index 04bd913e5f..ed2bec583c 100644
--- a/ghc/compiler/prelude/PrelInfo.lhs
+++ b/ghc/compiler/prelude/PrelInfo.lhs
@@ -7,20 +7,33 @@
 #include "HsVersions.h"
 
 module PrelInfo (
-
 	-- finite maps for built-in things (for the renamer and typechecker):
-	builtinNameInfo, builtinNameMaps,
-	builtinValNamesMap, builtinTcNamesMap,
-	builtinKeysMap,
+	builtinNames, builtinKeys, derivingOccurrences,
 	SYN_IE(BuiltinNames),
-	SYN_IE(BuiltinKeys), SYN_IE(BuiltinIdInfos),
 
-	maybeCharLikeTyCon, maybeIntLikeTyCon
+	maybeCharLikeTyCon, maybeIntLikeTyCon,
+
+	eq_RDR, ne_RDR, le_RDR, lt_RDR, ge_RDR, gt_RDR, max_RDR, min_RDR, compare_RDR, 
+	minBound_RDR, maxBound_RDR, enumFrom_RDR, enumFromTo_RDR, enumFromThen_RDR, 
+	enumFromThenTo_RDR, fromEnum_RDR,
+	range_RDR, index_RDR, inRange_RDR, readsPrec_RDR, readList_RDR, 
+	showsPrec_RDR, showList_RDR, plus_RDR, times_RDR, ltTag_RDR, eqTag_RDR, gtTag_RDR, 
+	eqH_Char_RDR, ltH_Char_RDR, eqH_Word_RDR, ltH_Word_RDR, eqH_Addr_RDR, ltH_Addr_RDR, 
+	eqH_Float_RDR, ltH_Float_RDR, eqH_Double_RDR, ltH_Double_RDR, eqH_Int_RDR, ltH_Int_RDR, 
+	geH_RDR, leH_RDR, minusH_RDR, false_RDR, true_RDR, and_RDR, not_RDR, append_RDR, 
+	map_RDR, compose_RDR, mkInt_RDR, error_RDR, showString_RDR, showParen_RDR, readParen_RDR, 
+	lex_RDR, showSpace_RDR, showList___RDR, readList___RDR, negate_RDR,
+
+	numClass_RDR, fractionalClass_RDR, eqClass_RDR, ccallableClass_RDR, creturnableClass_RDR,
+	monadZeroClass_RDR, enumClass_RDR, evalClass_RDR, ordClass_RDR,
+
+	needsDataDeclCtxtClassKeys, cCallishClassKeys, isNoDictClass,
+	isNumericClass, isStandardClass, isCcallishClass
     ) where
 
 IMP_Ubiq()
-IMPORT_DELOOPER(PrelLoop) ( primOpNameInfo )
-IMPORT_DELOOPER(IdLoop)	  ( SpecEnv )
+IMPORT_DELOOPER(PrelLoop) ( primOpName )
+-- IMPORT_DELOOPER(IdLoop)	  ( SpecEnv )
 
 -- friends:
 import PrelMods		-- Prelude module names
@@ -31,16 +44,18 @@ import TysPrim		-- TYPES
 import TysWiredIn
 
 -- others:
-import FiniteMap	( FiniteMap, emptyFM, listToFM )
-import Id		( mkTupleCon, GenId, SYN_IE(Id) )
-import Maybes		( catMaybes )
-import Name		( origName, OrigName(..), Name )
-import RnHsSyn		( RnName(..) )
-import TyCon		( tyConDataCons, mkFunTyCon, mkTupleTyCon, TyCon )
+import SpecEnv		( SpecEnv )
+import RdrHsSyn		( RdrName(..), varQual, tcQual, qual )
+import Id		( GenId, SYN_IE(Id) )
+import Name		( Name, OccName(..), DefnInfo(..), Provenance(..),
+			  getName, mkGlobalName, modAndOcc )
+import Class		( Class(..), GenClass, classKey )
+import TyCon		( tyConDataCons, mkFunTyCon, TyCon )
 import Type
-import UniqFM		( UniqFM, emptyUFM, listToUFM )
+import Bag
 import Unique		-- *Key stuff
-import Util		( nOfThem, panic )
+import UniqFM		( UniqFM, listToUFM ) 
+import Util		( isIn )
 \end{code}
 
 %************************************************************************
@@ -53,61 +68,29 @@ We have two ``builtin name funs,'' one to look up @TyCons@ and
 @Classes@, the other to look up values.
 
 \begin{code}
-builtinNameInfo :: ( BuiltinNames, BuiltinKeys, BuiltinIdInfos )
-
-type BuiltinNames   = (FiniteMap OrigName RnName, -- WiredIn Ids
-		       FiniteMap OrigName RnName) -- WiredIn TyCons
-			-- Two maps because "[]" is in both...
-
-type BuiltinKeys    = FiniteMap OrigName (Unique, Name -> RnName)
-						     -- Names with known uniques
-
-type BuiltinIdInfos = UniqFM IdInfo		     -- Info for known unique Ids
-
-builtinNameMaps    = case builtinNameInfo of { (x,_,_) -> x }
-builtinKeysMap	   = case builtinNameInfo of { (_,x,_) -> x }
-builtinValNamesMap = fst builtinNameMaps
-builtinTcNamesMap  = snd builtinNameMaps
-
-builtinNameInfo
-  = ( (listToFM assoc_val_wired, listToFM assoc_tc_wired)
-    , listToFM assoc_keys
-    , listToUFM assoc_id_infos
-    )
-  where
-    assoc_val_wired
-    	= concat [
-	    -- data constrs
-	    concat (map pcDataConWiredInInfo g_con_tycons),
-	    concat (map pcDataConWiredInInfo data_tycons),
-
-	    -- values
-	    map pcIdWiredInInfo wired_in_ids,
-	    primop_ids
-	  ]
-    assoc_tc_wired
-    	= concat [
-	    -- tycons
-	    map pcTyConWiredInInfo prim_tycons,
-	    map pcTyConWiredInInfo g_tycons,
-	    map pcTyConWiredInInfo data_tycons
-	  ]
-
-    assoc_keys
-	= concat
-	  [
-	    id_keys,
-	    tysyn_keys,
-	    class_keys,
-	    class_op_keys
-	  ]
-
-    id_keys = map id_key id_keys_infos
-    id_key (str_mod, uniq, info) = (str_mod, (uniq, RnImplicit))
-
-    assoc_id_infos = catMaybes (map assoc_info id_keys_infos)
-    assoc_info (str_mod, uniq, Just info) = Just (uniq, info)
-    assoc_info (str_mod, uniq, Nothing)   = Nothing
+type BuiltinNames = Bag Name
+
+builtinNames :: BuiltinNames
+builtinNames
+  = 	-- Wired in TyCons
+    unionManyBags (map getTyConNames wired_in_tycons)	`unionBags`
+
+	-- Wired in Ids
+    listToBag (map getName wired_in_ids)		`unionBags`
+
+	-- PrimOps
+    listToBag (map (getName.primOpName) allThePrimOps)	`unionBags`
+
+	-- Other names with magic keys
+    listToBag builtinKeys
+\end{code}
+
+
+\begin{code}
+getTyConNames :: TyCon -> Bag Name
+getTyConNames tycon
+    =  getName tycon `consBag` listToBag (map getName (tyConDataCons tycon))
+	-- Synonyms return empty list of constructors
 \end{code}
 
 
@@ -115,8 +98,18 @@ We let a lot of "non-standard" values be visible, so that we can make
 sense of them in interface pragmas. It's cool, though they all have
 "non-standard" names, so they won't get past the parser in user code.
 
-The WiredIn TyCons and DataCons ...
+%************************************************************************
+%*									*
+\subsection{Wired in TyCons}
+%*									*
+%************************************************************************
+
+
 \begin{code}
+wired_in_tycons = [mkFunTyCon] ++
+		  prim_tycons ++
+		  tuple_tycons ++
+		  data_tycons
 
 prim_tycons
   = [ addrPrimTyCon
@@ -136,27 +129,12 @@ prim_tycons
     , wordPrimTyCon
     ]
 
-g_tycons
-  = mkFunTyCon : g_con_tycons
-
-g_con_tycons
-  = listTyCon : mkTupleTyCon 0 : [mkTupleTyCon i | i <- [2..37] ]
-
-min_nonprim_tycon_list 	-- used w/ HideMostBuiltinNames
-  = [ boolTyCon
-    , charTyCon
-    , intTyCon
-    , floatTyCon
-    , doubleTyCon
-    , integerTyCon
-    , liftTyCon
-    , return2GMPsTyCon	-- ADR asked for these last two (WDP 94/11)
-    , returnIntAndGMPTyCon
-    ]
+tuple_tycons = unitTyCon : [tupleTyCon i | i <- [2..37] ]
 
 
 data_tycons
-  = [ addrTyCon
+  = [ listTyCon
+    , addrTyCon
     , boolTyCon
     , charTyCon
     , doubleTyCon
@@ -188,20 +166,37 @@ data_tycons
     , voidTyCon
     , wordTyCon
     ]
+
+min_nonprim_tycon_list 	-- used w/ HideMostBuiltinNames
+  = [ boolTyCon
+    , charTyCon
+    , intTyCon
+    , floatTyCon
+    , doubleTyCon
+    , integerTyCon
+    , liftTyCon
+    , return2GMPsTyCon	-- ADR asked for these last two (WDP 94/11)
+    , returnIntAndGMPTyCon
+    ]
 \end{code}
 
+%************************************************************************
+%*									*
+\subsection{Wired in Ids}
+%*									*
+%************************************************************************
+
 The WiredIn Ids ...
 ToDo: Some of these should be moved to id_keys_infos!
+
 \begin{code}
 wired_in_ids
   = [ aBSENT_ERROR_ID
     , augmentId
     , buildId
---  , copyableId
     , eRROR_ID
     , foldlId
     , foldrId
---  , forkId
     , iRREFUT_PAT_ERROR_ID
     , integerMinusOneId
     , integerPlusOneId
@@ -210,145 +205,288 @@ wired_in_ids
     , nON_EXHAUSTIVE_GUARDS_ERROR_ID
     , nO_DEFAULT_METHOD_ERROR_ID
     , nO_EXPLICIT_METHOD_ERROR_ID
---  , noFollowId
     , pAR_ERROR_ID
     , pAT_ERROR_ID
     , packStringForCId
---    , parAtAbsId
---    , parAtForNowId
---    , parAtId
---    , parAtRelId
---    , parGlobalId
---    , parId
---    , parLocalId
     , rEC_CON_ERROR_ID
     , rEC_UPD_ERROR_ID
     , realWorldPrimId
     , runSTId
---    , seqId
     , tRACE_ID
     , unpackCString2Id
     , unpackCStringAppendId
     , unpackCStringFoldrId
     , unpackCStringId
     , voidId
+
+--  , copyableId
+--  , forkId
+--  , noFollowId
+--    , parAtAbsId
+--    , parAtForNowId
+--    , parAtId
+--    , parAtRelId
+--    , parGlobalId
+--    , parId
+--    , parLocalId
+--    , seqId
     ]
+\end{code}
 
-pcTyConWiredInInfo :: TyCon -> (OrigName, RnName)
-pcTyConWiredInInfo tc = (origName "pcTyConWiredInInfo" tc, WiredInTyCon tc)
 
-pcDataConWiredInInfo :: TyCon -> [(OrigName, RnName)]
-pcDataConWiredInInfo tycon
-  = [ (origName "pcDataConWiredInInfo" con, WiredInId con) | con <- tyConDataCons tycon ]
+%************************************************************************
+%*									*
+\subsection{Built-in keys}
+%*									*
+%************************************************************************
 
-pcIdWiredInInfo :: Id -> (OrigName, RnName)
-pcIdWiredInInfo id = (origName "pcIdWiredInInfo" id, WiredInId id)
-\end{code}
+Ids, Synonyms, Classes and ClassOps with builtin keys. 
 
-WiredIn primitive numeric operations ...
 \begin{code}
-primop_ids
-  = map prim_fn allThePrimOps ++ map funny_fn funny_name_primops
-  where
-    prim_fn  op     = case (primOpNameInfo op) of (s,n) -> ((OrigName gHC_BUILTINS s),n)
-    funny_fn (op,s) = case (primOpNameInfo op) of (_,n) -> ((OrigName gHC_BUILTINS s),n)
-
-funny_name_primops
-  = [ (IntAddOp,      SLIT("+#"))
-    , (IntSubOp,      SLIT("-#"))
-    , (IntMulOp,      SLIT("*#"))
-    , (IntGtOp,       SLIT(">#"))
-    , (IntGeOp,       SLIT(">=#"))
-    , (IntEqOp,       SLIT("==#"))
-    , (IntNeOp,       SLIT("/=#"))
-    , (IntLtOp,       SLIT("<#"))
-    , (IntLeOp,       SLIT("<=#"))
-    , (DoubleAddOp,   SLIT("+##"))
-    , (DoubleSubOp,   SLIT("-##"))
-    , (DoubleMulOp,   SLIT("*##"))
-    , (DoubleDivOp,   SLIT("/##"))
-    , (DoublePowerOp, SLIT("**##"))
-    , (DoubleGtOp,    SLIT(">##"))
-    , (DoubleGeOp,    SLIT(">=##"))
-    , (DoubleEqOp,    SLIT("==##"))
-    , (DoubleNeOp,    SLIT("/=##"))
-    , (DoubleLtOp,    SLIT("<##"))
-    , (DoubleLeOp,    SLIT("<=##"))
+getKeyOrig :: (Module, OccName, Unique) -> Name
+getKeyOrig (mod, occ, uniq) = mkGlobalName uniq mod occ VanillaDefn Implicit
+
+builtinKeys :: [Name]
+builtinKeys
+  = map getKeyOrig
+    [
+	-- Type constructors (synonyms especially)
+      (iO_BASE,		TCOcc SLIT("IO"),       iOTyConKey)
+    , (pREL_BASE,	TCOcc SLIT("Ordering"), orderingTyConKey)
+    , (pREL_NUM,	TCOcc SLIT("Rational"), rationalTyConKey)
+    , (pREL_NUM,	TCOcc SLIT("Ratio"),    ratioTyConKey)
+
+
+	--  Classes.  *Must* include:
+	--  	classes that are grabbed by key (e.g., eqClassKey)
+	--  	classes in "Class.standardClassKeys" (quite a few)
+    , (pREL_BASE, TCOcc SLIT("Eq"),		eqClassKey)		-- mentioned, derivable
+    , (pREL_BASE, TCOcc SLIT("Eval"),		evalClassKey)		-- mentioned
+    , (pREL_BASE, TCOcc SLIT("Ord"),		ordClassKey)		-- derivable
+    , (pREL_BASE, TCOcc SLIT("Bounded"),	boundedClassKey)	-- derivable
+    , (pREL_BASE, TCOcc SLIT("Num"),		numClassKey)		-- mentioned, numeric
+    , (pREL_BASE, TCOcc SLIT("Enum"),		enumClassKey)		-- derivable
+    , (pREL_BASE, TCOcc SLIT("Monad"),		monadClassKey)
+    , (pREL_BASE, TCOcc SLIT("MonadZero"),		monadZeroClassKey)
+    , (pREL_BASE, TCOcc SLIT("MonadPlus"),		monadPlusClassKey)
+    , (pREL_BASE, TCOcc SLIT("Functor"),		functorClassKey)
+    , (pREL_BASE, TCOcc SLIT("Show"),		showClassKey)		-- derivable
+    , (pREL_NUM, TCOcc SLIT("Real"),		realClassKey)		-- numeric
+    , (pREL_NUM, TCOcc SLIT("Integral"),	integralClassKey)	-- numeric
+    , (pREL_NUM, TCOcc SLIT("Fractional"),	fractionalClassKey)	-- numeric
+    , (pREL_NUM, TCOcc SLIT("Floating"),	floatingClassKey)	-- numeric
+    , (pREL_NUM, TCOcc SLIT("RealFrac"),	realFracClassKey)	-- numeric
+    , (pREL_NUM, TCOcc SLIT("RealFloat"),	realFloatClassKey)	-- numeric
+    , (pREL_READ, TCOcc SLIT("Read"),		readClassKey)		-- derivable
+    , (iX,	TCOcc SLIT("Ix"),		ixClassKey)		-- derivable (but it isn't Prelude.Ix; hmmm)
+    , (fOREIGN,	TCOcc SLIT("CCallable"),	cCallableClassKey)	-- mentioned, ccallish
+    , (fOREIGN,   TCOcc SLIT("CReturnable"), 	cReturnableClassKey)	-- mentioned, ccallish
+
+
+	-- ClassOps 
+    , (pREL_BASE, VarOcc SLIT("fromInt"),	fromIntClassOpKey)
+    , (pREL_BASE, VarOcc SLIT("fromInteger"),	fromIntegerClassOpKey)
+    , (pREL_BASE, VarOcc SLIT("enumFrom"),	enumFromClassOpKey)
+    , (pREL_BASE, VarOcc SLIT("enumFromThen"),	enumFromThenClassOpKey)
+    , (pREL_BASE, VarOcc SLIT("enumFromTo"),	enumFromToClassOpKey)
+    , (pREL_BASE, VarOcc SLIT("enumFromThenTo"), enumFromThenToClassOpKey)
+    , (pREL_BASE, VarOcc SLIT("fromEnum"),	fromEnumClassOpKey)
+    , (pREL_BASE, VarOcc SLIT("=="),		eqClassOpKey)
+    , (pREL_BASE, VarOcc SLIT(">>="),		thenMClassOpKey)
+    , (pREL_BASE, VarOcc SLIT("zero"),		zeroClassOpKey)
+    , (pREL_NUM, VarOcc SLIT("fromRational"),	fromRationalClassOpKey)
     ]
 \end{code}
 
+ToDo: make it do the ``like'' part properly (as in 0.26 and before).
 
-Ids, Synonyms, Classes and ClassOps with builtin keys.
-For the Ids we may also have some builtin IdInfo.
 \begin{code}
-id_keys_infos :: [(OrigName, Unique, Maybe IdInfo)]
-id_keys_infos
-  = [ -- here because we use them in derived instances
-      (OrigName pRELUDE SLIT("&&"),		andandIdKey,	Nothing)
-    , (OrigName pRELUDE SLIT("."),		composeIdKey,	Nothing)
-    , (OrigName gHC__   SLIT("lex"),		lexIdKey,	Nothing)
-    , (OrigName pRELUDE SLIT("not"),		notIdKey,	Nothing)
-    , (OrigName pRELUDE SLIT("readParen"),	readParenIdKey,	Nothing)
-    , (OrigName pRELUDE SLIT("showParen"),	showParenIdKey,	Nothing)
-    , (OrigName pRELUDE SLIT("showString"),	showStringIdKey,Nothing)
-    , (OrigName gHC__   SLIT("readList__"),	ureadListIdKey,	Nothing)
-    , (OrigName gHC__   SLIT("showList__"),	ushowListIdKey,	Nothing)
-    , (OrigName gHC__   SLIT("showSpace"),	showSpaceIdKey,	Nothing)
-    ]
+maybeCharLikeTyCon tc = if (uniqueOf tc == charDataConKey) then Just charDataCon else Nothing
+maybeIntLikeTyCon  tc = if (uniqueOf tc == intDataConKey)  then Just intDataCon  else Nothing
+\end{code}
 
-tysyn_keys
-  = [ (OrigName gHC__   SLIT("IO"),       (iOTyConKey, RnImplicitTyCon))
-    , (OrigName pRELUDE SLIT("Ordering"), (orderingTyConKey, RnImplicitTyCon))
-    , (OrigName rATIO   SLIT("Rational"), (rationalTyConKey, RnImplicitTyCon))
-    , (OrigName rATIO   SLIT("Ratio"),    (ratioTyConKey, RnImplicitTyCon))
-    ]
+%************************************************************************
+%*									*
+\subsection{Commonly-used RdrNames}
+%*									*
+%************************************************************************
 
--- this "class_keys" list *must* include:
---  classes that are grabbed by key (e.g., eqClassKey)
---  classes in "Class.standardClassKeys" (quite a few)
-
-class_keys
-  = [ (str_mod, (k, RnImplicitClass)) | (str_mod,k) <-
-    [ (OrigName pRELUDE SLIT("Eq"),		eqClassKey)		-- mentioned, derivable
-    , (OrigName pRELUDE SLIT("Eval"),		evalClassKey)		-- mentioned
-    , (OrigName pRELUDE SLIT("Ord"),		ordClassKey)		-- derivable
-    , (OrigName pRELUDE SLIT("Num"),		numClassKey)		-- mentioned, numeric
-    , (OrigName pRELUDE SLIT("Real"),		realClassKey)		-- numeric
-    , (OrigName pRELUDE SLIT("Integral"),	integralClassKey)	-- numeric
-    , (OrigName pRELUDE SLIT("Fractional"),	fractionalClassKey)	-- numeric
-    , (OrigName pRELUDE SLIT("Floating"),	floatingClassKey)	-- numeric
-    , (OrigName pRELUDE SLIT("RealFrac"),	realFracClassKey)	-- numeric
-    , (OrigName pRELUDE SLIT("RealFloat"),	realFloatClassKey)	-- numeric
-    , (OrigName iX	SLIT("Ix"),		ixClassKey)		-- derivable (but it isn't Prelude.Ix; hmmm)
-    , (OrigName pRELUDE SLIT("Bounded"),	boundedClassKey)	-- derivable
-    , (OrigName pRELUDE SLIT("Enum"),		enumClassKey)		-- derivable
-    , (OrigName pRELUDE SLIT("Show"),		showClassKey)		-- derivable
-    , (OrigName pRELUDE SLIT("Read"),		readClassKey)		-- derivable
-    , (OrigName pRELUDE SLIT("Monad"),		monadClassKey)
-    , (OrigName pRELUDE SLIT("MonadZero"),	monadZeroClassKey)
-    , (OrigName pRELUDE SLIT("MonadPlus"),	monadPlusClassKey)
-    , (OrigName pRELUDE SLIT("Functor"),	functorClassKey)
-    , (OrigName gHC__	SLIT("CCallable"),	cCallableClassKey)	-- mentioned, ccallish
-    , (OrigName gHC__   SLIT("CReturnable"), 	cReturnableClassKey)	-- mentioned, ccallish
-    ]]
-
-class_op_keys
-  = [ (str_mod, (k, RnImplicit)) | (str_mod,k) <-
-    [ (OrigName pRELUDE SLIT("fromInt"),	fromIntClassOpKey)
-    , (OrigName pRELUDE SLIT("fromInteger"),	fromIntegerClassOpKey)
-    , (OrigName pRELUDE SLIT("fromRational"),	fromRationalClassOpKey)
-    , (OrigName pRELUDE SLIT("enumFrom"),	enumFromClassOpKey)
-    , (OrigName pRELUDE SLIT("enumFromThen"),	enumFromThenClassOpKey)
-    , (OrigName pRELUDE SLIT("enumFromTo"),	enumFromToClassOpKey)
-    , (OrigName pRELUDE SLIT("enumFromThenTo"),enumFromThenToClassOpKey)
-    , (OrigName pRELUDE SLIT("=="),		eqClassOpKey)
-    , (OrigName pRELUDE SLIT(">>="),		thenMClassOpKey)
-    , (OrigName pRELUDE SLIT("zero"),		zeroClassOpKey)
-    ]]
+These RdrNames are not really "built in", but some parts of the compiler
+(notably the deriving mechanism) need to mention their names, and it's convenient
+to write them all down in one place.
+
+\begin{code}
+prelude_primop op = qual (modAndOcc (primOpName op))
+
+eqClass_RDR		= tcQual (pREL_BASE, SLIT("Eq"))
+ordClass_RDR		= tcQual (pREL_BASE, SLIT("Ord"))
+evalClass_RDR 		= tcQual (pREL_BASE, SLIT("Eval"))
+monadZeroClass_RDR	= tcQual (pREL_BASE, SLIT("MonadZero"))
+enumClass_RDR 		= tcQual (pREL_BASE, SLIT("Enum"))
+numClass_RDR		= tcQual (pREL_BASE, SLIT("Num"))
+fractionalClass_RDR	= tcQual (pREL_NUM,  SLIT("Fractional"))
+ccallableClass_RDR	= tcQual (fOREIGN,   SLIT("CCallable"))
+creturnableClass_RDR	= tcQual (fOREIGN,   SLIT("CReturnable"))
+
+negate_RDR	   = varQual (pREL_BASE, SLIT("negate"))
+eq_RDR		   = varQual (pREL_BASE, SLIT("=="))
+ne_RDR		   = varQual (pREL_BASE, SLIT("/="))
+le_RDR		   = varQual (pREL_BASE, SLIT("<="))
+lt_RDR		   = varQual (pREL_BASE, SLIT("<"))
+ge_RDR		   = varQual (pREL_BASE, SLIT(">="))
+gt_RDR		   = varQual (pREL_BASE, SLIT(">"))
+ltTag_RDR	   = varQual (pREL_BASE,  SLIT("LT"))
+eqTag_RDR	   = varQual (pREL_BASE,  SLIT("EQ"))
+gtTag_RDR	   = varQual (pREL_BASE,  SLIT("GT"))
+max_RDR		   = varQual (pREL_BASE, SLIT("max"))
+min_RDR		   = varQual (pREL_BASE, SLIT("min"))
+compare_RDR	   = varQual (pREL_BASE, SLIT("compare"))
+minBound_RDR	   = varQual (pREL_BASE, SLIT("minBound"))
+maxBound_RDR	   = varQual (pREL_BASE, SLIT("maxBound"))
+false_RDR	   = varQual (pREL_BASE,  SLIT("False"))
+true_RDR	   = varQual (pREL_BASE,  SLIT("True"))
+and_RDR		   = varQual (pREL_BASE,  SLIT("&&"))
+not_RDR		   = varQual (pREL_BASE,  SLIT("not"))
+compose_RDR	   = varQual (pREL_BASE, SLIT("."))
+append_RDR	   = varQual (pREL_BASE, SLIT("++"))
+map_RDR		   = varQual (pREL_BASE, SLIT("map"))
+
+showList___RDR     = varQual (pREL_BASE,  SLIT("showList__"))
+showsPrec_RDR	   = varQual (pREL_BASE, SLIT("showsPrec"))
+showList_RDR	   = varQual (pREL_BASE, SLIT("showList"))
+showSpace_RDR	   = varQual (pREL_BASE,  SLIT("showSpace"))
+showString_RDR	   = varQual (pREL_BASE, SLIT("showString"))
+showParen_RDR	   = varQual (pREL_BASE, SLIT("showParen"))
+
+range_RDR	   = varQual (iX,   SLIT("range"))
+index_RDR	   = varQual (iX,   SLIT("index"))
+inRange_RDR	   = varQual (iX,   SLIT("inRange"))
+
+readsPrec_RDR	   = varQual (pREL_READ, SLIT("readsPrec"))
+readList_RDR	   = varQual (pREL_READ, SLIT("readList"))
+readParen_RDR	   = varQual (pREL_READ, SLIT("readParen"))
+lex_RDR		   = varQual (pREL_READ,  SLIT("lex"))
+readList___RDR     = varQual (pREL_READ,  SLIT("readList__"))
+
+fromEnum_RDR	   = varQual (pREL_BASE, SLIT("fromEnum"))
+enumFrom_RDR	   = varQual (pREL_BASE, SLIT("enumFrom"))
+enumFromTo_RDR	   = varQual (pREL_BASE, SLIT("enumFromTo"))
+enumFromThen_RDR   = varQual (pREL_BASE, SLIT("enumFromThen"))
+enumFromThenTo_RDR = varQual (pREL_BASE, SLIT("enumFromThenTo"))
+plus_RDR	   = varQual (pREL_BASE, SLIT("+"))
+times_RDR	   = varQual (pREL_BASE, SLIT("*"))
+mkInt_RDR	   = varQual (pREL_BASE, SLIT("I#"))
+
+error_RDR	   = varQual (iO_BASE, SLIT("error"))
+
+eqH_Char_RDR	= prelude_primop CharEqOp
+ltH_Char_RDR	= prelude_primop CharLtOp
+eqH_Word_RDR	= prelude_primop WordEqOp
+ltH_Word_RDR	= prelude_primop WordLtOp
+eqH_Addr_RDR	= prelude_primop AddrEqOp
+ltH_Addr_RDR	= prelude_primop AddrLtOp
+eqH_Float_RDR	= prelude_primop FloatEqOp
+ltH_Float_RDR	= prelude_primop FloatLtOp
+eqH_Double_RDR	= prelude_primop DoubleEqOp
+ltH_Double_RDR	= prelude_primop DoubleLtOp
+eqH_Int_RDR	= prelude_primop IntEqOp
+ltH_Int_RDR	= prelude_primop IntLtOp
+geH_RDR		= prelude_primop IntGeOp
+leH_RDR		= prelude_primop IntLeOp
+minusH_RDR	= prelude_primop IntSubOp
+
+intType_RDR = qual (modAndOcc intTyCon)
 \end{code}
 
-ToDo: make it do the ``like'' part properly (as in 0.26 and before).
+%************************************************************************
+%*									*
+\subsection[Class-std-groups]{Standard groups of Prelude classes}
+%*									*
+%************************************************************************
+
+@derivableClassKeys@ is also used in checking \tr{deriving} constructs
+(@TcDeriv@).
+
+@derivingOccurrences@ maps a class name to a list of the (qualified) occurrences
+that will be mentioned by  the derived code for the class when it is later generated.
+We don't need to put in things that are WiredIn (because they are already mapped to their
+correct name by the @NameSupply@.  The class itself, and all its class ops, is
+already flagged as an occurrence so we don't need to mention that either.
+
+@derivingOccurrences@ has an item for every derivable class, even if that item is empty,
+because we treat lookup failure as indicating that the class is illegal in a deriving clause.
+
 \begin{code}
-maybeCharLikeTyCon tc = if (uniqueOf tc == charDataConKey) then Just charDataCon else Nothing
-maybeIntLikeTyCon  tc = if (uniqueOf tc == intDataConKey)  then Just intDataCon  else Nothing
+derivingOccurrences :: UniqFM [RdrName]
+derivingOccurrences = listToUFM deriving_occ_info
+
+derivableClassKeys  = map fst deriving_occ_info
+
+deriving_occ_info
+  = [ (eqClassKey, 	[intType_RDR, and_RDR, not_RDR])
+    , (ordClassKey, 	[intType_RDR, compose_RDR])
+    , (enumClassKey, 	[intType_RDR, map_RDR])
+    , (evalClassKey,	[intType_RDR])
+    , (boundedClassKey,	[intType_RDR])
+    , (showClassKey,	[intType_RDR, numClass_RDR, ordClass_RDR, compose_RDR, showString_RDR, 
+			 showParen_RDR, showSpace_RDR, showList___RDR])
+    , (readClassKey,	[intType_RDR, numClass_RDR, ordClass_RDR, append_RDR, 
+			 lex_RDR, readParen_RDR, readList___RDR])
+    , (ixClassKey,	[intType_RDR, numClass_RDR, and_RDR, map_RDR])
+    ]
+	-- intType: Practically any deriving needs Int, either for index calculations, 
+	--		or for taggery.
+	-- ordClass: really it's the methods that are actually used.
+	-- numClass: for Int literals
+\end{code}
+
+
+NOTE: @Eq@ and @Text@ do need to appear in @standardClasses@
+even though every numeric class has these two as a superclass,
+because the list of ambiguous dictionaries hasn't been simplified.
+
+\begin{code}
+isCcallishClass, isNoDictClass, isNumericClass, isStandardClass :: Class -> Bool
+
+isNumericClass   clas = classKey clas `is_elem` numericClassKeys
+isStandardClass  clas = classKey clas `is_elem` standardClassKeys
+isCcallishClass	 clas = classKey clas `is_elem` cCallishClassKeys
+isNoDictClass    clas = classKey clas `is_elem` noDictClassKeys
+is_elem = isIn "is_X_Class"
+
+numericClassKeys
+  = [ numClassKey
+    , realClassKey
+    , integralClassKey
+    , fractionalClassKey
+    , floatingClassKey
+    , realFracClassKey
+    , realFloatClassKey
+    ]
+
+needsDataDeclCtxtClassKeys -- see comments in TcDeriv
+  = [ readClassKey
+    ]
+
+cCallishClassKeys = [ cCallableClassKey, cReturnableClassKey ]
+
+standardClassKeys
+  = derivableClassKeys ++ numericClassKeys ++ cCallishClassKeys
+    --
+    -- We have to have "CCallable" and "CReturnable" in the standard
+    -- classes, so that if you go...
+    --
+    --	    _ccall_ foo ... 93{-numeric literal-} ...
+    --
+    -- ... it can do The Right Thing on the 93.
+
+noDictClassKeys 	-- These classes are used only for type annotations;
+			-- they are not implemented by dictionaries, ever.
+  = cCallishClassKeys
+	-- I used to think that class Eval belonged in here, but
+	-- we really want functions with type (Eval a => ...) and that
+	-- means that we really want to pass a placeholder for an Eval
+	-- dictionary.  The unit tuple is what we'll get if we leave things
+	-- alone, and that'll do for now.  Could arrange to drop that parameter
+	-- in the end.
 \end{code}
diff --git a/ghc/compiler/prelude/PrelLoop.lhi b/ghc/compiler/prelude/PrelLoop.lhi
index acf9a4eae5..ba1320a13e 100644
--- a/ghc/compiler/prelude/PrelLoop.lhi
+++ b/ghc/compiler/prelude/PrelLoop.lhi
@@ -7,8 +7,8 @@ import PreludePS	( _PackedString )
 
 import Class		( GenClass )
 import CoreUnfold	( mkMagicUnfolding, Unfolding )
-import IdUtils		( primOpNameInfo )
-import Name		( Name, OrigName, mkPrimitiveName, mkWiredInName, ExportFlag )
+import IdUtils		( primOpName )
+import Name		( Name, ExportFlag )
 import PrimOp		( PrimOp )
 import RnHsSyn		( RnName )
 import Type		( mkSigmaTy, mkFunTy, mkFunTys, GenType )
@@ -17,11 +17,9 @@ import Unique		( Unique )
 import Usage		( GenUsage )
 
 mkMagicUnfolding :: Unique -> Unfolding
-mkPrimitiveName :: Unique -> OrigName -> Name
-mkWiredInName :: Unique -> OrigName -> ExportFlag -> Name
 mkSigmaTy :: [a] -> [(GenClass (GenTyVar (GenUsage Unique)) Unique, GenType a b)] -> GenType a b -> GenType a b
 mkFunTys :: [GenType a b] -> GenType a b -> GenType a b
 mkFunTy  :: GenType a b   -> GenType a b -> GenType a b
 
-primOpNameInfo	:: PrimOp -> (_PackedString, RnName)
+primOpName :: PrimOp -> Name
 \end{code}
diff --git a/ghc/compiler/prelude/PrelMods.lhs b/ghc/compiler/prelude/PrelMods.lhs
index 1d73db7908..8d9a5ad6e6 100644
--- a/ghc/compiler/prelude/PrelMods.lhs
+++ b/ghc/compiler/prelude/PrelMods.lhs
@@ -8,24 +8,32 @@ defined here so as to avod
 \begin{code}
 #include "HsVersions.h"
 
-module PrelMods (
-	gHC_BUILTINS, -- things that are really and truly primitive
-	pRELUDE, gHC__,
-	rATIO, iX,
-	modulesWithBuiltins
-  ) where
+module PrelMods where
 
 CHK_Ubiq() -- debugging consistency check
 \end{code}
 
 
 \begin{code}
+gHC__	     = SLIT("GHC")	   -- Primitive types and values
+
 pRELUDE	     = SLIT("Prelude")
-gHC_BUILTINS = SLIT("GHCbuiltins") -- the truly-primitive things
-gHC__	     = SLIT("GHCbase")	   -- all GHC basics, add-ons, extras, everything
-				   -- (which can be defined in Haskell)
+pREL_BASE    = SLIT("PrelBase")
+pREL_READ    = SLIT("PrelRead")
+pREL_NUM     = SLIT("PrelNum")
+pREL_LIST    = SLIT("PrelList")
+pREL_TUP     = SLIT("PrelTup")
+pACKED_STRING= SLIT("PackedString")
+cONC_BASE    = SLIT("ConcBase")
+iO_BASE	     = SLIT("IOBase")
+mONAD	     = SLIT("Monad")
 rATIO	     = SLIT("Ratio")
 iX	     = SLIT("Ix")
+sT_BASE	     = SLIT("STBase")
+aRR_BASE     = SLIT("ArrBase")
+fOREIGN	     = SLIT("Foreign")
 
-modulesWithBuiltins = [ gHC_BUILTINS, gHC__, pRELUDE, rATIO, iX ]
+mAIN	     = SLIT("Main")
+gHC_MAIN     = SLIT("GHCmain")
+gHC_ERR	     = SLIT("GHCerr")
 \end{code}
diff --git a/ghc/compiler/prelude/PrelVals.lhs b/ghc/compiler/prelude/PrelVals.lhs
index 84fd4d915a..c743362c54 100644
--- a/ghc/compiler/prelude/PrelVals.lhs
+++ b/ghc/compiler/prelude/PrelVals.lhs
@@ -10,7 +10,7 @@ module PrelVals where
 
 IMP_Ubiq()
 IMPORT_DELOOPER(IdLoop)		( UnfoldingGuidance(..), nullSpecEnv, SpecEnv )
-import Id		( SYN_IE(Id), GenId, mkImported, mkUserId, mkTemplateLocals )
+import Id		( SYN_IE(Id), GenId, mkImported, mkTemplateLocals )
 IMPORT_DELOOPER(PrelLoop)
 
 -- friends:
@@ -23,7 +23,7 @@ import CmdLineOpts	( maybe_CompilingGhcInternals )
 import CoreSyn		-- quite a bit
 import IdInfo		-- quite a bit
 import Literal		( mkMachInt )
-import Name		( ExportFlag(..) )
+import Name		( mkWiredInIdName )
 import PragmaInfo
 import PrimOp		( PrimOp(..) )
 import Type		( mkTyVarTy )
@@ -34,11 +34,11 @@ import Util		( panic )
 
 \begin{code}
 -- only used herein:
-pcMiscPrelId :: Unique{-IdKey-} -> FAST_STRING -> FAST_STRING -> Type -> IdInfo -> Id
+pcMiscPrelId :: Unique{-IdKey-} -> Module -> FAST_STRING -> Type -> IdInfo -> Id
 
-pcMiscPrelId key m n ty info
+pcMiscPrelId key mod occ ty info
   = let
-	name = mkWiredInName key (OrigName m n) ExportAll
+	name = mkWiredInIdName key mod occ imp
 	imp  = mkImported name ty info -- the usual case...
     in
     imp
@@ -73,14 +73,14 @@ templates, but we don't ever expect to generate code for it.
 pc_bottoming_Id key mod name ty
  = pcMiscPrelId key mod name ty bottoming_info
  where
-    bottoming_info = noIdInfo `addInfo` mkBottomStrictnessInfo
+    bottoming_info = noIdInfo `addStrictnessInfo` mkBottomStrictnessInfo
 	-- these "bottom" out, no matter what their arguments
 
 eRROR_ID
-  = pc_bottoming_Id errorIdKey pRELUDE SLIT("error") errorTy
+  = pc_bottoming_Id errorIdKey iO_BASE SLIT("error") errorTy
 
 generic_ERROR_ID u n
-  = pc_bottoming_Id u SLIT("GHCerr") n errorTy
+  = pc_bottoming_Id u gHC_ERR n errorTy
 
 pAT_ERROR_ID
   = generic_ERROR_ID patErrorIdKey SLIT("patError")
@@ -98,11 +98,11 @@ nO_EXPLICIT_METHOD_ERROR_ID
   = generic_ERROR_ID nonExplicitMethodErrorIdKey SLIT("noExplicitMethodError")
 
 aBSENT_ERROR_ID
-  = pc_bottoming_Id absentErrorIdKey SLIT("GHCerr") SLIT("absentErr")
+  = pc_bottoming_Id absentErrorIdKey gHC_ERR SLIT("absentErr")
 	(mkSigmaTy [openAlphaTyVar] [] openAlphaTy)
 
 pAR_ERROR_ID
-  = pcMiscPrelId parErrorIdKey SLIT("GHCerr") SLIT("parError")
+  = pcMiscPrelId parErrorIdKey gHC_ERR SLIT("parError")
     (mkSigmaTy [openAlphaTyVar] [] openAlphaTy) noIdInfo
 
 openAlphaTy = mkTyVarTy openAlphaTyVar
@@ -120,8 +120,8 @@ decide that the second argument is strict, evaluate that first (!!),
 and make a jolly old mess.
 \begin{code}
 tRACE_ID
-  = pcMiscPrelId traceIdKey gHC__ SLIT("trace") traceTy
-	(noIdInfo `addInfo` pcGenerateSpecs traceIdKey tRACE_ID noIdInfo traceTy)
+  = pcMiscPrelId traceIdKey iO_BASE SLIT("trace") traceTy
+	(noIdInfo `addSpecInfo` pcGenerateSpecs traceIdKey tRACE_ID noIdInfo traceTy)
   where
     traceTy = mkSigmaTy [alphaTyVar] [] (mkFunTys [mkListTy charTy, alphaTy] alphaTy)
 \end{code}
@@ -134,54 +134,55 @@ tRACE_ID
 
 \begin{code}
 packStringForCId
-  = pcMiscPrelId packCStringIdKey{-ToDo:rename-} gHC__ SLIT("packStringForC__")
+  = pcMiscPrelId packCStringIdKey{-ToDo:rename-} pACKED_STRING SLIT("packCString#")
 	(mkFunTys [stringTy] byteArrayPrimTy) noIdInfo
 
 --------------------------------------------------------------------
 
 unpackCStringId
-  = pcMiscPrelId unpackCStringIdKey gHC__ SLIT("unpackPS__")
+  = pcMiscPrelId unpackCStringIdKey pACKED_STRING SLIT("unpackCString#")
 		 (mkFunTys [addrPrimTy{-a char *-}] stringTy) noIdInfo
 -- Andy says:
---	(FunTy addrPrimTy{-a char *-} stringTy) (noIdInfo `addInfo` mkArityInfo 1)
+--	(FunTy addrPrimTy{-a char *-} stringTy) (noIdInfo `addInfo` exactArity 1)
 -- but I don't like wired-in IdInfos (WDP)
 
 unpackCString2Id -- for cases when a string has a NUL in it
-  = pcMiscPrelId unpackCString2IdKey gHC__ SLIT("unpackPS2__")
+  = pcMiscPrelId unpackCString2IdKey pACKED_STRING SLIT("unpackCString2#")
 		 (mkFunTys [addrPrimTy{-a char *-}, intPrimTy{-length-}] stringTy)
 		 noIdInfo
 
 --------------------------------------------------------------------
 unpackCStringAppendId
-  = pcMiscPrelId unpackCStringAppendIdKey gHC__ SLIT("unpackAppendPS__")
+  = pcMiscPrelId unpackCStringAppendIdKey pACKED_STRING SLIT("unpackAppendCString#")
 		(mkFunTys [addrPrimTy{-a "char *" pointer-},stringTy] stringTy)
 		((noIdInfo
-		 {-LATER:`addInfo_UF` mkMagicUnfolding unpackCStringAppendIdKey-})
-		 `addInfo` mkArityInfo 2)
+		 {-LATER:`addUnfoldInfo` mkMagicUnfolding unpackCStringAppendIdKey-})
+		 `addArityInfo` exactArity 2)
 
 unpackCStringFoldrId
-  = pcMiscPrelId unpackCStringFoldrIdKey gHC__ SLIT("unpackFoldrPS__")
+  = pcMiscPrelId unpackCStringFoldrIdKey pACKED_STRING SLIT("unpackFoldrCString#")
 		(mkSigmaTy [alphaTyVar] []
 		(mkFunTys [addrPrimTy{-a "char *" pointer-},
 			   mkFunTys [charTy, alphaTy] alphaTy,
 			   alphaTy]
 			  alphaTy))
 		((noIdInfo
-		 {-LATER:`addInfo_UF` mkMagicUnfolding unpackCStringFoldrIdKey-})
-		 `addInfo` mkArityInfo 3)
+		 {-LATER:`addUnfoldInfo` mkMagicUnfolding unpackCStringFoldrIdKey-})
+		 `addArityInfo` exactArity 3)
 \end{code}
 
 OK, this is Will's idea: we should have magic values for Integers 0,
 +1, +2, and -1 (go ahead, fire me):
+
 \begin{code}
 integerZeroId
-  = pcMiscPrelId integerZeroIdKey     gHC__ SLIT("integer_0")  integerTy noIdInfo
+  = pcMiscPrelId integerZeroIdKey     pREL_NUM SLIT("integer_0")  integerTy noIdInfo
 integerPlusOneId
-  = pcMiscPrelId integerPlusOneIdKey  gHC__ SLIT("integer_1")  integerTy noIdInfo
+  = pcMiscPrelId integerPlusOneIdKey  pREL_NUM SLIT("integer_1")  integerTy noIdInfo
 integerPlusTwoId
-  = pcMiscPrelId integerPlusTwoIdKey  gHC__ SLIT("integer_2")  integerTy noIdInfo
+  = pcMiscPrelId integerPlusTwoIdKey  pREL_NUM SLIT("integer_2")  integerTy noIdInfo
 integerMinusOneId
-  = pcMiscPrelId integerMinusOneIdKey gHC__ SLIT("integer_m1") integerTy noIdInfo
+  = pcMiscPrelId integerMinusOneIdKey pREL_NUM SLIT("integer_m1") integerTy noIdInfo
 \end{code}
 
 %************************************************************************
@@ -207,10 +208,10 @@ integerMinusOneId
 
 -}
 
-seqId = pcMiscPrelId seqIdKey gHC__ SLIT("seq")
+seqId = pcMiscPrelId seqIdKey pRELUDE SLIT("seq")
 		  (mkSigmaTy [alphaTyVar, betaTyVar] []
 		    (mkFunTys [alphaTy, betaTy] betaTy))
-		  (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding seq_template))
+		  (noIdInfo `addUnfoldInfo` (mkUnfolding True seq_template))
   where
     [x, y, z]
       = mkTemplateLocals [
@@ -242,10 +243,10 @@ seqId = pcMiscPrelId seqIdKey gHC__ SLIT("seq")
     par = /\ a b -> \ x::a y::b -> case par# x of { 0# -> parError#; _ -> y; }
 
 -}
-parId = pcMiscPrelId parIdKey gHC__ SLIT("par")
+parId = pcMiscPrelId parIdKey cONC_BASE SLIT("par")
 		  (mkSigmaTy [alphaTyVar, betaTyVar] []
 		    (mkFunTys [alphaTy, betaTy] betaTy))
-		  (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding par_template))
+		  (noIdInfo `addUnfoldInfo` (mkUnfolding True par_template))
   where
     [x, y, z]
       = mkTemplateLocals [
@@ -265,10 +266,10 @@ parId = pcMiscPrelId parIdKey gHC__ SLIT("par")
 {-
    _fork_ = /\ a b -> \ x::a y::b -> case fork# x of { 0# -> parError#; _ -> y; }
 -}
-forkId = pcMiscPrelId forkIdKey gHC__ SLIT("fork")
+forkId = pcMiscPrelId forkIdKey cONC_BASE SLIT("fork")
 		  (mkSigmaTy [alphaTyVar, betaTyVar] []
 		    (mkFunTys [alphaTy, betaTy] betaTy))
-		  (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding fork_template))
+		  (noIdInfo `addUnfoldInfo` (mkUnfolding True fork_template))
   where
     [x, y, z]
       = mkTemplateLocals [
@@ -289,10 +290,10 @@ forkId = pcMiscPrelId forkIdKey gHC__ SLIT("fork")
 GranSim ones:
 \begin{code}
 {- OUT:
-parLocalId = pcMiscPrelId parLocalIdKey gHC__ SLIT("parLocal")
+parLocalId = pcMiscPrelId parLocalIdKey cONC_BASE SLIT("parLocal")
 		  (mkSigmaTy [alphaTyVar, betaTyVar] []
 		    (mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy, alphaTy, betaTy] betaTy))
-		  (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parLocal_template))
+		  (noIdInfo `addUnfoldInfo` (mkUnfolding True parLocal_template))
   where
     -- Annotations: w: name, g: gran. info, s: size info, p: par info  -- HWL
     [w, g, s, p, x, y, z]
@@ -313,10 +314,10 @@ parLocalId = pcMiscPrelId parLocalIdKey gHC__ SLIT("parLocal")
 		    [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
 		    (BindDefault z (Var y))))
 
-parGlobalId = pcMiscPrelId parGlobalIdKey gHC__ SLIT("parGlobal")
+parGlobalId = pcMiscPrelId parGlobalIdKey cONC_BASE SLIT("parGlobal")
 		  (mkSigmaTy [alphaTyVar, betaTyVar] []
 		    (mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy, alphaTy, betaTy] betaTy))
-		  (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parGlobal_template))
+		  (noIdInfo `addUnfoldInfo` (mkUnfolding True parGlobal_template))
   where
     -- Annotations: w: name, g: gran. info, s: size info, p: par info  -- HWL
     [w, g, s, p, x, y, z]
@@ -338,11 +339,11 @@ parGlobalId = pcMiscPrelId parGlobalIdKey gHC__ SLIT("parGlobal")
 		    (BindDefault z (Var y))))
 
 
-parAtId = pcMiscPrelId parAtIdKey gHC__ SLIT("parAt")
+parAtId = pcMiscPrelId parAtIdKey cONC_BASE SLIT("parAt")
 		  (mkSigmaTy [alphaTyVar, betaTyVar] []
 		    (mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy,
 		               alphaTy, betaTy, gammaTy] gammaTy))
-		  (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parAt_template))
+		  (noIdInfo `addUnfoldInfo` (mkUnfolding True parAt_template))
   where
     -- Annotations: w: name, g: gran. info, s: size info, p: par info  -- HWL
     [w, g, s, p, v, x, y, z]
@@ -364,10 +365,10 @@ parAtId = pcMiscPrelId parAtIdKey gHC__ SLIT("parAt")
 		    [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [gammaTy])]
 		    (BindDefault z (Var y))))
 
-parAtAbsId = pcMiscPrelId parAtAbsIdKey gHC__ SLIT("parAtAbs")
+parAtAbsId = pcMiscPrelId parAtAbsIdKey cONC_BASE SLIT("parAtAbs")
 		  (mkSigmaTy [alphaTyVar, betaTyVar] []
 		    (mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, alphaTy, betaTy] betaTy))
-		  (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parAtAbs_template))
+		  (noIdInfo `addUnfoldInfo` (mkUnfolding True parAtAbs_template))
   where
     -- Annotations: w: name, g: gran. info, s: size info, p: par info  -- HWL
     [w, g, s, p, v, x, y, z]
@@ -389,10 +390,10 @@ parAtAbsId = pcMiscPrelId parAtAbsIdKey gHC__ SLIT("parAtAbs")
 		    [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
 		    (BindDefault z (Var y))))
 
-parAtRelId = pcMiscPrelId parAtRelIdKey gHC__ SLIT("parAtRel")
+parAtRelId = pcMiscPrelId parAtRelIdKey cONC_BASE SLIT("parAtRel")
 		  (mkSigmaTy [alphaTyVar, betaTyVar] []
 		    (mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy, intPrimTy, alphaTy, betaTy] betaTy))
-		  (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parAtRel_template))
+		  (noIdInfo `addUnfoldInfo` (mkUnfolding True parAtRel_template))
   where
     -- Annotations: w: name, g: gran. info, s: size info, p: par info  -- HWL
     [w, g, s, p, v, x, y, z]
@@ -414,11 +415,11 @@ parAtRelId = pcMiscPrelId parAtRelIdKey gHC__ SLIT("parAtRel")
 		    [(mkMachInt 0, mkTyApp (Var pAR_ERROR_ID) [betaTy])]
 		    (BindDefault z (Var y))))
 
-parAtForNowId = pcMiscPrelId parAtForNowIdKey gHC__ SLIT("parAtForNow")
+parAtForNowId = pcMiscPrelId parAtForNowIdKey cONC_BASE SLIT("parAtForNow")
 		  (mkSigmaTy [alphaTyVar, betaTyVar] []
 		    (mkFunTys [intPrimTy, intPrimTy, intPrimTy, intPrimTy,
 				alphaTy, betaTy, gammaTy] gammaTy))
-		  (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding parAtForNow_template))
+		  (noIdInfo `addUnfoldInfo` (mkUnfolding True parAtForNow_template))
   where
     -- Annotations: w: name, g: gran. info, s: size info, p: par info  -- HWL
     [w, g, s, p, v, x, y, z]
@@ -443,10 +444,10 @@ parAtForNowId = pcMiscPrelId parAtForNowIdKey gHC__ SLIT("parAtForNow")
 -- copyable and noFollow are currently merely hooks: they are translated into
 -- calls to the macros COPYABLE and NOFOLLOW                            -- HWL 
 
-copyableId = pcMiscPrelId copyableIdKey gHC__ SLIT("copyable")
+copyableId = pcMiscPrelId copyableIdKey cONC_BASE SLIT("copyable")
 		  (mkSigmaTy [alphaTyVar] []
 		    alphaTy)
-		  (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding copyable_template))
+		  (noIdInfo `addUnfoldInfo` (mkUnfolding True copyable_template))
   where
     -- Annotations: x: closure that's tagged to by copyable
     [x, z]
@@ -458,10 +459,10 @@ copyableId = pcMiscPrelId copyableIdKey gHC__ SLIT("copyable")
     copyable_template
       = mkLam [alphaTyVar] [x] ( Prim CopyableOp [TyArg alphaTy, VarArg x] )
 
-noFollowId = pcMiscPrelId noFollowIdKey gHC__ SLIT("noFollow")
+noFollowId = pcMiscPrelId noFollowIdKey cONC_BASE SLIT("noFollow")
 		  (mkSigmaTy [alphaTyVar] []
 		    alphaTy)
-		  (noIdInfo `addInfo_UF` (mkUnfolding EssentialUnfolding noFollow_template))
+		  (noIdInfo `addUnfoldInfo` (mkUnfolding True noFollow_template))
   where
     -- Annotations: x: closure that's tagged to not follow
     [x, z]
@@ -494,7 +495,7 @@ runST a m = case m _RealWorld (S# _RealWorld realWorld#) of
 We unfold always, just for simplicity:
 \begin{code}
 runSTId
-  = pcMiscPrelId runSTIdKey gHC__ SLIT("runST") run_ST_ty id_info
+  = pcMiscPrelId runSTIdKey sT_BASE SLIT("runST") run_ST_ty id_info
   where
     s_tv = betaTyVar
     s	 = betaTy
@@ -507,10 +508,10 @@ runSTId
 
     id_info
       = noIdInfo
-	`addInfo` mkArityInfo 1
-	`addInfo` mkStrictnessInfo [WwStrict] Nothing
-	`addInfo` mkArgUsageInfo [ArgUsage 1]
-	-- ABSOLUTELY NO UNFOLDING, e.g.: (mkUnfolding EssentialUnfolding run_ST_template)
+	`addArityInfo` exactArity 1
+	`addStrictnessInfo` mkStrictnessInfo [WwStrict] Nothing
+	`addArgUsageInfo` mkArgUsageInfo [ArgUsage 1]
+	-- ABSOLUTELY NO UNFOLDING, e.g.: (mkUnfolding True run_ST_template)
 	-- see example below
 {- OUT:
     [m, t, r, wild]
@@ -526,7 +527,7 @@ runSTId
 	    Let (NonRec t (Con stateDataCon [TyArg realWorldTy, VarArg realWorldPrimId])) (
 	      Case (App (mkTyApp (Var m) [realWorldTy]) (VarArg t)) (
 		AlgAlts
-		  [(mkTupleCon 2, [r, wild], Var r)]
+		  [(pairDataCon, [r, wild], Var r)]
 		  NoDefault)))
 -}
 \end{code}
@@ -564,13 +565,13 @@ All calls to @f@ will share a {\em single} array!  End SLPJ 95/04.
 nasty as-is, change it back to a literal (@Literal@).
 \begin{code}
 realWorldPrimId
-  = pcMiscPrelId realWorldPrimIdKey gHC_BUILTINS SLIT("realWorld#")
+  = pcMiscPrelId realWorldPrimIdKey gHC__ SLIT("realWorld#")
 	realWorldStatePrimTy
 	noIdInfo
 \end{code}
 
 \begin{code}
-voidId = pcMiscPrelId voidIdKey gHC_BUILTINS SLIT("void") voidTy noIdInfo
+voidId = pcMiscPrelId voidIdKey gHC__ SLIT("void") voidTy noIdInfo
 \end{code}
 
 %************************************************************************
@@ -581,12 +582,12 @@ voidId = pcMiscPrelId voidIdKey gHC_BUILTINS SLIT("void") voidTy noIdInfo
 
 \begin{code}
 buildId
-  = pcMiscPrelId buildIdKey SLIT("GHCerr") SLIT("build") buildTy
+  = pcMiscPrelId buildIdKey gHC_ERR SLIT("build") buildTy
 	((((noIdInfo
-		{-LATER:`addInfo_UF` mkMagicUnfolding buildIdKey-})
-		`addInfo` mkStrictnessInfo [WwStrict] Nothing)
-		`addInfo` mkArgUsageInfo [ArgUsage 2])
-		`addInfo` pcGenerateSpecs buildIdKey buildId noIdInfo{-ToDo-} buildTy)
+		{-LATER:`addUnfoldInfo` mkMagicUnfolding buildIdKey-})
+		`addStrictnessInfo` mkStrictnessInfo [WwStrict] Nothing)
+		`addArgUsageInfo` mkArgUsageInfo [ArgUsage 2])
+		`addSpecInfo` pcGenerateSpecs buildIdKey buildId noIdInfo{-ToDo-} buildTy)
 	-- cheating, but since _build never actually exists ...
   where
     -- The type of this strange object is:
@@ -626,11 +627,11 @@ mkBuild ty tv c n g expr
 
 \begin{code}
 augmentId
-  = pcMiscPrelId augmentIdKey SLIT("GHCerr") SLIT("augment") augmentTy
+  = pcMiscPrelId augmentIdKey gHC_ERR SLIT("augment") augmentTy
 	(((noIdInfo
-		{-LATER:`addInfo_UF` mkMagicUnfolding augmentIdKey-})
-		`addInfo` mkStrictnessInfo [WwStrict,WwLazy False] Nothing)
-		`addInfo` mkArgUsageInfo [ArgUsage 2,UnknownArgUsage])
+		{-LATER:`addUnfoldInfo` mkMagicUnfolding augmentIdKey-})
+		`addStrictnessInfo` mkStrictnessInfo [WwStrict,WwLazy False] Nothing)
+		`addArgUsageInfo` mkArgUsageInfo [ArgUsage 2,UnknownArgUsage])
 	-- cheating, but since _augment never actually exists ...
   where
     -- The type of this strange object is:
@@ -643,7 +644,7 @@ augmentId
 \end{code}
 
 \begin{code}
-foldrId = pcMiscPrelId foldrIdKey pRELUDE SLIT("foldr")
+foldrId = pcMiscPrelId foldrIdKey pREL_BASE SLIT("foldr")
 		 foldrTy idInfo
   where
 	foldrTy =
@@ -651,13 +652,13 @@ foldrId = pcMiscPrelId foldrIdKey pRELUDE SLIT("foldr")
 		(mkFunTys [mkFunTys [alphaTy, betaTy] betaTy, betaTy, mkListTy alphaTy] betaTy)
 
 	idInfo = (((((noIdInfo
-			{-LATER:`addInfo_UF` mkMagicUnfolding foldrIdKey-})
-			`addInfo` mkStrictnessInfo [WwLazy False,WwLazy False,WwStrict] Nothing)
-			`addInfo` mkArityInfo 3)
-			`addInfo` mkUpdateInfo [2,2,1])
-			`addInfo` pcGenerateSpecs foldrIdKey foldrId noIdInfo{-ToDo-} foldrTy)
+			{-LATER:`addUnfoldInfo` mkMagicUnfolding foldrIdKey-})
+			`addStrictnessInfo` mkStrictnessInfo [WwLazy False,WwLazy False,WwStrict] Nothing)
+			`addArityInfo` exactArity 3)
+			`addUpdateInfo` mkUpdateInfo [2,2,1])
+			`addSpecInfo` pcGenerateSpecs foldrIdKey foldrId noIdInfo{-ToDo-} foldrTy)
 
-foldlId = pcMiscPrelId foldlIdKey pRELUDE SLIT("foldl")
+foldlId = pcMiscPrelId foldlIdKey pREL_LIST SLIT("foldl")
 		 foldlTy idInfo
   where
 	foldlTy =
@@ -665,11 +666,11 @@ foldlId = pcMiscPrelId foldlIdKey pRELUDE SLIT("foldl")
 		(mkFunTys [mkFunTys [alphaTy, betaTy] alphaTy, alphaTy, mkListTy betaTy] alphaTy)
 
 	idInfo = (((((noIdInfo
-			{-LATER:`addInfo_UF` mkMagicUnfolding foldlIdKey-})
-			`addInfo` mkStrictnessInfo [WwLazy False,WwLazy False,WwStrict] Nothing)
-			`addInfo` mkArityInfo 3)
-			`addInfo` mkUpdateInfo [2,2,1])
-			`addInfo` pcGenerateSpecs foldlIdKey foldlId noIdInfo{-ToDo-} foldlTy)
+			{-LATER:`addUnfoldInfo` mkMagicUnfolding foldlIdKey-})
+			`addStrictnessInfo` mkStrictnessInfo [WwLazy False,WwLazy False,WwStrict] Nothing)
+			`addArityInfo` exactArity 3)
+			`addUpdateInfo` mkUpdateInfo [2,2,1])
+			`addSpecInfo` pcGenerateSpecs foldlIdKey foldlId noIdInfo{-ToDo-} foldlTy)
 
 -- A bit of magic goes no here. We translate appendId into ++,
 -- you have to be carefull when you actually compile append:
@@ -686,15 +687,15 @@ foldlId = pcMiscPrelId foldlIdKey pRELUDE SLIT("foldl")
 --
 {- OLD: doesn't apply with 1.3
 appendId
-  = pcMiscPrelId appendIdKey pRELUDE_LIST SLIT("++") appendTy idInfo
+  = pcMiscPrelId appendIdKey mONAD SLIT("++") appendTy idInfo
   where
     appendTy =
       (mkSigmaTy [alphaTyVar] []
 	    (mkFunTys [mkListTy alphaTy, mkListTy alphaTy] (mkListTy alphaTy)))
     idInfo = (((noIdInfo
-		`addInfo` mkStrictnessInfo [WwStrict,WwLazy False] Nothing)
-		`addInfo` mkArityInfo 2)
-		`addInfo` mkUpdateInfo [1,2])
+		`addStrictnessInfo` mkStrictnessInfo [WwStrict,WwLazy False] Nothing)
+		`addArityInfo` exactArity 2)
+		`addUpdateInfo` mkUpdateInfo [1,2])
 -}
 \end{code}
 
diff --git a/ghc/compiler/prelude/PrimOp.lhs b/ghc/compiler/prelude/PrimOp.lhs
index 1e62e9c326..0e522a4366 100644
--- a/ghc/compiler/prelude/PrimOp.lhs
+++ b/ghc/compiler/prelude/PrimOp.lhs
@@ -36,7 +36,7 @@ import TysPrim
 import TysWiredIn
 
 import CStrings		( identToC )
-import CgCompInfo   	( mIN_MP_INT_SIZE, mP_STRUCT_SIZE )
+import Constants   	( mIN_MP_INT_SIZE, mP_STRUCT_SIZE )
 import HeapOffs		( addOff, intOff, totHdrSize, HeapOffset )
 import PprStyle		( codeStyle{-, PprStyle(..) ToDo:rm-} )
 import PprType		( pprParendGenType, GenTyVar{-instance Outputable-} )
@@ -702,12 +702,12 @@ primOpInfo CharNeOp   = Compare SLIT("neChar#")   charPrimTy
 primOpInfo CharLtOp   = Compare SLIT("ltChar#")   charPrimTy
 primOpInfo CharLeOp   = Compare SLIT("leChar#")   charPrimTy
 
-primOpInfo IntGtOp    = Compare SLIT("gtInt#")	   intPrimTy
-primOpInfo IntGeOp    = Compare SLIT("geInt#")	   intPrimTy
-primOpInfo IntEqOp    = Compare SLIT("eqInt#")	   intPrimTy
-primOpInfo IntNeOp    = Compare SLIT("neInt#")	   intPrimTy
-primOpInfo IntLtOp    = Compare SLIT("ltInt#")	   intPrimTy
-primOpInfo IntLeOp    = Compare SLIT("leInt#")	   intPrimTy
+primOpInfo IntGtOp    = Compare SLIT(">#")	   intPrimTy
+primOpInfo IntGeOp    = Compare SLIT(">=#")	   intPrimTy
+primOpInfo IntEqOp    = Compare SLIT("==#")	   intPrimTy
+primOpInfo IntNeOp    = Compare SLIT("/=#")	   intPrimTy
+primOpInfo IntLtOp    = Compare SLIT("<#")	   intPrimTy
+primOpInfo IntLeOp    = Compare SLIT("<=#")	   intPrimTy
 
 primOpInfo WordGtOp   = Compare SLIT("gtWord#")   wordPrimTy
 primOpInfo WordGeOp   = Compare SLIT("geWord#")   wordPrimTy
@@ -730,12 +730,12 @@ primOpInfo FloatNeOp  = Compare SLIT("neFloat#")  floatPrimTy
 primOpInfo FloatLtOp  = Compare SLIT("ltFloat#")  floatPrimTy
 primOpInfo FloatLeOp  = Compare SLIT("leFloat#")  floatPrimTy
 
-primOpInfo DoubleGtOp = Compare SLIT("gtDouble#") doublePrimTy
-primOpInfo DoubleGeOp = Compare SLIT("geDouble#") doublePrimTy
-primOpInfo DoubleEqOp = Compare SLIT("eqDouble#") doublePrimTy
-primOpInfo DoubleNeOp = Compare SLIT("neDouble#") doublePrimTy
-primOpInfo DoubleLtOp = Compare SLIT("ltDouble#") doublePrimTy
-primOpInfo DoubleLeOp = Compare SLIT("leDouble#") doublePrimTy
+primOpInfo DoubleGtOp = Compare SLIT(">##") doublePrimTy
+primOpInfo DoubleGeOp = Compare SLIT(">=##") doublePrimTy
+primOpInfo DoubleEqOp = Compare SLIT("==##") doublePrimTy
+primOpInfo DoubleNeOp = Compare SLIT("/=##") doublePrimTy
+primOpInfo DoubleLtOp = Compare SLIT("<##") doublePrimTy
+primOpInfo DoubleLeOp = Compare SLIT("<=##") doublePrimTy
 \end{code}
 
 %************************************************************************
@@ -756,9 +756,9 @@ primOpInfo ChrOp = Coercing SLIT("chr#") intPrimTy charPrimTy
 %************************************************************************
 
 \begin{code}
-primOpInfo IntAddOp  = Dyadic SLIT("plusInt#")	 intPrimTy
-primOpInfo IntSubOp  = Dyadic SLIT("minusInt#") intPrimTy
-primOpInfo IntMulOp  = Dyadic SLIT("timesInt#") intPrimTy
+primOpInfo IntAddOp  = Dyadic SLIT("+#")	 intPrimTy
+primOpInfo IntSubOp  = Dyadic SLIT("-#") intPrimTy
+primOpInfo IntMulOp  = Dyadic SLIT("*#") intPrimTy
 primOpInfo IntQuotOp = Dyadic SLIT("quotInt#")	 intPrimTy
 primOpInfo IntRemOp  = Dyadic SLIT("remInt#")	 intPrimTy
 
@@ -851,10 +851,10 @@ primOpInfo FloatPowerOp	= Dyadic    SLIT("powerFloat#")   floatPrimTy
 similar).
 
 \begin{code}
-primOpInfo DoubleAddOp	= Dyadic    SLIT("plusDouble#")   doublePrimTy
-primOpInfo DoubleSubOp	= Dyadic    SLIT("minusDouble#")  doublePrimTy
-primOpInfo DoubleMulOp	= Dyadic    SLIT("timesDouble#")  doublePrimTy
-primOpInfo DoubleDivOp	= Dyadic    SLIT("divideDouble#") doublePrimTy
+primOpInfo DoubleAddOp	= Dyadic    SLIT("+##")   doublePrimTy
+primOpInfo DoubleSubOp	= Dyadic    SLIT("-##")  doublePrimTy
+primOpInfo DoubleMulOp	= Dyadic    SLIT("*##")  doublePrimTy
+primOpInfo DoubleDivOp	= Dyadic    SLIT("/##") doublePrimTy
 primOpInfo DoubleNegOp	= Monadic   SLIT("negateDouble#") doublePrimTy
 
 primOpInfo Double2IntOp	    = Coercing SLIT("double2Int#")   doublePrimTy intPrimTy
@@ -875,7 +875,7 @@ primOpInfo DoubleAtanOp	= Monadic   SLIT("atanDouble#")   doublePrimTy
 primOpInfo DoubleSinhOp	= Monadic   SLIT("sinhDouble#")   doublePrimTy
 primOpInfo DoubleCoshOp	= Monadic   SLIT("coshDouble#")   doublePrimTy
 primOpInfo DoubleTanhOp	= Monadic   SLIT("tanhDouble#")   doublePrimTy
-primOpInfo DoublePowerOp= Dyadic    SLIT("powerDouble#")  doublePrimTy
+primOpInfo DoublePowerOp= Dyadic    SLIT("**##")  doublePrimTy
 \end{code}
 
 %************************************************************************
diff --git a/ghc/compiler/prelude/TysPrim.lhs b/ghc/compiler/prelude/TysPrim.lhs
index 954659a017..17ee58e629 100644
--- a/ghc/compiler/prelude/TysPrim.lhs
+++ b/ghc/compiler/prelude/TysPrim.lhs
@@ -14,13 +14,13 @@ module TysPrim where
 IMP_Ubiq(){-uitous-}
 
 import Kind		( mkUnboxedTypeKind, mkBoxedTypeKind, mkTypeKind, mkArrowKind )
-import Name		( mkPrimitiveName )
-import PrelMods		( gHC_BUILTINS )
+import Name		( mkWiredInTyConName )
 import PrimRep		( PrimRep(..) )	-- getPrimRepInfo uses PrimRep repn
 import TyCon		( mkPrimTyCon, mkDataTyCon, NewOrData(..) )
 import Type		( applyTyCon, mkTyVarTys, mkTyConTy )
 import TyVar		( GenTyVar(..), alphaTyVars )
 import Usage		( usageOmega )
+import PrelMods		( gHC__ )
 import Unique
 \end{code}
 
@@ -40,10 +40,10 @@ alphaTys = mkTyVarTys alphaTyVars
 pcPrimTyCon :: Unique{-TyConKey-} -> FAST_STRING -> Int -> PrimRep -> TyCon
 
 pcPrimTyCon key str arity primrep
-  = mkPrimTyCon name (mk_kind arity) primrep
+  = the_tycon
   where
-    name = mkPrimitiveName key (OrigName gHC_BUILTINS str)
-
+    name      = mkWiredInTyConName key gHC__ str the_tycon
+    the_tycon = mkPrimTyCon name (mk_kind arity) primrep
     mk_kind 0 = mkUnboxedTypeKind
     mk_kind n = mkTypeKind `mkArrowKind` mk_kind (n-1)
 
@@ -111,17 +111,8 @@ We never manipulate values of type RealWorld; it's only used in the type
 system, to parameterise State#.
 
 \begin{code}
-realWorldTy = applyTyCon realWorldTyCon []
-realWorldTyCon
-  = mkDataTyCon name mkBoxedTypeKind 
-	[{-no tyvars-}]
-	[{-no context-}]
-	[{-no data cons!-}] -- we tell you *nothing* about this guy
-	[{-no derivings-}]
-	DataType
-  where
-    name = mkPrimitiveName realWorldTyConKey (OrigName gHC_BUILTINS SLIT("RealWorld"))
-
+realWorldTy	     = applyTyCon realWorldTyCon []
+realWorldTyCon	     = mk_no_constr_tycon realWorldTyConKey SLIT("RealWorld") 
 realWorldStatePrimTy = mkStatePrimTy realWorldTy
 \end{code}
 
@@ -137,17 +128,21 @@ defined in \tr{TysWiredIn.lhs}, not here.
 --
 -- ) It's boxed; there is only one value of this
 -- type, namely "void", whose semantics is just bottom.
-voidTy = mkTyConTy voidTyCon
-
-voidTyCon
-  = mkDataTyCon name mkBoxedTypeKind 
-	[{-no tyvars-}]
-	[{-no context-}]
-	[{-no data cons!-}]
-	[{-no derivings-}]
-	DataType
+voidTy    = mkTyConTy voidTyCon
+voidTyCon = mk_no_constr_tycon voidTyConKey SLIT("Void")
+\end{code}
+
+\begin{code}
+mk_no_constr_tycon key str
+  = the_tycon
   where
-    name = mkPrimitiveName voidTyConKey (OrigName gHC_BUILTINS SLIT("Void"))
+    name      = mkWiredInTyConName key gHC__ str the_tycon
+    the_tycon = mkDataTyCon name mkBoxedTypeKind 
+			[{-no tyvars-}]
+			[{-no context-}]
+			[{-no data cons!-}] -- we tell you *nothing* about this guy
+			[{-no derivings-}]
+			DataType
 \end{code}
 
 %************************************************************************
diff --git a/ghc/compiler/prelude/TysWiredIn.lhs b/ghc/compiler/prelude/TysWiredIn.lhs
index 5b1e3d0a0c..06c91a35fa 100644
--- a/ghc/compiler/prelude/TysWiredIn.lhs
+++ b/ghc/compiler/prelude/TysWiredIn.lhs
@@ -45,6 +45,7 @@ module TysWiredIn (
 	mkPrimIoTy,
 	mkStateTy,
 	mkStateTransformerTy,
+	tupleTyCon, tupleCon, unitTyCon, unitDataCon, pairTyCon, pairDataCon,
 	mkTupleTy,
 	nilDataCon,
 	primIoTyCon,
@@ -86,7 +87,7 @@ module TysWiredIn (
 --import Kind
 
 IMP_Ubiq()
-IMPORT_DELOOPER(TyLoop)	( mkDataCon, StrictnessMark(..) )
+IMPORT_DELOOPER(TyLoop)	( mkDataCon, mkTupleCon, StrictnessMark(..) )
 IMPORT_DELOOPER(IdLoop)	( SpecEnv )
 
 -- friends:
@@ -95,15 +96,15 @@ import TysPrim
 
 -- others:
 import Kind		( mkBoxedTypeKind, mkArrowKind )
-import Name		( mkWiredInName, ExportFlag(..) )
-import SrcLoc		( mkBuiltinSrcLoc )
+import Name		( mkWiredInTyConName, mkWiredInIdName, mkTupNameStr )
 import TyCon		( mkDataTyCon, mkTupleTyCon, mkSynTyCon,
 			  NewOrData(..), TyCon
 			)
-import Type		( mkTyConTy, applyTyCon, mkSigmaTy,
-			  mkFunTy, maybeAppTyCon,
+import Type		( mkTyConTy, applyTyCon, mkSigmaTy, mkTyVarTys, 
+			  mkFunTy, mkFunTys, maybeAppTyCon,
 			  GenType(..), SYN_IE(ThetaType), SYN_IE(TauType) )
-import TyVar		( tyVarKind, alphaTyVar, betaTyVar )
+import TyVar		( tyVarKind, alphaTyVars, alphaTyVar, betaTyVar )
+import Lex		( mkTupNameStr )
 import Unique
 import Util		( assoc, panic )
 
@@ -124,25 +125,30 @@ pcDataTyCon = pc_tycon DataType
 pcNewTyCon  = pc_tycon NewType
 
 pc_tycon new_or_data key mod str tyvars cons
-  = mkDataTyCon (mkWiredInName key (OrigName mod str) ExportAll) tycon_kind 
+  = tycon
+  where
+    tycon = mkDataTyCon name tycon_kind 
 		tyvars [{-no context-}] cons [{-no derivings-}]
 		new_or_data
-  where
+    name = mkWiredInTyConName key mod str tycon
     tycon_kind = foldr (mkArrowKind . tyVarKind) mkBoxedTypeKind tyvars
 
 pcSynTyCon key mod str kind arity tyvars expansion
-  = mkSynTyCon
-     (mkWiredInName key (OrigName mod str) ExportAll)
-     kind arity tyvars expansion
+  = tycon
+  where
+    tycon = mkSynTyCon name kind arity tyvars expansion
+    name  = mkWiredInTyConName key mod str tycon
 
 pcDataCon :: Unique{-DataConKey-} -> Module -> FAST_STRING
 	  -> [TyVar] -> ThetaType -> [TauType] -> TyCon -> SpecEnv -> Id
 pcDataCon key mod str tyvars context arg_tys tycon specenv
-  = mkDataCon (mkWiredInName key (OrigName mod str) ExportAll)
-	[ NotMarkedStrict | a <- arg_tys ]
-	[ {- no labelled fields -} ]
-	tyvars context arg_tys tycon
-	-- specenv
+  = data_con
+  where
+    data_con = mkDataCon name 
+		[ NotMarkedStrict | a <- arg_tys ]
+		[ {- no labelled fields -} ]
+		tyvars context arg_tys tycon
+    name = mkWiredInIdName key mod str data_con
 
 pcGenerateDataSpecs :: Type -> SpecEnv
 pcGenerateDataSpecs ty
@@ -153,6 +159,45 @@ pcGenerateDataSpecs ty
 
 %************************************************************************
 %*									*
+\subsection[TysWiredIn-tuples]{The tuple types}
+%*									*
+%************************************************************************
+
+\begin{code}
+tupleTyCon :: Arity -> TyCon
+tupleTyCon arity
+  = tycon
+  where
+    tycon = mkTupleTyCon uniq name arity
+    uniq  = mkTupleTyConUnique arity
+    name  = mkWiredInTyConName uniq mod_name (mkTupNameStr arity) tycon
+    mod_name | arity == 0 = pREL_BASE
+	     | otherwise  = pREL_TUP 
+
+tupleCon :: Arity -> Id
+tupleCon arity
+  = tuple_con
+  where
+    tuple_con = mkTupleCon arity name ty
+    uniq      = mkTupleDataConUnique arity
+    name      = mkWiredInIdName uniq mod_name (mkTupNameStr arity) tuple_con
+    mod_name  | arity == 0 = pREL_BASE
+	      | otherwise  = pREL_TUP
+    ty 		= mkSigmaTy tyvars [] (mkFunTys tyvar_tys (applyTyCon tycon tyvar_tys))
+    tyvars	= take arity alphaTyVars
+    tyvar_tys	= mkTyVarTys tyvars
+    tycon	= tupleTyCon arity
+
+unitTyCon = tupleTyCon 0
+pairTyCon = tupleTyCon 2
+
+unitDataCon = tupleCon 0
+pairDataCon = tupleCon 2
+\end{code}
+
+
+%************************************************************************
+%*									*
 \subsection[TysWiredIn-boxed-prim]{The ``boxed primitive'' types (@Char@, @Int@, etc)}
 %*									*
 %************************************************************************
@@ -160,8 +205,8 @@ pcGenerateDataSpecs ty
 \begin{code}
 charTy = mkTyConTy charTyCon
 
-charTyCon = pcDataTyCon charTyConKey  pRELUDE  SLIT("Char") [] [charDataCon]
-charDataCon = pcDataCon charDataConKey pRELUDE SLIT("C#") [] [] [charPrimTy] charTyCon nullSpecEnv
+charTyCon = pcDataTyCon charTyConKey  pREL_BASE  SLIT("Char") [] [charDataCon]
+charDataCon = pcDataCon charDataConKey pREL_BASE SLIT("C#") [] [] [charPrimTy] charTyCon nullSpecEnv
 
 stringTy = mkListTy charTy -- convenience only
 \end{code}
@@ -169,65 +214,65 @@ stringTy = mkListTy charTy -- convenience only
 \begin{code}
 intTy = mkTyConTy intTyCon 
 
-intTyCon = pcDataTyCon intTyConKey pRELUDE SLIT("Int") [] [intDataCon]
-intDataCon = pcDataCon intDataConKey pRELUDE SLIT("I#") [] [] [intPrimTy] intTyCon nullSpecEnv
+intTyCon = pcDataTyCon intTyConKey pREL_BASE SLIT("Int") [] [intDataCon]
+intDataCon = pcDataCon intDataConKey pREL_BASE SLIT("I#") [] [] [intPrimTy] intTyCon nullSpecEnv
 \end{code}
 
 \begin{code}
 wordTy = mkTyConTy wordTyCon
 
-wordTyCon = pcDataTyCon wordTyConKey gHC__ SLIT("Word") [] [wordDataCon]
+wordTyCon = pcDataTyCon wordTyConKey   fOREIGN SLIT("Word") [] [wordDataCon]
 wordDataCon = pcDataCon wordDataConKey gHC__ SLIT("W#") [] [] [wordPrimTy] wordTyCon nullSpecEnv
 \end{code}
 
 \begin{code}
 addrTy = mkTyConTy addrTyCon
 
-addrTyCon = pcDataTyCon addrTyConKey gHC__ SLIT("Addr") [] [addrDataCon]
+addrTyCon = pcDataTyCon addrTyConKey   fOREIGN SLIT("Addr") [] [addrDataCon]
 addrDataCon = pcDataCon addrDataConKey gHC__ SLIT("A#") [] [] [addrPrimTy] addrTyCon nullSpecEnv
 \end{code}
 
 \begin{code}
 floatTy	= mkTyConTy floatTyCon
 
-floatTyCon = pcDataTyCon floatTyConKey pRELUDE SLIT("Float") [] [floatDataCon]
-floatDataCon = pcDataCon floatDataConKey pRELUDE SLIT("F#") [] [] [floatPrimTy] floatTyCon nullSpecEnv
+floatTyCon = pcDataTyCon floatTyConKey pREL_BASE SLIT("Float") [] [floatDataCon]
+floatDataCon = pcDataCon floatDataConKey pREL_BASE SLIT("F#") [] [] [floatPrimTy] floatTyCon nullSpecEnv
 \end{code}
 
 \begin{code}
 doubleTy = mkTyConTy doubleTyCon
 
-doubleTyCon = pcDataTyCon doubleTyConKey pRELUDE SLIT("Double") [] [doubleDataCon]
-doubleDataCon = pcDataCon doubleDataConKey pRELUDE SLIT("D#") [] [] [doublePrimTy] doubleTyCon nullSpecEnv
+doubleTyCon = pcDataTyCon doubleTyConKey pREL_BASE SLIT("Double") [] [doubleDataCon]
+doubleDataCon = pcDataCon doubleDataConKey pREL_BASE SLIT("D#") [] [] [doublePrimTy] doubleTyCon nullSpecEnv
 \end{code}
 
 \begin{code}
 mkStateTy ty	 = applyTyCon stateTyCon [ty]
 realWorldStateTy = mkStateTy realWorldTy -- a common use
 
-stateTyCon = pcDataTyCon stateTyConKey gHC__ SLIT("State") alpha_tyvar [stateDataCon]
+stateTyCon = pcDataTyCon stateTyConKey sT_BASE SLIT("State") alpha_tyvar [stateDataCon]
 stateDataCon
-  = pcDataCon stateDataConKey gHC__ SLIT("S#")
+  = pcDataCon stateDataConKey sT_BASE SLIT("S#")
 	alpha_tyvar [] [mkStatePrimTy alphaTy] stateTyCon nullSpecEnv
 \end{code}
 
 \begin{code}
 stablePtrTyCon
-  = pcDataTyCon stablePtrTyConKey gHC__ SLIT("StablePtr")
+  = pcDataTyCon stablePtrTyConKey fOREIGN SLIT("StablePtr")
 	alpha_tyvar [stablePtrDataCon]
   where
     stablePtrDataCon
-      = pcDataCon stablePtrDataConKey gHC__ SLIT("StablePtr")
+      = pcDataCon stablePtrDataConKey fOREIGN SLIT("StablePtr")
 	    alpha_tyvar [] [mkStablePtrPrimTy alphaTy] stablePtrTyCon nullSpecEnv
 \end{code}
 
 \begin{code}
 foreignObjTyCon
-  = pcDataTyCon foreignObjTyConKey gHC__ SLIT("ForeignObj")
+  = pcDataTyCon foreignObjTyConKey fOREIGN SLIT("ForeignObj")
 	[] [foreignObjDataCon]
   where
     foreignObjDataCon
-      = pcDataCon foreignObjDataConKey gHC__ SLIT("ForeignObj")
+      = pcDataCon foreignObjDataConKey fOREIGN SLIT("ForeignObj")
 	    [] [] [foreignObjPrimTy] foreignObjTyCon nullSpecEnv
 \end{code}
 
@@ -242,27 +287,27 @@ foreignObjTyCon
 integerTy :: GenType t u
 integerTy    = mkTyConTy integerTyCon
 
-integerTyCon = pcDataTyCon integerTyConKey pRELUDE SLIT("Integer") [] [integerDataCon]
+integerTyCon = pcDataTyCon integerTyConKey pREL_BASE SLIT("Integer") [] [integerDataCon]
 
-integerDataCon = pcDataCon integerDataConKey pRELUDE SLIT("J#")
+integerDataCon = pcDataCon integerDataConKey pREL_BASE SLIT("J#")
 		[] [] [intPrimTy, intPrimTy, byteArrayPrimTy] integerTyCon nullSpecEnv
 \end{code}
 
 And the other pairing types:
 \begin{code}
 return2GMPsTyCon = pcDataTyCon return2GMPsTyConKey
-	gHC__ SLIT("Return2GMPs") [] [return2GMPsDataCon]
+	pREL_NUM SLIT("Return2GMPs") [] [return2GMPsDataCon]
 
 return2GMPsDataCon
-  = pcDataCon return2GMPsDataConKey gHC__ SLIT("Return2GMPs") [] []
+  = pcDataCon return2GMPsDataConKey pREL_NUM SLIT("Return2GMPs") [] []
 	[intPrimTy, intPrimTy, byteArrayPrimTy,
 	 intPrimTy, intPrimTy, byteArrayPrimTy] return2GMPsTyCon nullSpecEnv
 
 returnIntAndGMPTyCon = pcDataTyCon returnIntAndGMPTyConKey
-	gHC__ SLIT("ReturnIntAndGMP") [] [returnIntAndGMPDataCon]
+	pREL_NUM SLIT("ReturnIntAndGMP") [] [returnIntAndGMPDataCon]
 
 returnIntAndGMPDataCon
-  = pcDataCon returnIntAndGMPDataConKey gHC__ SLIT("ReturnIntAndGMP") [] []
+  = pcDataCon returnIntAndGMPDataConKey pREL_NUM SLIT("ReturnIntAndGMP") [] []
 	[intPrimTy, intPrimTy, intPrimTy, byteArrayPrimTy] returnIntAndGMPTyCon nullSpecEnv
 \end{code}
 
@@ -281,118 +326,118 @@ We fish one of these \tr{StateAnd<blah>#} things with
 
 \begin{code}
 stateAndPtrPrimTyCon
-  = pcDataTyCon stateAndPtrPrimTyConKey gHC__ SLIT("StateAndPtr#")
+  = pcDataTyCon stateAndPtrPrimTyConKey sT_BASE SLIT("StateAndPtr#")
 		alpha_beta_tyvars [stateAndPtrPrimDataCon]
 stateAndPtrPrimDataCon
-  = pcDataCon stateAndPtrPrimDataConKey gHC__ SLIT("StateAndPtr#")
+  = pcDataCon stateAndPtrPrimDataConKey sT_BASE SLIT("StateAndPtr#")
 		alpha_beta_tyvars [] [mkStatePrimTy alphaTy, betaTy]
 		stateAndPtrPrimTyCon nullSpecEnv
 
 stateAndCharPrimTyCon
-  = pcDataTyCon stateAndCharPrimTyConKey gHC__ SLIT("StateAndChar#")
+  = pcDataTyCon stateAndCharPrimTyConKey sT_BASE SLIT("StateAndChar#")
 		alpha_tyvar [stateAndCharPrimDataCon]
 stateAndCharPrimDataCon
-  = pcDataCon stateAndCharPrimDataConKey gHC__ SLIT("StateAndChar#")
+  = pcDataCon stateAndCharPrimDataConKey sT_BASE SLIT("StateAndChar#")
 		alpha_tyvar [] [mkStatePrimTy alphaTy, charPrimTy]
 		stateAndCharPrimTyCon nullSpecEnv
 
 stateAndIntPrimTyCon
-  = pcDataTyCon stateAndIntPrimTyConKey gHC__ SLIT("StateAndInt#")
+  = pcDataTyCon stateAndIntPrimTyConKey sT_BASE SLIT("StateAndInt#")
 		alpha_tyvar [stateAndIntPrimDataCon]
 stateAndIntPrimDataCon
-  = pcDataCon stateAndIntPrimDataConKey gHC__ SLIT("StateAndInt#")
+  = pcDataCon stateAndIntPrimDataConKey sT_BASE SLIT("StateAndInt#")
 		alpha_tyvar [] [mkStatePrimTy alphaTy, intPrimTy]
 		stateAndIntPrimTyCon nullSpecEnv
 
 stateAndWordPrimTyCon
-  = pcDataTyCon stateAndWordPrimTyConKey gHC__ SLIT("StateAndWord#")
+  = pcDataTyCon stateAndWordPrimTyConKey sT_BASE SLIT("StateAndWord#")
 		alpha_tyvar [stateAndWordPrimDataCon]
 stateAndWordPrimDataCon
-  = pcDataCon stateAndWordPrimDataConKey gHC__ SLIT("StateAndWord#")
+  = pcDataCon stateAndWordPrimDataConKey sT_BASE SLIT("StateAndWord#")
 		alpha_tyvar [] [mkStatePrimTy alphaTy, wordPrimTy]
 		stateAndWordPrimTyCon nullSpecEnv
 
 stateAndAddrPrimTyCon
-  = pcDataTyCon stateAndAddrPrimTyConKey gHC__ SLIT("StateAndAddr#")
+  = pcDataTyCon stateAndAddrPrimTyConKey sT_BASE SLIT("StateAndAddr#")
 		alpha_tyvar [stateAndAddrPrimDataCon]
 stateAndAddrPrimDataCon
-  = pcDataCon stateAndAddrPrimDataConKey gHC__ SLIT("StateAndAddr#")
+  = pcDataCon stateAndAddrPrimDataConKey sT_BASE SLIT("StateAndAddr#")
 		alpha_tyvar [] [mkStatePrimTy alphaTy, addrPrimTy]
 		stateAndAddrPrimTyCon nullSpecEnv
 
 stateAndStablePtrPrimTyCon
-  = pcDataTyCon stateAndStablePtrPrimTyConKey gHC__ SLIT("StateAndStablePtr#")
+  = pcDataTyCon stateAndStablePtrPrimTyConKey fOREIGN SLIT("StateAndStablePtr#")
 		alpha_beta_tyvars [stateAndStablePtrPrimDataCon]
 stateAndStablePtrPrimDataCon
-  = pcDataCon stateAndStablePtrPrimDataConKey gHC__ SLIT("StateAndStablePtr#")
+  = pcDataCon stateAndStablePtrPrimDataConKey fOREIGN SLIT("StateAndStablePtr#")
 		alpha_beta_tyvars []
 		[mkStatePrimTy alphaTy, applyTyCon stablePtrPrimTyCon [betaTy]]
 		stateAndStablePtrPrimTyCon nullSpecEnv
 
 stateAndForeignObjPrimTyCon
-  = pcDataTyCon stateAndForeignObjPrimTyConKey gHC__ SLIT("StateAndForeignObj#")
+  = pcDataTyCon stateAndForeignObjPrimTyConKey fOREIGN SLIT("StateAndForeignObj#")
 		alpha_tyvar [stateAndForeignObjPrimDataCon]
 stateAndForeignObjPrimDataCon
-  = pcDataCon stateAndForeignObjPrimDataConKey gHC__ SLIT("StateAndForeignObj#")
+  = pcDataCon stateAndForeignObjPrimDataConKey fOREIGN SLIT("StateAndForeignObj#")
 		alpha_tyvar []
 		[mkStatePrimTy alphaTy, applyTyCon foreignObjPrimTyCon []]
 		stateAndForeignObjPrimTyCon nullSpecEnv
 
 stateAndFloatPrimTyCon
-  = pcDataTyCon stateAndFloatPrimTyConKey gHC__ SLIT("StateAndFloat#")
+  = pcDataTyCon stateAndFloatPrimTyConKey sT_BASE SLIT("StateAndFloat#")
 		alpha_tyvar [stateAndFloatPrimDataCon]
 stateAndFloatPrimDataCon
-  = pcDataCon stateAndFloatPrimDataConKey gHC__ SLIT("StateAndFloat#")
+  = pcDataCon stateAndFloatPrimDataConKey sT_BASE SLIT("StateAndFloat#")
 		alpha_tyvar [] [mkStatePrimTy alphaTy, floatPrimTy]
 		stateAndFloatPrimTyCon nullSpecEnv
 
 stateAndDoublePrimTyCon
-  = pcDataTyCon stateAndDoublePrimTyConKey gHC__ SLIT("StateAndDouble#")
+  = pcDataTyCon stateAndDoublePrimTyConKey sT_BASE SLIT("StateAndDouble#")
 		alpha_tyvar [stateAndDoublePrimDataCon]
 stateAndDoublePrimDataCon
-  = pcDataCon stateAndDoublePrimDataConKey gHC__ SLIT("StateAndDouble#")
+  = pcDataCon stateAndDoublePrimDataConKey sT_BASE SLIT("StateAndDouble#")
 		alpha_tyvar [] [mkStatePrimTy alphaTy, doublePrimTy]
 		stateAndDoublePrimTyCon nullSpecEnv
 \end{code}
 
 \begin{code}
 stateAndArrayPrimTyCon
-  = pcDataTyCon stateAndArrayPrimTyConKey gHC__ SLIT("StateAndArray#")
+  = pcDataTyCon stateAndArrayPrimTyConKey aRR_BASE SLIT("StateAndArray#")
 		alpha_beta_tyvars [stateAndArrayPrimDataCon]
 stateAndArrayPrimDataCon
-  = pcDataCon stateAndArrayPrimDataConKey gHC__ SLIT("StateAndArray#")
+  = pcDataCon stateAndArrayPrimDataConKey aRR_BASE SLIT("StateAndArray#")
 		alpha_beta_tyvars [] [mkStatePrimTy alphaTy, mkArrayPrimTy betaTy]
 		stateAndArrayPrimTyCon nullSpecEnv
 
 stateAndMutableArrayPrimTyCon
-  = pcDataTyCon stateAndMutableArrayPrimTyConKey gHC__ SLIT("StateAndMutableArray#")
+  = pcDataTyCon stateAndMutableArrayPrimTyConKey aRR_BASE SLIT("StateAndMutableArray#")
 		alpha_beta_tyvars [stateAndMutableArrayPrimDataCon]
 stateAndMutableArrayPrimDataCon
-  = pcDataCon stateAndMutableArrayPrimDataConKey gHC__ SLIT("StateAndMutableArray#")
+  = pcDataCon stateAndMutableArrayPrimDataConKey aRR_BASE SLIT("StateAndMutableArray#")
 		alpha_beta_tyvars [] [mkStatePrimTy alphaTy, mkMutableArrayPrimTy alphaTy betaTy]
 		stateAndMutableArrayPrimTyCon nullSpecEnv
 
 stateAndByteArrayPrimTyCon
-  = pcDataTyCon stateAndByteArrayPrimTyConKey gHC__ SLIT("StateAndByteArray#")
+  = pcDataTyCon stateAndByteArrayPrimTyConKey aRR_BASE SLIT("StateAndByteArray#")
 		alpha_tyvar [stateAndByteArrayPrimDataCon]
 stateAndByteArrayPrimDataCon
-  = pcDataCon stateAndByteArrayPrimDataConKey gHC__ SLIT("StateAndByteArray#")
+  = pcDataCon stateAndByteArrayPrimDataConKey aRR_BASE SLIT("StateAndByteArray#")
 		alpha_tyvar [] [mkStatePrimTy alphaTy, byteArrayPrimTy]
 		stateAndByteArrayPrimTyCon nullSpecEnv
 
 stateAndMutableByteArrayPrimTyCon
-  = pcDataTyCon stateAndMutableByteArrayPrimTyConKey gHC__ SLIT("StateAndMutableByteArray#")
+  = pcDataTyCon stateAndMutableByteArrayPrimTyConKey aRR_BASE SLIT("StateAndMutableByteArray#")
 		alpha_tyvar [stateAndMutableByteArrayPrimDataCon]
 stateAndMutableByteArrayPrimDataCon
-  = pcDataCon stateAndMutableByteArrayPrimDataConKey gHC__ SLIT("StateAndMutableByteArray#")
+  = pcDataCon stateAndMutableByteArrayPrimDataConKey aRR_BASE SLIT("StateAndMutableByteArray#")
 		alpha_tyvar [] [mkStatePrimTy alphaTy, applyTyCon mutableByteArrayPrimTyCon alpha_ty]
 		stateAndMutableByteArrayPrimTyCon nullSpecEnv
 
 stateAndSynchVarPrimTyCon
-  = pcDataTyCon stateAndSynchVarPrimTyConKey gHC__ SLIT("StateAndSynchVar#")
+  = pcDataTyCon stateAndSynchVarPrimTyConKey cONC_BASE SLIT("StateAndSynchVar#")
 		alpha_beta_tyvars [stateAndSynchVarPrimDataCon]
 stateAndSynchVarPrimDataCon
-  = pcDataCon stateAndSynchVarPrimDataConKey gHC__ SLIT("StateAndSynchVar#")
+  = pcDataCon stateAndSynchVarPrimDataConKey cONC_BASE SLIT("StateAndSynchVar#")
 		alpha_beta_tyvars [] [mkStatePrimTy alphaTy, mkSynchVarPrimTy alphaTy betaTy]
 		stateAndSynchVarPrimTyCon nullSpecEnv
 \end{code}
@@ -446,9 +491,9 @@ This is really just an ordinary synonym, except it is ABSTRACT.
 \begin{code}
 mkStateTransformerTy s a = applyTyCon stTyCon [s, a]
 
-stTyCon = pcNewTyCon stTyConKey gHC__ SLIT("ST") alpha_beta_tyvars [stDataCon]
+stTyCon = pcNewTyCon stTyConKey sT_BASE SLIT("ST") alpha_beta_tyvars [stDataCon]
 
-stDataCon = pcDataCon stDataConKey gHC__ SLIT("ST")
+stDataCon = pcDataCon stDataConKey sT_BASE SLIT("ST")
 			alpha_beta_tyvars [] [ty] stTyCon nullSpecEnv
   where
     ty = mkFunTy (mkStateTy alphaTy) (mkTupleTy 2 [betaTy, mkStateTy alphaTy])
@@ -465,7 +510,7 @@ mkPrimIoTy a = mkStateTransformerTy realWorldTy a
 
 primIoTyCon
   = pcSynTyCon
-     primIoTyConKey gHC__ SLIT("PrimIO")
+     primIoTyConKey iO_BASE SLIT("PrimIO")
      (mkBoxedTypeKind `mkArrowKind` mkBoxedTypeKind)
      1 alpha_tyvar (mkPrimIoTy alphaTy)
 \end{code}
@@ -521,10 +566,10 @@ primitive counterpart.
 \begin{code}
 boolTy = mkTyConTy boolTyCon
 
-boolTyCon = pcDataTyCon boolTyConKey pRELUDE SLIT("Bool") [] [falseDataCon, trueDataCon]
+boolTyCon = pcDataTyCon boolTyConKey pREL_BASE SLIT("Bool") [] [falseDataCon, trueDataCon]
 
-falseDataCon = pcDataCon falseDataConKey pRELUDE SLIT("False") [] [] [] boolTyCon nullSpecEnv
-trueDataCon  = pcDataCon trueDataConKey	 pRELUDE SLIT("True")  [] [] [] boolTyCon nullSpecEnv
+falseDataCon = pcDataCon falseDataConKey pREL_BASE SLIT("False") [] [] [] boolTyCon nullSpecEnv
+trueDataCon  = pcDataCon trueDataConKey	 pREL_BASE SLIT("True")  [] [] [] boolTyCon nullSpecEnv
 \end{code}
 
 %************************************************************************
@@ -548,12 +593,12 @@ mkListTy ty = applyTyCon listTyCon [ty]
 
 alphaListTy = mkSigmaTy alpha_tyvar [] (applyTyCon listTyCon alpha_ty)
 
-listTyCon = pcDataTyCon listTyConKey pRELUDE SLIT("[]") 
+listTyCon = pcDataTyCon listTyConKey pREL_BASE SLIT("[]") 
 			alpha_tyvar [nilDataCon, consDataCon]
 
-nilDataCon  = pcDataCon nilDataConKey  pRELUDE SLIT("[]") alpha_tyvar [] [] listTyCon
+nilDataCon  = pcDataCon nilDataConKey  pREL_BASE SLIT("[]") alpha_tyvar [] [] listTyCon
 		(pcGenerateDataSpecs alphaListTy)
-consDataCon = pcDataCon consDataConKey pRELUDE SLIT(":")
+consDataCon = pcDataCon consDataConKey pREL_BASE SLIT(":")
 		alpha_tyvar [] [alphaTy, applyTyCon listTyCon alpha_ty] listTyCon
 		(pcGenerateDataSpecs alphaListTy)
 -- Interesting: polymorphic recursion would help here.
@@ -610,7 +655,7 @@ done by enumeration\srcloc{lib/prelude/InTup?.hs}.
 \begin{code}
 mkTupleTy :: Int -> [GenType t u] -> GenType t u
 
-mkTupleTy arity tys = applyTyCon (mkTupleTyCon arity) tys
+mkTupleTy arity tys = applyTyCon (tupleTyCon arity) tys
 
 unitTy    = mkTupleTy 0 []
 \end{code}
@@ -644,10 +689,10 @@ isLiftTy ty
 alphaLiftTy = mkSigmaTy alpha_tyvar [] (applyTyCon liftTyCon alpha_ty)
 
 liftTyCon
-  = pcDataTyCon liftTyConKey gHC__ SLIT("Lift") alpha_tyvar [liftDataCon]
+  = pcDataTyCon liftTyConKey pREL_BASE SLIT("Lift") alpha_tyvar [liftDataCon]
 
 liftDataCon
-  = pcDataCon liftDataConKey gHC__ SLIT("Lift")
+  = pcDataCon liftDataConKey pREL_BASE SLIT("Lift")
 		alpha_tyvar [] alpha_ty liftTyCon
 		((pcGenerateDataSpecs alphaLiftTy) `addOneToSpecEnv`
 		 (mkSpecInfo [Just realWorldStatePrimTy] 0 bottom))