[project @ 1996-04-10 16:55:54 by partain]

Sansom 1.3 changes through 960410

ghc/compiler/parser/hsparser.y

@@ -237,9 +237,7 @@ BOOLEAN inpat;
   		gdrhs gdpat valrhs
   		lampats	cexps
 
-%type <umaybe>  maybeexports impas maybeimpspec deriving
-
-%type <ueither> impspec  
+%type <umaybe>  maybeexports impspec deriving
 
 %type <uliteral> lit_constant
 
@@ -254,7 +252,7 @@ BOOLEAN inpat;
 		VARID CONID VARSYM CONSYM 
   		var con varop conop op
 		vark varid varsym varsym_nominus
-	        tycon modid impmod ccallid
+	        tycon modid ccallid
 
 %type <uqid>	QVARID QCONID QVARSYM QCONSYM 
 		qvarid qconid qvarsym qconsym
@@ -284,7 +282,7 @@ BOOLEAN inpat;
 
 %type <uentid>	  export import
 
-%type <ulong>     commas impqual
+%type <ulong>     commas
 
 /**********************************************************************
 *                                                                     *
@@ -380,32 +378,20 @@ impdecls:  impdecl				{ $$ = $1; }
 	;
 
 
-impdecl	:  importkey impqual impmod impas maybeimpspec
-		{ 
-		  $$ = lsing(mkimport($3,$2,$4,$5,startlineno));
-	        }
-	;
-
-impmod  : modid					{ $$ = $1; }
-	;
-
-impqual :  /* noqual */				{ $$ = 0; }
-	|  QUALIFIED 				{ $$ = 1; }
-	;
-
-impas   :  /* noas */				{ $$ = mknothing(); }
-	|  AS modid				{ $$ = mkjust($2);  }
-	;
-
-maybeimpspec :	/* empty */			{ $$ = mknothing(); }
-	|  impspec				{ $$ = mkjust($1);  }
+impdecl	:  importkey modid impspec
+		{ $$ = lsing(mkimport($2,0,mknothing(),$3,startlineno)); }
+	|  importkey QUALIFIED modid impspec
+		{ $$ = lsing(mkimport($3,1,mknothing(),$4,startlineno)); }
+	|  importkey QUALIFIED modid AS modid impspec
+		{ $$ = lsing(mkimport($3,1,mkjust($5),$6,startlineno)); }
 	;
 
-impspec	:  OPAREN CPAREN			  { $$ = mkleft(Lnil); }
-	|  OPAREN import_list CPAREN		  { $$ = mkleft($2);   }
-	|  OPAREN import_list COMMA CPAREN	  { $$ = mkleft($2);   }
-	|  HIDING OPAREN import_list CPAREN	  { $$ = mkright($3);  }
-	|  HIDING OPAREN import_list COMMA CPAREN { $$ = mkright($3);  }
+impspec	:  /* empty */				  { $$ = mknothing(); }
+	|  OPAREN CPAREN			  { $$ = mkjust(mkleft(Lnil)); }
+	|  OPAREN import_list CPAREN		  { $$ = mkjust(mkleft($2));   }
+	|  OPAREN import_list COMMA CPAREN	  { $$ = mkjust(mkleft($2));   }
+	|  HIDING OPAREN import_list CPAREN	  { $$ = mkjust(mkright($3));  }
+	|  HIDING OPAREN import_list COMMA CPAREN { $$ = mkjust(mkright($3));  }
   	;
 
 import_list:

ghc/compiler/rename/Rename.lhs

@@ -19,7 +19,7 @@ import RnHsSyn		( RnName, RenamedHsModule(..), isRnTyCon, isRnClass )
 import RnMonad
 import RnNames		( getGlobalNames, GlobalNameInfo(..) )
 import RnSource		( rnSource )
-import RnIfaces		( rnInterfaces, finalIfaceInfo, VersionInfo(..), ParsedIface )
+import RnIfaces		( findHiFiles, rnInterfaces, finalIfaceInfo, VersionInfo(..), ParsedIface )
 import RnUtils		( extendGlobalRnEnv, emptyRnEnv, multipleOccWarn )
 import MainMonad
 
