[project @ 1996-05-06 11:01:29 by partain]

SLPJ 1.3 changes through 960505

18 files changed, 137 insertions, 55 deletions

diff --git a/ghc/compiler/absCSyn/CLabel.lhs b/ghc/compiler/absCSyn/CLabel.lhs
index a6df00937b..74d2144243 100644
--- a/ghc/compiler/absCSyn/CLabel.lhs
+++ b/ghc/compiler/absCSyn/CLabel.lhs
@@ -39,7 +39,10 @@ module CLabel (
 
 	needsCDecl, isReadOnly, isAsmTemp, externallyVisibleCLabel,
 
-	pprCLabel, pprCLabel_asm
+	pprCLabel
+#if ! OMIT_NATIVE_CODEGEN
+	, pprCLabel_asm
+#endif
 
 #ifdef GRAN
 	, isSlowEntryCCodeBlock
@@ -50,7 +53,9 @@ import Ubiq{-uitous-}
 import AbsCLoop		( CtrlReturnConvention(..),
 			  ctrlReturnConvAlg
 			)
+#if ! OMIT_NATIVE_CODEGEN
 import NcgLoop		( underscorePrefix, fmtAsmLbl )
+#endif
 
 import CStrings		( pp_cSEP )
 import Id		( externallyVisibleId, cmpId_withSpecDataCon,
@@ -314,7 +319,9 @@ duplicate declarations in generating C (see @labelSeenTE@ in
 
 \begin{code}
 -- specialised for PprAsm: saves lots of arg passing in NCG
+#if ! OMIT_NATIVE_CODEGEN
 pprCLabel_asm = pprCLabel (PprForAsm underscorePrefix fmtAsmLbl)
+#endif
 
 pprCLabel :: PprStyle -> CLabel -> Unpretty
 
diff --git a/ghc/compiler/codeGen/CgBindery.lhs b/ghc/compiler/codeGen/CgBindery.lhs
index 8c5814a7ad..534fa9499b 100644
--- a/ghc/compiler/codeGen/CgBindery.lhs
+++ b/ghc/compiler/codeGen/CgBindery.lhs
@@ -45,7 +45,9 @@ import Id		( idPrimRep, toplevelishId, isDataCon,
 			)
 import Maybes		( catMaybes )
 import Name		( isLocallyDefined )
+#ifdef DEBUG
 import PprAbsC		( pprAmode )
+#endif
 import PprStyle		( PprStyle(..) )
 import StgSyn		( StgArg(..), StgLiveVars(..), GenStgArg(..) )
 import Unpretty		( uppShow )
diff --git a/ghc/compiler/coreSyn/CoreSyn.lhs b/ghc/compiler/coreSyn/CoreSyn.lhs
index c816aa1881..49e66879a5 100644
--- a/ghc/compiler/coreSyn/CoreSyn.lhs
+++ b/ghc/compiler/coreSyn/CoreSyn.lhs
@@ -259,9 +259,9 @@ mkCoLetNoUnboxed bind@(NonRec binder rhs) body
 mkCoLetsNoUnboxed []    expr = expr
 mkCoLetsNoUnboxed binds expr = foldr mkCoLetNoUnboxed expr binds
 
---mkCoLetrecNoUnboxed :: [(Id, CoreExpr)]	-- bindings
---  	            -> CoreExpr		-- body
---		    -> CoreExpr 		-- result
+mkCoLetrecNoUnboxed :: [(GenId (GenType a b), GenCoreExpr (GenId (GenType a b)) c d e)]
+		    -> GenCoreExpr (GenId (GenType a b)) c d e
+		    -> GenCoreExpr (GenId (GenType a b)) c d e
 
 mkCoLetrecNoUnboxed []    body = body
 mkCoLetrecNoUnboxed binds body
diff --git a/ghc/compiler/deSugar/DsBinds.lhs b/ghc/compiler/deSugar/DsBinds.lhs
index 41813e44c5..a4d6dda09e 100644
--- a/ghc/compiler/deSugar/DsBinds.lhs
+++ b/ghc/compiler/deSugar/DsBinds.lhs
@@ -16,9 +16,12 @@ import Ubiq
 import DsLoop		-- break dsExpr-ish loop
 
 import HsSyn		-- lots of things
+			hiding ( collectBinders{-also in CoreSyn-} )
 import CoreSyn		-- lots of things
 import TcHsSyn		( TypecheckedHsBinds(..), TypecheckedHsExpr(..),
-			  TypecheckedBind(..), TypecheckedMonoBinds(..) )
+			  TypecheckedBind(..), TypecheckedMonoBinds(..),
+			  TypecheckedPat(..)
+			)
 import DsHsSyn		( collectTypedBinders, collectTypedPatBinders )
 
 import DsMonad
@@ -39,7 +42,7 @@ import Type		( mkTyVarTys, mkForAllTys, splitSigmaTy,
 import TyVar		( tyVarSetToList, GenTyVar{-instance Eq-} )
 import Util		( isIn, panic, pprTrace{-ToDo:rm-} )
 import PprCore--ToDo:rm
-import PprType--ToDo:rm
+import PprType		( GenTyVar ) --ToDo:rm
 import Usage--ToDo:rm
 import Unique--ToDo:rm
 
diff --git a/ghc/compiler/deSugar/DsExpr.lhs b/ghc/compiler/deSugar/DsExpr.lhs
index db63f50958..9030f94c34 100644
--- a/ghc/compiler/deSugar/DsExpr.lhs
+++ b/ghc/compiler/deSugar/DsExpr.lhs
@@ -14,7 +14,7 @@ import DsLoop		-- partly to get dsBinds, partly to chk dsExpr
 import HsSyn		( HsExpr(..), HsLit(..), ArithSeqInfo(..),
 			  Match, Qual, HsBinds, Stmt, PolyType )
 import TcHsSyn		( TypecheckedHsExpr(..), TypecheckedHsBinds(..),
-			  TypecheckedRecordBinds(..)
+			  TypecheckedRecordBinds(..), TypecheckedPat(..)
 			)
 import CoreSyn
 
@@ -22,7 +22,8 @@ import DsMonad
 import DsCCall		( dsCCall )
 import DsListComp	( dsListComp )
 import DsUtils		( mkAppDs, mkConDs, mkPrimDs, dsExprToAtom,
-			  mkErrorAppDs, showForErr
+			  mkErrorAppDs, showForErr, EquationInfo,
+			  MatchResult
 			)
 import Match		( matchWrapper )
 
@@ -38,6 +39,7 @@ import Id		( mkTupleCon, idType, nullIdEnv, addOneToIdEnv,
 			)
 import Literal		( mkMachInt, Literal(..) )
 import MagicUFs		( MagicUnfoldingFun )
+import Name		( Name{--O only-} )
 import PprStyle		( PprStyle(..) )
 import PprType		( GenType )
 import PrelInfo		( mkTupleTy, unitTy, nilDataCon, consDataCon,
diff --git a/ghc/compiler/deSugar/DsListComp.lhs b/ghc/compiler/deSugar/DsListComp.lhs
index 7b6651a14e..123a8f28f9 100644
--- a/ghc/compiler/deSugar/DsListComp.lhs
+++ b/ghc/compiler/deSugar/DsListComp.lhs
@@ -10,7 +10,7 @@ import Ubiq
 import DsLoop		-- break dsExpr-ish loop
 
 import HsSyn		( Qual(..), HsExpr, HsBinds )
-import TcHsSyn		( TypecheckedQual(..), TypecheckedHsExpr(..) )
+import TcHsSyn		( TypecheckedQual(..), TypecheckedHsExpr(..) , TypecheckedHsBinds(..) )
 import DsHsSyn		( outPatType )
 import CoreSyn
 
diff --git a/ghc/compiler/deSugar/Match.lhs b/ghc/compiler/deSugar/Match.lhs
index 5f1b90d4a2..5437929a7b 100644
--- a/ghc/compiler/deSugar/Match.lhs
+++ b/ghc/compiler/deSugar/Match.lhs
@@ -12,7 +12,7 @@ import Ubiq
 import DsLoop		-- here for paranoia-checking reasons
 			-- and to break dsExpr/dsBinds-ish loop
 
-import HsSyn
+import HsSyn		hiding ( collectBinders{-also from CoreSyn-} )
 import TcHsSyn		( TypecheckedPat(..), TypecheckedMatch(..),
 			  TypecheckedHsBinds(..), TypecheckedHsExpr(..)	)
 import DsHsSyn		( outPatType, collectTypedPatBinders )
diff --git a/ghc/compiler/deSugar/MatchLit.lhs b/ghc/compiler/deSugar/MatchLit.lhs
index 1ae29da52d..da0392e5c2 100644
--- a/ghc/compiler/deSugar/MatchLit.lhs
+++ b/ghc/compiler/deSugar/MatchLit.lhs
@@ -13,8 +13,10 @@ import DsLoop		-- break match-ish and dsExpr-ish loops
 
 import HsSyn		( HsLit(..), OutPat(..), HsExpr(..),
 			  Match, HsBinds, Stmt, Qual, PolyType, ArithSeqInfo )
-import TcHsSyn		( TypecheckedHsExpr(..) )
-import CoreSyn		( CoreExpr(..) )
+import TcHsSyn		( TypecheckedHsExpr(..), TypecheckedHsBinds(..),
+			  TypecheckedPat(..)
+			)
+import CoreSyn		( CoreExpr(..), CoreBinding(..) )
 
 import DsMonad
 import DsUtils
diff --git a/ghc/compiler/main/MkIface.lhs b/ghc/compiler/main/MkIface.lhs
index 489183777a..796d51d0cb 100644
--- a/ghc/compiler/main/MkIface.lhs
+++ b/ghc/compiler/main/MkIface.lhs
@@ -24,6 +24,7 @@ import Bag		( emptyBag, snocBag, bagToList )
 import Class		( GenClass(..){-instance NamedThing-}, GenClassOp(..) )
 import CmdLineOpts	( opt_ProduceHi )
 import FieldLabel	( FieldLabel{-instance NamedThing-} )
+import FiniteMap	( fmToList )
 import HsSyn
 import Id		( idType, dataConSig, dataConFieldLabels,
 			  dataConStrictMarks, StrictnessMark(..),
@@ -128,15 +129,34 @@ endIface (Just if_hdl)	= hPutStr if_hdl "\n" >> hClose if_hdl
 \begin{code}
 ifaceUsages Nothing{-no iface handle-} _ = return ()
 
-ifaceUsages (Just if_hdl) version_info
-  = hPutStr if_hdl "__usages__\nFoo 1" -- a stub, obviously
+ifaceUsages (Just if_hdl) usages
+  | null usages_list
+  = return ()
+  | otherwise
+  = hPutStr if_hdl "__usages__\n"   >>
+    hPutStr if_hdl (ppShow 10000 (ppAboves (map pp_uses usages_list)))
+  where
+    usages_list = fmToList usages
+
+    pp_uses (m, (mv, versions))
+      = ppBesides [ppPStr m, ppSP, ppInt mv, ppPStr SLIT(" :: "),
+	       pp_versions (fmToList versions), ppSemi]
 \end{code}
 
 \begin{code}
 ifaceVersions Nothing{-no iface handle-} _ = return ()
 
 ifaceVersions (Just if_hdl) version_info
-  = hPutStr if_hdl "\n__versions__\nFoo 1" -- a stub, obviously
+  | null version_list
+  = return ()
+  | otherwise
+  = hPutStr if_hdl "\n__versions__\n"	>>
+    hPutStr if_hdl (ppShow 10000 (pp_versions version_list))
+  where
+    version_list = fmToList version_info
+
+pp_versions nvs
+  = ppInterleave ppComma [ ppCat [ppPStr n, ppInt v] | (n,v) <- nvs ]
 \end{code}
 
 \begin{code}
diff --git a/ghc/compiler/reader/PrefixToHs.lhs b/ghc/compiler/reader/PrefixToHs.lhs
index 033ed415f3..c638ca2f52 100644
--- a/ghc/compiler/reader/PrefixToHs.lhs
+++ b/ghc/compiler/reader/PrefixToHs.lhs
@@ -28,7 +28,7 @@ import RdrHsSyn
 import HsPragmas	( noGenPragmas, noClassOpPragmas )
 
 import SrcLoc		( mkSrcLoc2 )
-import Util		( panic, assertPanic )
+import Util		( mapAndUnzip, panic, assertPanic )
 \end{code}
 
 %************************************************************************
@@ -154,7 +154,7 @@ cvFunMonoBind :: SrcFile -> [RdrMatch] -> (RdrName {-VarName-}, Bool {-InfixDefn
 cvFunMonoBind sf matches
   = (head srcfuns, head infixdefs, cvMatches sf False matches)
   where
-    (srcfuns, infixdefs) = unzip (map get_mdef matches)
+    (srcfuns, infixdefs) = mapAndUnzip get_mdef matches
     -- ToDo: Check for consistent srcfun and infixdef
 
     get_mdef (RdrMatch_NoGuard _ sfun pat _ _) = get_pdef pat
diff --git a/ghc/compiler/rename/ParseUtils.lhs b/ghc/compiler/rename/ParseUtils.lhs
index 3d40da13d2..d095ce9d43 100644
--- a/ghc/compiler/rename/ParseUtils.lhs
+++ b/ghc/compiler/rename/ParseUtils.lhs
@@ -228,7 +228,8 @@ mk_inst	ctxt clas mono_ty
 lexIface :: String -> [IfaceToken]
 
 lexIface str
-  = case str of
+  = _scc_ "Lexer"
+    case str of
       []    -> []
 
       -- whitespace and comments
diff --git a/ghc/compiler/rename/Rename.lhs b/ghc/compiler/rename/Rename.lhs
index c5d18119d6..780017a985 100644
--- a/ghc/compiler/rename/Rename.lhs
+++ b/ghc/compiler/rename/Rename.lhs
@@ -81,7 +81,7 @@ renameModule us input@(HsModule mod _ _ imports _ _ _ _ _ _ _ _ _ _)
     --				     ]}) $
 
     findHiFiles opt_HiDirList opt_SysHiDirList	    >>=	         \ hi_files ->
-    newVar (emptyFM, hi_files){-init iface cache-}  `thenPrimIO` \ iface_cache ->
+    newVar (emptyFM,emptyFM,hi_files){-init iface cache-}  `thenPrimIO` \ iface_cache ->
 
     fixIO ( \ ~(_, _, _, _, rec_occ_fm, rec_export_fn) ->
     let
@@ -196,7 +196,7 @@ renameModule us input@(HsModule mod _ _ imports _ _ _ _ _ _ _ _ _ _)
 
 \begin{code}
 {- TESTING:
-pprPIface (ParsedIface m v mv usgs lcm exm ims lfx ltdm lvdm lids ldp)
+pprPIface (ParsedIface m ?? v mv usgs lcm exm ims lfx ltdm lvdm lids ldp)
   = ppAboves [
 	ppCat [ppPStr SLIT("interface"), ppPStr m, ppInt v,
 	       case mv of { Nothing -> ppNil; Just n -> ppInt n }],
diff --git a/ghc/compiler/rename/RnExpr.lhs b/ghc/compiler/rename/RnExpr.lhs
index 805a1dc813..5f6790e117 100644
--- a/ghc/compiler/rename/RnExpr.lhs
+++ b/ghc/compiler/rename/RnExpr.lhs
@@ -28,10 +28,11 @@ import RnMonad
 import ErrUtils		( addErrLoc, addShortErrLocLine )
 import Name		( isLocallyDefinedName, pprSym, Name, RdrName )
 import Pretty
-import UniqFM		( lookupUFM )
+import UniqFM		( lookupUFM, ufmToList{-ToDo:rm-} )
 import UniqSet		( emptyUniqSet, unitUniqSet,
 			  unionUniqSets, unionManyUniqSets,
-			  UniqSet(..) )
+			  UniqSet(..)
+			)
 import Util		( Ord3(..), removeDups, panic )
 \end{code}
 
@@ -485,6 +486,7 @@ precParseExpr exp@(OpApp (NegApp e1 n) (HsVar op) e2)
 precParseExpr exp@(OpApp (OpApp e11 (HsVar op1) e12) (HsVar op) e2)
   = lookupFixity op		 `thenRn` \ (op_fix, op_prec) ->
     lookupFixity op1		 `thenRn` \ (op1_fix, op1_prec) ->
+    -- pprTrace "precParse:" (ppCat [ppr PprDebug op, ppInt op_prec, ppr PprDebug op1, ppInt op1_prec]) $
     case cmp op1_prec op_prec of
       LT_  -> rearrange
       EQ_  -> case (op1_fix, op_fix) of
@@ -534,6 +536,7 @@ data INFIX = INFIXL | INFIXR | INFIXN deriving Eq
 lookupFixity :: RnName -> RnM_Fixes s (INFIX, Int)
 lookupFixity op
   = getExtraRn `thenRn` \ fixity_fm ->
+    -- pprTrace "lookupFixity:" (ppAboves [ppCat [pprUnique u, ppr PprDebug i_f] | (u,i_f) <- ufmToList fixity_fm]) $
     case lookupUFM fixity_fm op of
       Nothing           -> returnRn (INFIXL, 9)
       Just (InfixL _ n) -> returnRn (INFIXL, n)
diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs
index 0f0949765c..97445c9c62 100644
--- a/ghc/compiler/rename/RnIfaces.lhs
+++ b/ghc/compiler/rename/RnIfaces.lhs
@@ -37,8 +37,9 @@ import Bag		( emptyBag, unitBag, consBag, snocBag,
 			  unionBags, unionManyBags, isEmptyBag, bagToList )
 import CmdLineOpts	( opt_HiSuffix, opt_SysHiSuffix )
 import ErrUtils		( Error(..), Warning(..) )
-import FiniteMap	( emptyFM, lookupFM, addToFM, addToFM_C, plusFM, plusFM_C, eltsFM,
-			  fmToList, delListFromFM, sizeFM, keysFM{-ToDo:rm-}
+import FiniteMap	( emptyFM, lookupFM, addToFM, addToFM_C, plusFM, eltsFM,
+			  fmToList, delListFromFM, sizeFM, foldFM, unitFM,
+			  plusFM_C, keysFM{-ToDo:rm-}
 			)
 import Maybes		( maybeToBool )
 import Name		( moduleNamePair, origName, isRdrLexCon, RdrName(..) )
@@ -77,9 +78,9 @@ absolute-filename-for-that-interface.
 findHiFiles :: [FilePath] -> [FilePath] -> IO (FiniteMap Module FilePath)
 
 findHiFiles dirs sysdirs
-  = hPutStr stderr "  findHiFiles "	>>
+  = --hPutStr stderr "  findHiFiles "	>>
     do_dirs emptyFM (dirs ++ sysdirs)	>>= \ result ->
-    hPutStr stderr " done\n"		>>
+    --hPutStr stderr " done\n"		>>
     return result
   where
     do_dirs env [] = return env
@@ -88,7 +89,7 @@ findHiFiles dirs sysdirs
 	do_dirs new_env dirs
     -------
     do_dir env dir
-      = hPutStr stderr "D" >>
+      = --hPutStr stderr "D" >>
 	getDirectoryContents dir    >>= \ entries ->
 	do_entries env entries
       where
@@ -100,7 +101,7 @@ findHiFiles dirs sysdirs
 	do_entry env e
 	  = case (acceptable_hi (reverse e)) of
 	      Nothing  -> --trace ("Deemed uncool:"++e) $
-			  hPutStr stderr "." >>
+			  --hPutStr stderr "." >>
 			  return env
 	      Just mod ->
 		let
@@ -108,12 +109,12 @@ findHiFiles dirs sysdirs
 		in
 		case (lookupFM env pmod) of
 		  Nothing -> --trace ("Adding "++mod++" -> "++e) $
-			     hPutStr stderr "!" >>
+			     --hPutStr stderr "!" >>
 			     return (addToFM env pmod (dir ++ '/':e))
 			     -- ToDo: use DIR_SEP, not /
 
 		  Just xx -> ( if de_dot xx /= e then trace ("Already mapped!! "++mod++" -> "++xx++"; ignoring:"++e) else id) $
-			     hPutStr stderr "." >>
+			     --hPutStr stderr "." >>
 			     return env
     -------
     acceptable_hi rev_e -- looking at pathname *backwards*
@@ -194,7 +195,7 @@ cachedIface want_orig_iface iface_cache mod
   where
     want_iface iface orig_fm 
       | want_orig_iface
-      = case lookupFM orig_fm of
+      = case lookupFM orig_fm mod of
 	  Nothing         -> Failed (noOrigIfaceErr mod)
           Just orig_iface -> Succeeded orig_iface
       | otherwise
@@ -224,7 +225,7 @@ mergeIfaces (ParsedIface mod1 (_, files1) _ _ _ _ _ _ fixes1 tdefs1 vdefs1 idefs
   where
     dup_merge str ppr_dup dup1 dup2
       = pprTrace "mergeIfaces:"
-	   	 (ppCat [ppPStr mod, ppPStr mod1, ppStr ": dup", ppStr str, ppStr "decl",
+	   	 (ppCat [ppPStr mod1, ppPStr mod2, ppStr ": dup", ppStr str, ppStr "decl",
 			 ppr_dup dup1, ppr_dup dup2]) $
         dup2
 
@@ -312,14 +313,18 @@ readIface :: FilePath -> Module
 	      -> IO (MaybeErr ParsedIface Error)
 
 readIface file mod
-  = hPutStr stderr ("  reading "++file)	>>
+  = --hPutStr stderr ("  reading "++file)	>>
     readFile file		`thenPrimIO` \ read_result ->
     case read_result of
       Left  err      -> return (Failed (cannaeReadErr file err))
-      Right contents -> hPutStr stderr " parsing"   >>
+      Right contents -> --hPutStr stderr " parsing"   >>
 			let parsed = parseIface contents in
-			hPutStr stderr " done\n"    >>
-			return (Succeeded (init_merge mod parsed))
+			--hPutStr stderr " done\n"    >>
+			return (
+			case parsed of
+			  Failed _    -> parsed
+			  Succeeded p -> Succeeded (init_merge mod p)
+			)
   where
     init_merge this (ParsedIface mod _ v sv us vs exps insts fixes tdefs vdefs idefs prags)
       =	ParsedIface mod (False, unitBag this) v sv us vs exps insts fixes tdefs vdefs idefs prags
@@ -374,7 +379,7 @@ rnIfaces iface_cache imp_mods us
 
     -- finalize what we want to say we learned about the
     -- things we used
-    finalIfaceInfo iface_cache if_final_env if_instdecls {-all_imports_used imp_mods-} >>=
+    finalIfaceInfo iface_cache modname if_final_env if_instdecls {-all_imports_used imp_mods-} >>=
 	\ usage_stuff@(usage_info, version_info, instance_mods) ->
 
     return (HsModule modname iface_version exports imports fixities
@@ -779,6 +784,7 @@ rnIfaceInst (InstSig _ _ _ inst_decl) = rnInstDecl inst_decl
 \begin{code}
 finalIfaceInfo ::
 	   IfaceCache			-- iface cache
+	-> Module			-- this module's name
 	-> RnEnv
 	-> [RenamedInstDecl]
 --	-> [RnName]			-- all imported names required
@@ -787,14 +793,47 @@ finalIfaceInfo ::
 	       VersionsMap,		-- info about version numbers
 	       [Module])		-- special instance modules
 
-finalIfaceInfo iface_cache if_final_env@((qual, unqual, tc_qual, tc_unqual), stack) if_instdecls
+finalIfaceInfo iface_cache modname if_final_env@((qual, unqual, tc_qual, tc_unqual), stack) if_instdecls
   =
     pprTrace "usageIf:qual:"      (ppCat [ppBesides[ppPStr m,ppChar '.',ppPStr n] | (n,m) <- keysFM qual]) $
 --  pprTrace "usageIf:unqual:"    (ppCat (map ppPStr (keysFM unqual))) $
     pprTrace "usageIf:tc_qual:"   (ppCat [ppBesides[ppPStr m,ppChar '.',ppPStr n] | (n,m) <- keysFM tc_qual]) $
 --  pprTrace "usageIf:tc_unqual:" (ppCat (map ppPStr (keysFM tc_unqual))) $
+    let
+	val_stuff@(val_usages, val_versions)
+	  = foldFM process_item (emptyFM, emptyFM){-init-} qual
 
-    return (emptyFM, emptyFM, [])
+	(all_usages, all_versions)
+	  = foldFM process_item val_stuff{-keep going-} tc_qual
+    in
+    return (all_usages, all_versions, [])
+  where
+    process_item :: (FAST_STRING,Module) -> RnName -- RnEnv (QualNames) components
+		 -> (UsagesMap, VersionsMap)	   -- input
+		 -> (UsagesMap, VersionsMap)	   -- output
+
+    process_item (n,m) rn as_before@(usages, versions)
+      | irrelevant rn
+      = as_before
+      | m == modname -- this module => add to "versions"
+      =	(usages, addToFM versions n 1{-stub-})
+      | otherwise  -- from another module => add to "usages"
+      = (add_to_usages usages m n 1{-stub-}, versions)
+
+    irrelevant (RnConstr  _ _) = True	-- We don't report these in their
+    irrelevant (RnField   _ _) = True	-- own right in usages/etc.
+    irrelevant (RnClassOp _ _) = True
+    irrelevant _	       = False
+
+    add_to_usages usages m n version
+      = addToFM usages m (
+	    case (lookupFM usages m) of
+	      Nothing -> -- nothing for this module yet...
+		(1{-stub-}, unitFM n version)
+
+	      Just (mversion, mstuff) -> -- the "new" stuff will shadow the old
+		(mversion, addToFM mstuff n version)
+	)
 \end{code}
 
 
diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
index e106696413..53d04e1d08 100644
--- a/ghc/compiler/rename/RnNames.lhs
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -289,7 +289,7 @@ newGlobalName locn maybe_exp rdr
 	       Just exp -> exp
 	       Nothing  -> exp_fn n
 
-	n = mkTopLevName uniq orig locn exp (occ_fn n)
+	n = mkTopLevName uniq orig locn exp (occ_fn n) -- NB: two "n"s
     in
     addWarnIfRn (rdr == Unqual SLIT("negate")) (negateNameWarn (rdr, locn)) `thenRn_`
     addErrIfRn (isQual rdr) (qualNameErr "name in definition" (rdr, locn)) `thenRn_`
@@ -363,6 +363,9 @@ doImportDecls iface_cache g_info us src_imps
 		     then [{- no "import Prelude" -}]
 	             else [ImportDecl pRELUDE False Nothing Nothing prel_loc]
 
+    prel_imps -- WDP: Just guessing on this defn... ToDo
+      = [ imp | imp@(ImportDecl mod _ _ _ _) <- the_imps, fromPrelude mod ]
+
     prel_loc = mkBuiltinSrcLoc
 
     (uniq_imps, imp_dups) = removeDups cmp_mod the_imps
@@ -431,15 +434,16 @@ doImport iface_cache info us (ImportDecl mod qual maybe_as maybe_spec src_loc)
 		>>= \ (ie_vals, ie_tcs, imp_flags, errs, warns) ->
 	accumulate (map (checkOrigIE iface_cache) chk_ies)
 		>>= \ chk_errs_warns ->
-	accumulate (map (getFixityDecl iface_cache) (bagToList ie_vals))
+	let
+	    final_vals = mapBag fst_occ b_vals `unionBags` mapBag pair_occ ie_vals
+	    final_tcs  = mapBag fst_occ b_tcs  `unionBags` mapBag pair_occ ie_tcs
+	in
+	accumulate (map (getFixityDecl iface_cache) (bagToList final_vals))
 		>>= \ fix_maybes_errs ->
 	let
 	    (chk_errs, chk_warns)  = unzip chk_errs_warns
 	    (fix_maybes, fix_errs) = unzip fix_maybes_errs
 
-	    final_vals = mapBag fst_occ b_vals `unionBags` mapBag pair_occ ie_vals
-	    final_tcs  = mapBag fst_occ b_tcs  `unionBags` mapBag pair_occ ie_tcs
-
 	    unquals    = if qual then emptyBag
 		         else mapBag pair_as (ie_vals `unionBags` ie_tcs)
 
@@ -511,16 +515,16 @@ getBuiltins (((b_val_names,b_tc_names),_,_,_),_,_,_) mod maybe_spec
         (vals, tcs, ies_left) = do_builtin ies
 
 
-getOrigIEs (ParsedIface _ _ _ _ _ exps _ _ _ _ _ _) Nothing		-- import all
+getOrigIEs (ParsedIface _ _ _ _ _ _ exps _ _ _ _ _ _) Nothing		-- import all
   = (map mkAllIE (eltsFM exps), [], emptyBag)
 
-getOrigIEs (ParsedIface _ _ _ _ _ exps _ _ _ _ _ _) (Just (True, ies))	-- import hiding
+getOrigIEs (ParsedIface _ _ _ _ _ _ exps _ _ _ _ _ _) (Just (True, ies))	-- import hiding
   = (map mkAllIE (eltsFM exps_left), found_ies, errs)
   where
     (found_ies, errs) = lookupIEs exps ies
     exps_left = delListFromFM exps (map (getLocalName.ie_name.fst) found_ies)
 
-getOrigIEs (ParsedIface _ _ _ _ _ exps _ _ _ _ _ _) (Just (False, ies))	-- import these
+getOrigIEs (ParsedIface _ _ _ _ _ _ exps _ _ _ _ _ _) (Just (False, ies))	-- import these
   = (map fst found_ies, found_ies, errs)
   where
     (found_ies, errs) = lookupIEs exps ies
@@ -617,7 +621,7 @@ with_decl iface_cache n do_err do_decl
       Succeeded decl -> return (do_decl decl)
 
 
-getFixityDecl iface_cache rn
+getFixityDecl iface_cache (_,rn)
   = let
 	(mod, str) = moduleNamePair rn
     in
@@ -625,7 +629,7 @@ getFixityDecl iface_cache rn
     case maybe_iface of
       Failed err ->
 	return (Nothing, unitBag err)
-      Succeeded (ParsedIface _ _ _ _ _ _ _ fixes _ _ _ _) ->
+      Succeeded (ParsedIface _ _ _ _ _ _ _ _ fixes _ _ _ _) ->
 	case lookupFM fixes str of
 	  Nothing 	    -> return (Nothing, emptyBag)
 	  Just (InfixL _ i) -> return (Just (InfixL rn i), emptyBag)
@@ -761,7 +765,7 @@ newImportedName tycon_or_class locn maybe_exp maybe_imp rdr
 
 	    (imp_flag, imp_locs) = imp_fn n
 
-	    n = mkImportedName uniq rdr imp locn imp_locs exp (occ_fn n)
+	    n = mkImportedName uniq rdr imp locn imp_locs exp (occ_fn n) -- NB: two "n"s
 	in
 	returnRn n
 \end{code}
diff --git a/ghc/compiler/simplCore/SimplCore.lhs b/ghc/compiler/simplCore/SimplCore.lhs
index dffde6b86d..a58f126ae8 100644
--- a/ghc/compiler/simplCore/SimplCore.lhs
+++ b/ghc/compiler/simplCore/SimplCore.lhs
@@ -89,8 +89,7 @@ core2core :: [CoreToDo]			-- spec of what core-to-core passes to do
 	      SpecialiseData)		--  specialisation data
 
 core2core core_todos module_name ppr_style us local_tycons tycon_specs binds
-  = _scc_ "Core2Core"
-    if null core_todos then -- very rare, I suspect...
+  = if null core_todos then -- very rare, I suspect...
 	-- well, we still must do some renumbering
 	return (
 	(substCoreBindings nullIdEnv nullTyVarEnv binds us,
diff --git a/ghc/compiler/simplStg/SimplStg.lhs b/ghc/compiler/simplStg/SimplStg.lhs
index 4335884ad2..f0aa84fa34 100644
--- a/ghc/compiler/simplStg/SimplStg.lhs
+++ b/ghc/compiler/simplStg/SimplStg.lhs
@@ -53,8 +53,7 @@ stg2stg :: [StgToDo]		-- spec of what stg-to-stg passes to do
 	      [CostCentre]))	-- "extern" cost-centres
 
 stg2stg stg_todos module_name ppr_style us binds
-  = _scc_ "Stg2Stg"
-    case (splitUniqSupply us)	of { (us4now, us4later) ->
+  = case (splitUniqSupply us)	of { (us4now, us4later) ->
 
     (if do_verbose_stg2stg then
 	hPutStr stderr "VERBOSE STG-TO-STG:\n" >>
diff --git a/ghc/compiler/utils/FiniteMap.lhs b/ghc/compiler/utils/FiniteMap.lhs
index 0b1e3d9f8b..384a7d122a 100644
--- a/ghc/compiler/utils/FiniteMap.lhs
+++ b/ghc/compiler/utils/FiniteMap.lhs
@@ -48,10 +48,11 @@ module FiniteMap (
 	plusFM,
 	plusFM_C,
 	minusFM,
+	foldFM,
 
 	IF_NOT_GHC(intersectFM COMMA)
 	IF_NOT_GHC(intersectFM_C COMMA)
-	IF_NOT_GHC(mapFM COMMA foldFM COMMA filterFM COMMA)
+	IF_NOT_GHC(mapFM COMMA filterFM COMMA)
 
 	sizeFM, isEmptyFM, elemFM, lookupFM, lookupWithDefaultFM,