@@ -32,8 +32,7 @@ import UniqFM		( emptyUFM, lookupUFM, addListToUFM_C, eltsUFM )
 import UniqSupply	( splitUniqSupply )
 import Util		( panic, assertPanic )
 
-findHiFiles :: PrimIO (FiniteMap Module FAST_STRING)
-findHiFiles = returnPrimIO emptyFM
+opt_HiDirList = panic "opt_HiDirList"
 \end{code}
 
 \begin{code}
@@ -63,7 +62,7 @@ ToDo: Deal with instances (instance version, this module on instance list ???)
 \begin{code}
 renameModule b_names b_keys us
    	     input@(HsModule mod _ _ imports _ _ _ _ _ _ _ _ _ _)
-  = findHiFiles			`thenPrimIO` \ hi_files ->
+  = findHiFiles opt_HiDirList	`thenPrimIO` \ hi_files ->
     newVar (emptyFM, hi_files)	`thenPrimIO` \ iface_var ->
 
     fixPrimIO ( \ ~(_, _, _, _, rec_occ_fm, rec_export_fn) ->
@@ -76,7 +75,7 @@ renameModule b_names b_keys us
 	global_name_info = (b_names, b_keys, rec_export_fn, rec_occ_fn)
     in
     getGlobalNames iface_var global_name_info us1 input
-		`thenPrimIO` \ (occ_env, imp_mods, imp_fixes, top_errs, top_warns) ->
+		`thenPrimIO` \ (occ_env, imp_mods, unqual_imps, imp_fixes, top_errs, top_warns) ->
 
     if not (isEmptyBag top_errs) then
 	returnPrimIO (rn_panic, rn_panic, top_errs, top_warns, emptyUFM, rn_panic)
@@ -84,7 +83,7 @@ renameModule b_names b_keys us
 
     -- No top-level name errors so rename source ...
     case initRn True mod occ_env us2
-		(rnSource imp_mods imp_fixes input) of {
+		(rnSource imp_mods unqual_imps imp_fixes input) of {
 	((rn_module, export_fn, src_occs), src_errs, src_warns) ->
 
     let

ghc/compiler/rename/RnBinds.lhs

@@ -20,14 +20,14 @@ module RnBinds (
    ) where
 
 import Ubiq
-import RnLoop		-- break the RnPass4/RnExpr4/RnBinds4 loops
+import RnLoop		-- break the RnPass/RnExpr/RnBinds loops
 
 import HsSyn
 import HsPragmas	( isNoGenPragmas, noGenPragmas )
 import RdrHsSyn
 import RnHsSyn
 import RnMonad
-import RnExpr		( rnMatch, rnGRHSsAndBinds, rnPat, checkPrecInfixBind )
+import RnExpr		( rnMatch, rnGRHSsAndBinds, rnPat, checkPrecMatch )
 
 import CmdLineOpts	( opt_SigsRequired )
 import Digraph		( stronglyConnComp )
@@ -172,10 +172,10 @@ rnMethodBinds class_name (AndMonoBinds mb1 mb2)
 		       (rnMethodBinds class_name mb2)
 
 rnMethodBinds class_name (FunMonoBind occname inf matches locn)
-  = pushSrcLocRn locn				$
-    lookupClassOp class_name occname  		`thenRn` \ op_name ->
-    mapAndUnzipRn rnMatch matches		`thenRn` \ (new_matches, _) ->
---  checkPrecInfixBind inf op_name new_matches 	`thenRn_`
+  = pushSrcLocRn locn				   $
+    lookupClassOp class_name occname  		   `thenRn` \ op_name ->
+    mapAndUnzipRn rnMatch matches		   `thenRn` \ (new_matches, _) ->
+    mapRn (checkPrecMatch inf op_name) new_matches `thenRn_`
     returnRn (FunMonoBind op_name inf new_matches locn)
 
 rnMethodBinds class_name (PatMonoBind (VarPatIn occname) grhss_and_binds locn)
@@ -348,10 +348,10 @@ flattenMonoBinds uniq sigs (PatMonoBind pat grhss_and_binds locn)
     )
 
 flattenMonoBinds uniq sigs (FunMonoBind name inf matches locn)
-  = pushSrcLocRn locn				$
-    lookupValue name				`thenRn` \ name' ->
-    mapAndUnzipRn rnMatch matches		`thenRn` \ (new_matches, fv_lists) ->
---  checkPrecInfixBind inf name' new_matches	`thenRn_`
+  = pushSrcLocRn locn				 $
+    lookupValue name				 `thenRn` \ name' ->
+    mapAndUnzipRn rnMatch matches		 `thenRn` \ (new_matches, fv_lists) ->
+    mapRn (checkPrecMatch inf name') new_matches `thenRn_`
     let
 	fvs = unionManyUniqSets fv_lists
 

ghc/compiler/rename/RnExpr.lhs

@@ -14,11 +14,11 @@ free variables.
 
 module RnExpr (
 	rnMatch, rnGRHSsAndBinds, rnPat,
-	checkPrecInfixBind
+	checkPrecMatch
    ) where
 
 import Ubiq
-import RnLoop		-- break the RnPass4/RnExpr4/RnBinds4 loops
+import RnLoop		-- break the RnPass/RnExpr/RnBinds loops
 
 import HsSyn
 import RdrHsSyn
@@ -498,13 +498,15 @@ lookupFixity op
 \end{code}
 
 \begin{code}
-checkPrecInfixBind :: Bool -> RnName -> [RenamedPat] -> RnM_Fixes s ()
+checkPrecMatch :: Bool -> RnName -> RenamedMatch -> RnM_Fixes s ()
 
-checkPrecInfixBind False fn pats
+checkPrecMatch False fn match
   = returnRn ()
-checkPrecInfixBind True op [p1,p2]
+checkPrecMatch True op (PatMatch p1 (PatMatch p2 (GRHSMatch _)))
   = checkPrec op p1 False	`thenRn_`
     checkPrec op p2 True
+checkPrecMatch True op _
+  = panic "checkPrecMatch"
 
 checkPrec op (ConOpPatIn _ op1 _) right
   = lookupFixity op	`thenRn` \ (op_fix, op_prec) ->
@@ -512,17 +514,15 @@ checkPrec op (ConOpPatIn _ op1 _) right
     getSrcLocRn 	`thenRn` \ src_loc ->
     let
 	inf_ok = op1_prec > op_prec || 
-	         op1_prec == op_prec &&
-		 (op1_fix == INFIXR && op_fix == INFIXR && right ||
-		  op1_fix == INFIXL && op_fix == INFIXL && not right)
+	         (op1_prec == op_prec &&
+		  (op1_fix == INFIXR && op_fix == INFIXR && right ||
+		   op1_fix == INFIXL && op_fix == INFIXL && not right))
 
 	info  = (op,op_fix,op_prec)
 	info1 = (op1,op1_fix,op1_prec)
 	(infol, infor) = if right then (info, info1) else (info1, info)
-
-	inf_err = precParseErr infol infor src_loc
     in
-    addErrIfRn (not inf_ok) inf_err
+    addErrIfRn (not inf_ok) (precParseErr infol infor src_loc)
 
 checkPrec op (NegPatIn _) right
   = lookupFixity op	`thenRn` \ (op_fix, op_prec) ->

ghc/compiler/rename/RnIfaces.lhs

@@ -7,6 +7,7 @@
 #include "HsVersions.h"
 
 module RnIfaces (
+	findHiFiles,
 	cacheInterface,
 	readInterface,
 	rnInterfaces,
@@ -40,11 +41,29 @@ import Util		( panic )
 
 \begin{code}
 type IfaceCache = MutableVar _RealWorld (FiniteMap Module ParsedIface,
-				         FiniteMap Module FAST_STRING)
+				         FiniteMap Module String)
 
 data ParsedIface = ParsedIface
+\end{code}
+
+*********************************************************
+*							*
+\subsection{Looking for interface files}
+*							*
+*********************************************************
+
+\begin{code}
+findHiFiles :: [String] -> PrimIO (FiniteMap Module String)
+findHiFiles dirs = returnPrimIO emptyFM
+\end{code}
 
+*********************************************************
+*							*
+\subsection{Reading interface files}
+*							*
+*********************************************************
 
+\begin{code}
 cacheInterface :: IfaceCache -> Module
 	       -> PrimIO (MaybeErr ParsedIface Error)
 
@@ -67,7 +86,7 @@ cacheInterface iface_var mod
 		returnPrimIO (Succeeded iface)
 
 
-readInterface :: FAST_STRING -> Module
+readInterface :: String -> Module
 	      -> PrimIO (MaybeErr ParsedIface Error)
 
 readInterface file mod = panic "readInterface"

ghc/compiler/rename/RnMonad.lhs

@@ -20,8 +20,8 @@ module RnMonad (
 	rnGetUnique, rnGetUniques,
 
 	newLocalNames,
-	lookupValue, lookupValueMaybe,
-	lookupTyCon, lookupClass, lookupClassOp,
+	lookupValue, lookupValueMaybe, lookupClassOp,
+	lookupTyCon, lookupClass, lookupTyConOrClass,
 	extendSS2, extendSS,
 
 	TyVarNamesEnv(..), mkTyVarNamesEnv, domTyVarNamesEnv,
@@ -371,6 +371,9 @@ lookupTyCon rdr
 lookupClass rdr
   = lookup_tc rdr isRnClass mkRnImplicitClass "class"
 
+lookupTyConOrClass rdr
+  = lookup_tc rdr (\ rn -> isRnTyCon rn || isRnClass rn)
+	      (panic "lookupTC:mk_implicit") "class or type constructor"
 
 lookup_tc rdr check mk_implicit err_str down@(RnDown _ _ locn (RnSource occ_var) env _ _)
   = case lookupTcRnEnv env rdr of

ghc/compiler/rename/RnNames.lhs

@@ -53,8 +53,9 @@ getGlobalNames ::
 	-> UniqSupply
 	-> RdrNameHsModule
 	-> PrimIO (RnEnv,
-		   [Module],
-		   Bag RenamedFixityDecl,
+		   [Module],				-- directly imported modules
+		   Bag (Module,(RnName,ExportFlag)),	-- unqualified imports from module
+		   Bag RenamedFixityDecl,		-- imported fixity decls
 		   Bag Error,
 		   Bag Warning)
 
@@ -66,7 +67,7 @@ getGlobalNames iface_var info us
     of { ((src_vals, src_tcs), src_errs, src_warns) ->
 
     getImportedNames iface_var info us2 imports	`thenPrimIO`
-	\ (imp_vals, imp_tcs, imp_mods, imp_fixes, imp_errs, imp_warns) ->
+	\ (imp_vals, imp_tcs, imp_mods, unqual_imps, imp_fixes, imp_errs, imp_warns) ->
 
     let
         unqual_vals = mapBag (\rn -> (Unqual (getLocalName rn), rn)) src_vals
@@ -84,7 +85,7 @@ getGlobalNames iface_var info us
 	all_errs  = src_errs `unionBags` imp_errs `unionBags` listToBag dup_errs
 	all_warns = src_warns `unionBags` imp_warns
     in
-    returnPrimIO (all_env, bagToList imp_mods, imp_fixes, all_errs, all_warns)
+    returnPrimIO (all_env, bagToList imp_mods, unqual_imps, imp_fixes, all_errs, all_warns)
     }
   where
     (us1, us2) = splitUniqSupply us
@@ -266,18 +267,19 @@ newGlobalName locn maybe_exp rdr
 \begin{code}
 getImportedNames ::
 	   IfaceCache
-	-> GlobalNameInfo			-- builtin and knot name info
+	-> GlobalNameInfo				-- builtin and knot name info
 	-> UniqSupply
-	-> [RdrNameImportDecl]			-- import declarations
-	-> PrimIO (Bag (RdrName,RnName),	-- imported values in scope
-		   Bag (RdrName,RnName),	-- imported tycons/classes in scope
-		   Bag Module,			-- directly imported modules
-		   Bag RenamedFixityDecl,	-- fixity info for imported names
+	-> [RdrNameImportDecl]				-- import declarations
+	-> PrimIO (Bag (RdrName,RnName),		-- imported values in scope
+		   Bag (RdrName,RnName),		-- imported tycons/classes in scope
+		   Bag Module,				-- directly imported modules
+		   Bag (Module,(RnName,ExportFlag)),	-- unqualified imports from module
+		   Bag RenamedFixityDecl,		-- fixity info for imported names
 		   Bag Error,
 		   Bag Warning)
 
 getImportedNames iface_var info us imports 
-  = returnPrimIO (builtin_vals, builtin_tcs, emptyBag, emptyBag, emptyBag, emptyBag)
+  = returnPrimIO (builtin_vals, builtin_tcs, emptyBag, emptyBag, emptyBag, emptyBag, emptyBag)
   where
     -- For now jsut add the builtin names ...
     (b_names,_,_,_) = info

ghc/compiler/rename/RnSource.lhs

@@ -9,7 +9,7 @@
 module RnSource ( rnSource, rnPolyType ) where
 
 import Ubiq
-import RnLoop		-- *check* the RnPass4/RnExpr4/RnBinds4 loop-breaking
+import RnLoop		-- *check* the RnPass/RnExpr/RnBinds loop-breaking
 
 import HsSyn
 import HsPragmas
@@ -18,20 +18,18 @@ import RnHsSyn
 import RnMonad
 import RnBinds		( rnTopBinds, rnMethodBinds )
 
-import Bag		( bagToList )
+import Bag		( emptyBag, unitBag, consBag, unionManyBags, listToBag, bagToList )
 import Class		( derivableClassKeys )
 import ListSetOps	( unionLists, minusList )
 import Maybes		( maybeToBool, catMaybes )
-import Name		( isLocallyDefined, isAvarid, getLocalName, ExportFlag(..), RdrName )
+import Name		( Name, isLocallyDefined, isAvarid, getLocalName, ExportFlag(..), RdrName )
 import Pretty
 import SrcLoc		( SrcLoc )
 import Unique		( Unique )
 import UniqFM		( addListToUFM, listToUFM )
 import UniqSet		( UniqSet(..) )
-import Util		( isn'tIn, panic, assertPanic )
+import Util		( isIn, isn'tIn, sortLt, panic, assertPanic )
 
-rnExports mods Nothing     = returnRn (\n -> ExportAll)
-rnExports mods (Just exps) = returnRn (\n -> ExportAll)
 \end{code}
 
 rnSource `renames' the source module and export list.
@@ -49,22 +47,24 @@ Checks the (..) etc constraints in the export list.
 
 
 \begin{code}
-rnSource :: [Module]				-- imported modules
+rnSource :: [Module]
+         -> Bag (Module,(RnName,ExportFlag))	-- unqualified imports from module
 	 -> Bag RenamedFixityDecl		-- fixity info for imported names
 	 -> RdrNameHsModule
 	 -> RnM s (RenamedHsModule,
 		   Name -> ExportFlag,		-- export info
 		   Bag (RnName, RdrName))	-- occurrence info
 
-rnSource imp_mods imp_fixes (HsModule mod version exports _ fixes
-	                       ty_decls specdata_sigs class_decls
-	                       inst_decls specinst_sigs defaults
-	                       binds _ src_loc)
+rnSource imp_mods unqual_imps imp_fixes
+	(HsModule mod version exports _ fixes
+	   ty_decls specdata_sigs class_decls
+	   inst_decls specinst_sigs defaults
+	   binds _ src_loc)
 
   = pushSrcLocRn src_loc $
 
-    rnExports (mod:imp_mods) exports	`thenRn` \ exported_fn ->
-    rnFixes fixes			`thenRn` \ src_fixes ->
+    rnExports (mod:imp_mods) unqual_imps exports	`thenRn` \ exported_fn ->
+    rnFixes fixes					`thenRn` \ src_fixes ->
     let
 	pair_name inf@(InfixL n _) = (n, inf)
 	pair_name inf@(InfixR n _) = (n, inf)
@@ -99,6 +99,108 @@ rnSource imp_mods imp_fixes (HsModule mod version exports _ fixes
     trashed_imports = trace "rnSource:trashed_imports" []
 \end{code}
 
+
+%*********************************************************
+%*							*
+\subsection{Export list}
+%*							*
+%*********************************************************
+
+\begin{code}
+rnExports :: [Module]
+	  -> Bag (Module,(RnName,ExportFlag))
+	  -> Maybe [RdrNameIE]
+	  -> RnM s (Name -> ExportFlag)
+
+rnExports mods unqual_imps Nothing
+  = returnRn (\n -> if isLocallyDefined n then ExportAll else NotExported)
+
+rnExports mods unqual_imps (Just exps)
+  = mapAndUnzipRn (rnIE mods) exps `thenRn` \ (mod_maybes, exp_bags) ->
+    let 
+        exp_mods  = catMaybes mod_maybes
+        exp_names = unionManyBags exp_bags
+
+	-- check for duplicate names
+	-- check for duplicate modules
+
+	-- check for duplicate local names
+	-- add in module contents checking for duplicate local names
+
+	-- build export flag lookup function
+	exp_fn n = if isLocallyDefined n then ExportAll else NotExported
+    in
+    returnRn exp_fn
+
+rnIE mods (IEVar name)
+  = lookupValue name	`thenRn` \ rn ->
+    checkIEVar rn	`thenRn` \ exps ->
+    returnRn (Nothing, exps)
+  where
+    checkIEVar (RnName n)         = returnRn (unitBag (n,ExportAbs))
+    checkIEVar (RnUnbound _)      = returnRn emptyBag
+    checkIEVar rn@(RnClassOp _ _) = getSrcLocRn `thenRn` \ src_loc ->
+			            failButContinueRn emptyBag (classOpExportErr rn src_loc)
+    checkIEVar rn                 = panic "checkIEVar"
+
+rnIE mods (IEThingAbs name)
+  = lookupTyConOrClass name	`thenRn` \ rn ->
+    checkIEAbs rn		`thenRn` \ exps ->
+    returnRn (Nothing, exps)
+  where
+    checkIEAbs (RnSyn n)     = returnRn (unitBag (n,ExportAbs))
+    checkIEAbs (RnData n _)  = returnRn (unitBag (n,ExportAbs))
+    checkIEAbs (RnClass n _) = returnRn (unitBag (n,ExportAbs))
+    checkIEAbs (RnUnbound _) = returnRn emptyBag
+    checkIEAbs rn            = panic "checkIEAbs"
+
+rnIE mods (IEThingAll name)
+  = lookupTyConOrClass name	`thenRn` \ rn ->
+    checkIEAll rn		`thenRn` \ exps ->
+    returnRn (Nothing, exps)
+  where
+    checkIEAll (RnData n cons) = returnRn (consBag (exp_all n) (listToBag (map exp_all cons)))
+    checkIEAll (RnClass n ops) = returnRn (consBag (exp_all n) (listToBag (map exp_all ops)))
+    checkIEAll (RnUnbound _)   = returnRn emptyBag
+    checkIEAll rn@(RnSyn _)    = getSrcLocRn `thenRn` \ src_loc ->
+			         warnAndContinueRn emptyBag (synAllExportErr rn src_loc)
+    checkIEAll rn              = panic "checkIEAll"
+
+    exp_all n = (n, ExportAll)
+
+rnIE mods (IEThingWith name names)
+  = lookupTyConOrClass name	`thenRn` \ rn ->
+    mapRn lookupValue names	`thenRn` \ rns ->
+    checkIEWith rn rns		`thenRn` \ exps ->
+    returnRn (Nothing, exps)
+  where
+    checkIEWith rn@(RnData n cons) rns
+		 | same_names cons rns = returnRn (consBag (exp_all n) (listToBag (map exp_all cons)))
+		 | otherwise 	       = rnWithErr "constructrs" rn cons rns 
+    checkIEWith rn@(RnClass n ops) rns
+		 | same_names ops rns  = returnRn (consBag (exp_all n) (listToBag (map exp_all ops)))
+		 | otherwise 	       = rnWithErr "class ops" rn ops rns
+    checkIEWith (RnUnbound _)      rns = returnRn emptyBag
+    checkIEWith rn@(RnSyn _)       rns = getSrcLocRn `thenRn` \ src_loc ->
+			                 failButContinueRn emptyBag (synAllExportErr rn src_loc)
+    checkIEWith rn                 rns = panic "checkIEWith"
+
+    exp_all n = (n, ExportAll)
+
+    same_names has rns
+      = all (not.isRnUnbound) rns &&
+	sortLt (<) (map uniqueOf has) == sortLt (<) (map uniqueOf rns)
+
+    rnWithErr str rn has rns
+      = getSrcLocRn `thenRn` \ src_loc ->
+	failButContinueRn emptyBag (withExportErr str rn has rns src_loc)
+
+rnIE mods (IEModuleContents mod)
+  | isIn "IEModule" mod mods = returnRn (Just mod, emptyBag)
+  | otherwise                = getSrcLocRn `thenRn` \ src_loc ->
+			       failButContinueRn (Nothing,emptyBag) (badModExportErr mod src_loc)
+\end{code}
+
 %*********************************************************
 %*							*
 \subsection{Type declarations}
@@ -492,17 +594,34 @@ rnContext tv_env ctxt
 
 
 \begin{code}
+classOpExportErr op locn sty 
+  = ppHang (ppStr "Class operation can only be exported with class:")
+         4 (ppCat [ppr sty op, ppr sty locn])
+
+synAllExportErr syn locn sty
+  = ppHang (ppStr "Type synonym should be exported abstractly:")
+         4 (ppCat [ppr sty syn, ppr sty locn])
+
+withExportErr str rn has rns locn sty
+  = ppHang (ppBesides [ppStr "Inconsistent list of ", ppStr str, ppStr ": ", ppr sty locn])
+         4 (ppAbove (ppCat [ppStr "expected:", ppInterleave ppComma (map (ppr sty) has)])
+		    (ppCat [ppStr "found:   ", ppInterleave ppComma (map (ppr sty) rns)]))
+
+badModExportErr mod locn sty
+  = ppHang (ppStr "Unknown module in export list:")
+         4 (ppCat [ppStr "module", ppPStr mod, ppr sty locn])
+
 derivingNonStdClassErr clas locn sty
-  = ppHang (ppStr "Non-standard class in deriving")
+  = ppHang (ppStr "Non-standard class in deriving:")
          4 (ppCat [ppr sty clas, ppr sty locn])
 
 dupDefaultDeclErr defs sty
-  = ppHang (ppStr "Duplicate default declarations")
+  = ppHang (ppStr "Duplicate default declarations:")
          4 (ppAboves (map pp_def_loc defs))
   where
     pp_def_loc (DefaultDecl _ src_loc) = ppr sty src_loc
 
 undefinedFixityDeclErr decl sty
-  = ppHang (ppStr "Fixity declaration for unknown operator")
+  = ppHang (ppStr "Fixity declaration for unknown operator:")
 	 4 (ppr sty decl)
 \end{code}

ghc/compiler/rename/RnUtils.lhs

@@ -86,7 +86,7 @@ emptyRnEnv
 
 extendGlobalRnEnv ((qual, unqual, tc_qual, tc_unqual), stack) val_list tc_list
   = ASSERT(isEmptyFM stack)
-    (((qual', unqual', tc_qual, tc_unqual), stack), tc_dups `unionBags` dups)
+    (((qual', unqual', tc_qual', tc_unqual'), stack), tc_dups `unionBags` dups)
   where
     (qual', unqual', dups)          = extend_global qual unqual val_list
     (tc_qual', tc_unqual', tc_dups) = extend_global tc_qual tc_unqual tc_list