Rename.lhs 28 KB
Newer Older
1 2 3 4 5 6
%
% (c) The GRASP Project, Glasgow University, 1992-1998
%
\section[Rename]{Renaming and dependency analysis passes}

\begin{code}
7
module Rename ( renameModule, closeIfaceDecls, checkOldIface ) where
8 9 10 11

#include "HsVersions.h"

import HsSyn
12
import RdrHsSyn		( RdrNameHsModule, RdrNameHsDecl, RdrNameDeprecation, 
13
			  RdrNameTyClDecl, RdrNameRuleDecl, RdrNameInstDecl, RdrNameImportDecl
14 15
			)
import RnHsSyn		( RenamedHsDecl, RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl,
16
			  extractHsTyNames, 
17
			  instDeclFVs, tyClDeclFVs, ruleDeclFVs
18 19
			)

20
import CmdLineOpts	( DynFlags, DynFlag(..), dopt )
21 22
import RnMonad
import RnNames		( getGlobalNames )
23
import RnSource		( rnSourceDecls, rnTyClDecl, rnIfaceRuleDecl, rnInstDecl )
24
import RnIfaces		( slurpImpDecls, mkImportInfo, 
25
			  getInterfaceExports, closeDecls,
26
			  RecompileRequired, outOfDate, recompileRequired
27
			)
28 29
import RnHiFiles	( readIface, removeContext, 
			  loadExports, loadFixDecls, loadDeprecs )
30
import RnEnv		( availsToNameSet,
31
			  emptyAvailEnv, unitAvailEnv, availEnvElts, plusAvailEnv, groupAvails,
32
			  warnUnusedImports, warnUnusedLocalBinds, warnUnusedModules,
33
			  lookupOrigNames, lookupSrcName, newGlobalName
34
			)
35
import Module           ( Module, ModuleName, WhereFrom(..),
36 37
			  moduleNameUserString, moduleName,
			  mkModuleInThisPackage, mkModuleName, moduleEnvElts
38
			)
39 40
import Name		( Name, NamedThing(..), getSrcLoc,
			  nameIsLocalOrFrom,
41
			  nameOccName, nameModule,
42
			)
43
import Name		( mkNameEnv, nameEnvElts, extendNameEnv )
44
import RdrName		( elemRdrEnv, foldRdrEnv, isQual )
45
import OccName		( occNameFlavour )
46
import NameSet
47
import TysWiredIn	( unitTyCon, intTyCon, boolTyCon )
48
import PrelNames	( mAIN_Name, pREL_MAIN_Name, pRELUDE_Name,
49
			  ioTyCon_RDR, main_RDR,
50 51
			  unpackCString_RDR, unpackCStringFoldr_RDR, unpackCStringUtf8_RDR,
			  eqString_RDR
52
			)
53 54
import PrelInfo		( derivingOccurrences )
import Type		( funTyCon )
55 56
import ErrUtils		( dumpIfSet )
import Bag		( bagToList )
57
import FiniteMap	( FiniteMap, fmToList, emptyFM, lookupFM, 
58 59
			  addToFM_C, elemFM, addToFM
			)
60
import UniqFM		( lookupUFM )
61
import Maybes		( maybeToBool, catMaybes )
62
import Outputable
63
import IO		( openFile, IOMode(..) )
64
import HscTypes		( PersistentCompilerState, HomeIfaceTable, HomeSymbolTable, 
65
			  ModIface(..), WhatsImported(..), 
66 67
			  VersionInfo(..), ImportVersion, 
			  IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
68
			  GlobalRdrEnv, AvailEnv, GenAvailInfo(..), AvailInfo, 
69
			  Provenance(..), ImportReason(..), initialVersionInfo,
70
			  Deprecations(..), lookupDeprec, lookupIface
71
			 )
72
import List		( partition, nub )
73 74 75 76
\end{code}



77 78 79 80 81 82
%*********************************************************
%*						 	 *
\subsection{The main function: rename}
%*							 *
%*********************************************************

83
\begin{code}
84
renameModule :: DynFlags
85 86 87
	     -> HomeIfaceTable -> HomeSymbolTable
	     -> PersistentCompilerState 
	     -> Module -> RdrNameHsModule 
88
	     -> IO (PersistentCompilerState, Maybe (ModIface, [RenamedHsDecl]))
89
	-- Nothing => some error occurred in the renamer
90

91
renameModule dflags hit hst old_pcs this_module rdr_module
92
  = 	-- Initialise the renamer monad
93
    do {
94
	(new_pcs, errors_found, maybe_rn_stuff) 
95
	   <- initRn dflags hit hst old_pcs this_module (rename this_module rdr_module) ;
96

97
	-- Return results.  No harm in updating the PCS
98
	if errors_found then
99
	    return (new_pcs, Nothing)
100
        else
101
	    return (new_pcs, maybe_rn_stuff)
102
    }
103 104 105
\end{code}

\begin{code}
106
rename :: Module -> RdrNameHsModule -> RnMG (Maybe (ModIface, [RenamedHsDecl]))
107 108
rename this_module contents@(HsModule _ _ _ imports local_decls mod_deprec loc)
  = pushSrcLocRn loc		$
109

110 111 112
 	-- FIND THE GLOBAL NAME ENVIRONMENT
    getGlobalNames this_module contents 	`thenRn` \ (gbl_env, local_gbl_env, 
							    export_avails, global_avail_env) ->
113

114 115 116 117 118 119 120 121
	-- Exit if we've found any errors
    checkErrsRn				`thenRn` \ no_errs_so_far ->
    if not no_errs_so_far then
	-- Found errors already, so exit now
	rnDump [] []		`thenRn_`
	returnRn Nothing 
    else
	
122
	-- DEAL WITH DEPRECATIONS
123 124
    rnDeprecs local_gbl_env mod_deprec 
	      [d | DeprecD d <- local_decls]		`thenRn` \ my_deprecs ->
125 126 127

	-- DEAL WITH LOCAL FIXITIES
    fixitiesFromLocalDecls local_gbl_env local_decls	`thenRn` \ local_fixity_env ->
128 129

	-- RENAME THE SOURCE
130
    initRnMS gbl_env local_fixity_env SourceMode (
131 132 133
	rnSourceDecls local_decls
    )					`thenRn` \ (rn_local_decls, source_fvs) ->

134 135 136
	-- CHECK THAT main IS DEFINED, IF REQUIRED
    checkMain this_module local_gbl_env		`thenRn_`

137
	-- SLURP IN ALL THE NEEDED DECLARATIONS
138
    implicitFVs mod_name rn_local_decls 	`thenRn` \ implicit_fvs -> 
139
    let
140
	slurp_fvs	= implicit_fvs `plusFV` source_fvs
141 142 143
		-- It's important to do the "plus" this way round, so that
		-- when compiling the prelude, locally-defined (), Bool, etc
		-- override the implicit ones. 
144
    in
145
    traceRn (text "Source FVs:" <+> fsep (map ppr (nameSetToList slurp_fvs)))	`thenRn_`
146
    slurpImpDecls slurp_fvs		`thenRn` \ rn_imp_decls ->
147 148

	-- EXIT IF ERRORS FOUND
149
    rnDump rn_imp_decls rn_local_decls		`thenRn_` 
150
    checkErrsRn					`thenRn` \ no_errs_so_far ->
151 152
    if not no_errs_so_far then
	-- Found errors already, so exit now
153
	returnRn Nothing
154 155 156
    else

	-- GENERATE THE VERSION/USAGE INFO
157
    mkImportInfo mod_name imports 			`thenRn` \ my_usages ->
158

159
	-- BUILD THE MODULE INTERFACE
160
    let
161 162 163 164 165
	-- We record fixities even for things that aren't exported,
	-- so that we can change into the context of this moodule easily
	fixities = mkNameEnv [ (name, fixity)
			     | FixitySig name fixity loc <- nameEnvElts local_fixity_env
			     ]
166

167
	-- Sort the exports to make them easier to compare for versions
168
	my_exports = groupAvails this_module export_avails
169
	
170 171 172
	final_decls = rn_local_decls ++ rn_imp_decls
	is_orphan   = any (isOrphanDecl this_module) rn_local_decls

173
	mod_iface = ModIface {	mi_module   = this_module,
174
				mi_version  = initialVersionInfo,
175
				mi_usages = my_usages,
176
				mi_boot	    = False,
177
				mi_orphan   = is_orphan,
178
				mi_exports  = my_exports,
179 180
				mi_globals  = gbl_env,
				mi_fixities = fixities,
181
				mi_deprecs  = my_deprecs,
182
				mi_decls    = panic "mi_decls"
183
		    }
184 185 186 187 188 189 190 191

		-- The export_fvs make the exported names look just as if they
		-- occurred in the source program.  
		-- We only need the 'parent name' of the avail;
		-- that's enough to suck in the declaration.
	export_fvs = availsToNameSet export_avails
	used_vars  = source_fvs `plusFV` export_fvs

192
    in
193

194
	-- REPORT UNUSED NAMES, AND DEBUG DUMP 
195
    reportUnusedNames mod_iface imports global_avail_env
196
		      used_vars rn_imp_decls 			`thenRn_`
197

198
    returnRn (Just (mod_iface, final_decls))
199 200 201 202 203 204 205 206 207 208 209 210 211
  where
    mod_name = moduleName this_module
\end{code}

Checking that main is defined

\begin{code}
checkMain :: Module -> GlobalRdrEnv -> RnMG ()
checkMain this_mod local_env
  | moduleName this_mod == mAIN_Name 
  = checkRn (main_RDR `elemRdrEnv` local_env) noMainErr
  | otherwise
  = returnRn ()
212 213 214 215 216 217
\end{code}

@implicitFVs@ forces the renamer to slurp in some things which aren't
mentioned explicitly, but which might be needed by the type checker.

\begin{code}
218
implicitFVs mod_name decls
219
  = lookupOrigNames implicit_occs			`thenRn` \ implicit_names ->
220 221
    returnRn (mkNameSet (map getName default_tycons)	`plusFV`
	      implicit_names)
222
  where
223
 	-- Add occurrences for Int, and (), because they
224 225 226 227 228 229
	-- are the types to which ambigious type variables may be defaulted by
	-- the type checker; so they won't always appear explicitly.
	-- [The () one is a GHC extension for defaulting CCall results.]
	-- ALSO: funTyCon, since it occurs implicitly everywhere!
	--  	 (we don't want to be bothered with making funTyCon a
	--	  free var at every function application!)
230 231
	-- Double is dealt with separately in getGates
    default_tycons = [unitTyCon, funTyCon, boolTyCon, intTyCon]
232 233 234

	-- Add occurrences for IO or PrimIO
    implicit_main |  mod_name == mAIN_Name
235 236
		  || mod_name == pREL_MAIN_Name = [ioTyCon_RDR]
		  |  otherwise 		        = []
237 238 239 240

	-- Now add extra "occurrences" for things that
	-- the deriving mechanism, or defaulting, will later need in order to
	-- generate code
241 242 243
    implicit_occs = string_occs ++ foldr ((++) . get) implicit_main decls

	-- Virtually every program has error messages in it somewhere
244 245
    string_occs = [unpackCString_RDR, unpackCStringFoldr_RDR, 
		   unpackCStringUtf8_RDR, eqString_RDR]
246

247
    get (TyClD (TyData _ _ _ _ _ _ (Just deriv_classes) _ _ _))
248 249 250 251 252 253
       = concat (map get_deriv deriv_classes)
    get other = []

    get_deriv cls = case lookupUFM derivingOccurrences cls of
			Nothing   -> []
			Just occs -> occs
254 255 256
\end{code}

\begin{code}
257 258 259
isOrphanDecl this_mod (InstD (InstDecl inst_ty _ _ _ _))
  = not (foldNameSet ((||) . nameIsLocalOrFrom this_mod) False 
		     (extractHsTyNames (removeContext inst_ty)))
260 261 262 263 264
	-- The 'removeContext' is because of
	--	instance Foo a => Baz T where ...
	-- The decl is an orphan if Baz and T are both not locally defined,
	--	even if Foo *is* locally defined

265
isOrphanDecl this_mod (RuleD (HsRule _ _ _ lhs _ _))
266 267
  = check lhs
  where
268 269 270
	-- At the moment we just check for common LHS forms
	-- Expand as necessary.  Getting it wrong just means
	-- more orphans than necessary
271
    check (HsVar v)   	  = not (nameIsLocalOrFrom this_mod v)
272 273
    check (HsApp f a) 	  = check f && check a
    check (HsLit _)   	  = False
274
    check (HsOverLit _)	  = False
275 276 277 278 279 280 281 282
    check (OpApp l o _ r) = check l && check o && check r
    check (NegApp e _)    = check e
    check (HsPar e)	  = check e
    check (SectionL e o)  = check e && check o
    check (SectionR o e)  = check e && check o

    check other	      	  = True 	-- Safe fall through

283
isOrphanDecl _ _  = False
284 285 286
\end{code}


287 288 289 290 291 292 293
%*********************************************************
%*						 	 *
\subsection{Fixities}
%*							 *
%*********************************************************

\begin{code}
294
fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG LocalFixityEnv
295
fixitiesFromLocalDecls gbl_env decls
296 297
  = foldlRn getFixities emptyNameEnv decls				`thenRn` \ env -> 
    traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts env)))	`thenRn_`
298 299
    returnRn env
  where
300 301 302
    getFixities :: LocalFixityEnv -> RdrNameHsDecl -> RnMG LocalFixityEnv
    getFixities acc (FixD fix)
      = fix_decl acc fix
303

304 305
    getFixities acc (TyClD (ClassDecl _ _ _ _ sigs _ _ _ ))
      = foldlRn fix_decl acc [sig | FixSig sig <- sigs]
306
		-- Get fixities from class decl sigs too.
307
    getFixities acc other_decl
308 309
      = returnRn acc

310
    fix_decl acc sig@(FixitySig rdr_name fixity loc)
311
	= 	-- Check for fixity decl for something not declared
312
	  pushSrcLocRn loc 			$
313
	  lookupSrcName gbl_env rdr_name	`thenRn` \ name ->
314 315

		-- Check for duplicate fixity decl
316 317 318
	  case lookupNameEnv acc name of
	    Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc')	`thenRn_`
					 returnRn acc ;
319

320
	    Nothing		      -> returnRn (extendNameEnv acc name (FixitySig name fixity loc))
321 322 323 324 325 326 327 328 329 330 331 332 333 334 335
\end{code}


%*********************************************************
%*						 	 *
\subsection{Deprecations}
%*							 *
%*********************************************************

For deprecations, all we do is check that the names are in scope.
It's only imported deprecations, dealt with in RnIfaces, that we
gather them together.

\begin{code}
rnDeprecs :: GlobalRdrEnv -> Maybe DeprecTxt
336 337 338 339 340 341 342 343 344 345 346
	   -> [RdrNameDeprecation] -> RnMG Deprecations
rnDeprecs gbl_env Nothing []
 = returnRn NoDeprecs

rnDeprecs gbl_env (Just txt) decls
 = mapRn (addErrRn . badDeprec) decls 	`thenRn_` 
   returnRn (DeprecAll txt)

rnDeprecs gbl_env Nothing decls
  = mapRn rn_deprec decls	`thenRn` \ pairs ->
    returnRn (DeprecSome (mkNameEnv (catMaybes pairs)))
347
 where
348
   rn_deprec (Deprecation rdr_name txt loc)
349 350 351
     = pushSrcLocRn loc				$
       lookupSrcName gbl_env rdr_name		`thenRn` \ name ->
       returnRn (Just (name, (name,txt)))
352 353 354
\end{code}


355 356 357 358 359 360 361
%************************************************************************
%*									*
\subsection{Grabbing the old interface file and checking versions}
%*									*
%************************************************************************

\begin{code}
362
checkOldIface :: DynFlags
363 364
	      -> HomeIfaceTable -> HomeSymbolTable
	      -> PersistentCompilerState
365
	      -> FilePath
366 367 368 369 370
	      -> Bool 			-- Source unchanged
	      -> Maybe ModIface 	-- Old interface from compilation manager, if any
	      -> IO (PersistentCompilerState, Bool, (RecompileRequired, Maybe ModIface))
				-- True <=> errors happened

371
checkOldIface dflags hit hst pcs iface_path source_unchanged maybe_iface
372 373 374 375 376 377 378 379
  = case maybe_iface of
       Just old_iface -> -- Use the one we already have
                         startRn (mi_module old_iface) $ 
                         check_versions old_iface
       Nothing -- try and read it from a file
          -> do read_result <- readIface do_traceRn iface_path
                case read_result of
                   Left err -> -- Old interface file not found, or garbled; give up
380 381
			       do { ioTraceRn (text "Bad old interface file" $$ nest 4 err) ;
	                            return (pcs, False, (outOfDate, Nothing)) }
382 383 384 385 386 387 388 389 390 391 392 393 394 395 396
                   Right parsed_iface
                      -> startRn (pi_mod parsed_iface) $
                         loadOldIface parsed_iface `thenRn` \ m_iface ->
                         check_versions m_iface
    where
       check_versions :: ModIface -> RnMG (RecompileRequired, Maybe ModIface)
       check_versions iface
          = -- Check versions
            recompileRequired iface_path source_unchanged iface
	 						`thenRn` \ recompile ->
            returnRn (recompile, Just iface)

       do_traceRn     = dopt Opt_D_dump_rn_trace dflags
       ioTraceRn sdoc = if do_traceRn then printErrs sdoc else return ()
       startRn mod     = initRn dflags hit hst pcs mod
397 398
\end{code}

399 400
I think the following function should now have a more representative name,
but what?
401 402

\begin{code}
403 404 405 406 407
loadOldIface :: ParsedIface -> RnMG ModIface

loadOldIface parsed_iface
  = let iface = parsed_iface 
    in	-- RENAME IT
408 409 410
    let mod = pi_mod iface
        doc_str = ptext SLIT("need usage info from") <+> ppr mod
    in
411 412 413 414 415
    initIfaceRnMS mod (
	loadHomeDecls (pi_decls iface)	`thenRn` \ decls ->
	loadHomeRules (pi_rules iface)	`thenRn` \ rules -> 
	loadHomeInsts (pi_insts iface)	`thenRn` \ insts ->
	returnRn (decls, rules, insts)
416 417
    )	
	`thenRn` \ ((decls_vers, new_decls), (rule_vers, new_rules), new_insts) ->
418 419

    mapRn loadHomeUsage	(pi_usages iface)	`thenRn` \ usages ->
420
    loadExports         (pi_exports iface)	`thenRn` \ (export_vers, avails) ->
421 422 423 424 425 426 427 428
    loadFixDecls mod	(pi_fixity iface)	`thenRn` \ fix_env ->
    loadDeprecs mod	(pi_deprecs iface)	`thenRn` \ deprec_env ->
    let
	version	= VersionInfo { vers_module  = pi_vers iface, 
				vers_exports = export_vers,
				vers_rules   = rule_vers,
				vers_decls   = decls_vers }

429
	decls = mkIfaceDecls new_decls new_rules new_insts
430 431

 	mod_iface = ModIface { mi_module = mod, mi_version = version,
432 433
			       mi_exports = avails, mi_usages  = usages,
			       mi_boot = False, mi_orphan = pi_orphan iface, 
434 435 436 437 438
			       mi_fixities = fix_env, mi_deprecs = deprec_env,
			       mi_decls   = decls,
			       mi_globals = panic "No mi_globals in old interface"
		    }
    in
439
    returnRn mod_iface
440 441 442 443 444 445 446 447 448 449 450
\end{code}

\begin{code}
loadHomeDecls :: [(Version, RdrNameTyClDecl)]
	      -> RnMS (NameEnv Version, [RenamedTyClDecl])
loadHomeDecls decls = foldlRn loadHomeDecl (emptyNameEnv, []) decls

loadHomeDecl :: (NameEnv Version, [RenamedTyClDecl])
	     -> (Version, RdrNameTyClDecl)
	     -> RnMS (NameEnv Version, [RenamedTyClDecl])
loadHomeDecl (version_map, decls) (version, decl)
451
  = rnTyClDecl decl	`thenRn` \ decl' ->
452 453 454 455 456 457
    returnRn (extendNameEnv version_map (tyClDeclName decl') version, decl':decls)

------------------
loadHomeRules :: (Version, [RdrNameRuleDecl])
	      -> RnMS (Version, [RenamedRuleDecl])
loadHomeRules (version, rules)
458
  = mapRn rnIfaceRuleDecl rules	`thenRn` \ rules' ->
459 460 461 462 463
    returnRn (version, rules')

------------------
loadHomeInsts :: [RdrNameInstDecl]
	      -> RnMS [RenamedInstDecl]
464
loadHomeInsts insts = mapRn rnInstDecl insts
465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481

------------------
loadHomeUsage :: ImportVersion OccName
	      -> RnMG (ImportVersion Name)
loadHomeUsage (mod_name, orphans, is_boot, whats_imported)
  = rn_imps whats_imported	`thenRn` \ whats_imported' ->
    returnRn (mod_name, orphans, is_boot, whats_imported')
  where
    rn_imps NothingAtAll	   	  = returnRn NothingAtAll
    rn_imps (Everything v)		  = returnRn (Everything v)
    rn_imps (Specifically mv ev items rv) = mapRn rn_imp items 	`thenRn` \ items' ->
					    returnRn (Specifically mv ev items' rv)
    rn_imp (occ,vers) = newGlobalName mod_name occ	`thenRn` \ name ->
			returnRn (name,vers)
\end{code}


482 483 484 485 486 487 488 489 490 491 492

%*********************************************************
%*						 	 *
\subsection{Closing up the interface decls}
%*							 *
%*********************************************************

Suppose we discover we don't need to recompile.   Then we start from the
IfaceDecls in the ModIface, and fluff them up by sucking in all the decls they need.

\begin{code}
493
closeIfaceDecls :: DynFlags
494 495 496 497 498
	      	-> HomeIfaceTable -> HomeSymbolTable
	      	-> PersistentCompilerState
	      	-> ModIface 	-- Get the decls from here
	      	-> IO (PersistentCompilerState, Bool, [RenamedHsDecl])
				-- True <=> errors happened
499
closeIfaceDecls dflags hit hst pcs
500
		mod_iface@(ModIface { mi_module = mod, mi_decls = iface_decls })
501
  = initRn dflags hit hst pcs mod $
502 503 504 505 506 507 508 509 510

    let
	rule_decls = dcl_rules iface_decls
	inst_decls = dcl_insts iface_decls
	tycl_decls = dcl_tycl  iface_decls
	decls = map RuleD rule_decls ++
		map InstD inst_decls ++
		map TyClD tycl_decls
	needed = unionManyNameSets (map ruleDeclFVs rule_decls) `unionNameSets`
511 512
		 unionManyNameSets (map instDeclFVs inst_decls) `unionNameSets`
		 unionManyNameSets (map tyClDeclFVs tycl_decls)
513 514 515 516
    in
    closeDecls decls needed
\end{code}

517 518 519 520 521 522 523
%*********************************************************
%*						 	 *
\subsection{Unused names}
%*							 *
%*********************************************************

\begin{code}
524 525 526 527
reportUnusedNames :: ModIface -> [RdrNameImportDecl] 
		  -> AvailEnv
		  -> NameSet 
		  -> [RenamedHsDecl] 
528
		  -> RnMG ()
529 530
reportUnusedNames my_mod_iface imports avail_env 
		  used_names imported_decls
531
  = warnUnusedModules unused_imp_mods				`thenRn_`
532
    warnUnusedLocalBinds bad_locals				`thenRn_`
533
    warnUnusedImports bad_imp_names				`thenRn_`
534 535
    printMinimalImports this_mod minimal_imports		`thenRn_`
    warnDeprecations this_mod my_deprecs really_used_names	`thenRn_`
536
    traceRn (text "Used" <+> fsep (map ppr (nameSetToList used_names)))	`thenRn_`
537 538 539
    returnRn ()

  where
540
    this_mod   = mi_module my_mod_iface
541
    gbl_env    = mi_globals my_mod_iface
542
    my_deprecs = mi_deprecs my_mod_iface
543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562
    
    -- Now, a use of C implies a use of T,
    -- if C was brought into scope by T(..) or T(C)
    really_used_names = used_names `unionNameSets`
      mkNameSet [ parent_name
	        | sub_name <- nameSetToList used_names
    
    		-- Usually, every used name will appear in avail_env, but there 
    		-- is one time when it doesn't: tuples and other built in syntax.  When you
    		-- write (a,b) that gives rise to a *use* of "(,)", so that the
    		-- instances will get pulled in, but the tycon "(,)" isn't actually
    		-- in scope.  Also, (-x) gives rise to an implicit use of 'negate'; 
    		-- similarly,   3.5 gives rise to an implcit use of :%
    		-- Hence the silent 'False' in all other cases
    	      
	        , Just parent_name <- [case lookupNameEnv avail_env sub_name of
			    		Just (AvailTC n _) -> Just n
			    		other		   -> Nothing]
    	    ]
    
563 564 565 566 567 568 569 570
	-- Collect the defined names from the in-scope environment
	-- Look for the qualified ones only, else get duplicates
    defined_names :: [(Name,Provenance)]
    defined_names = foldRdrEnv add [] gbl_env
    add rdr_name ns acc | isQual rdr_name = ns ++ acc
			| otherwise	  = acc

    defined_and_used, defined_but_not_used :: [(Name,Provenance)]
571
    (defined_and_used, defined_but_not_used) = partition used defined_names
572
    used (name,_)	  		     = name `elemNameSet` really_used_names
573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626
    
    -- Filter out the ones only defined implicitly
    bad_locals :: [Name]
    bad_locals     = [n     | (n,LocalDef) <- defined_but_not_used]
    
    bad_imp_names :: [(Name,Provenance)]
    bad_imp_names  = [(n,p) | (n,p@(NonLocalDef (UserImport mod _ True) _)) <- defined_but_not_used,
  	  		      not (module_unused mod)]
    
    -- inst_mods are directly-imported modules that 
    --	contain instance decl(s) that the renamer decided to suck in
    -- It's not necessarily redundant to import such modules.
    --
    -- NOTE: Consider 
    --	      module This
    --		import M ()
    --
    --	 The import M() is not *necessarily* redundant, even if
    -- 	 we suck in no instance decls from M (e.g. it contains 
    --	 no instance decls, or This contains no code).  It may be 
    --	 that we import M solely to ensure that M's orphan instance 
    --	 decls (or those in its imports) are visible to people who 
    --	 import This.  Sigh. 
    --	 There's really no good way to detect this, so the error message 
    --	 in RnEnv.warnUnusedModules is weakened instead
    inst_mods :: [ModuleName]
    inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
    		 let m = moduleName (nameModule dfun),
    		 m `elem` direct_import_mods
    	    ]
    
    -- To figure out the minimal set of imports, start with the things
    -- that are in scope (i.e. in gbl_env).  Then just combine them
    -- into a bunch of avails, so they are properly grouped
    minimal_imports :: FiniteMap ModuleName AvailEnv
    minimal_imports0 = emptyFM
    minimal_imports1 = foldr add_name     minimal_imports0 defined_and_used
    minimal_imports  = foldr add_inst_mod minimal_imports1 inst_mods
    
    add_name (n,NonLocalDef (UserImport m _ _) _) acc = addToFM_C plusAvailEnv acc (moduleName (nameModule n))
					    			  (unitAvailEnv (mk_avail n))
    add_name (n,other_prov)			  acc = acc

    mk_avail n = case lookupNameEnv avail_env n of
    		Just (AvailTC m _) | n==m      -> AvailTC n [n]
    				   | otherwise -> AvailTC m [n,m]
    		Just avail	   -> Avail n
    		Nothing		   -> pprPanic "mk_avail" (ppr n)
    
    add_inst_mod m acc 
      | m `elemFM` acc = acc	-- We import something already
      | otherwise      = addToFM acc m emptyAvailEnv
    	-- Add an empty collection of imports for a module
    	-- from which we have sucked only instance decls
627 628 629 630
   
    direct_import_mods :: [ModuleName]
    direct_import_mods = nub [m | ImportDecl m _ _ _ _ _ <- imports]

631 632 633 634 635 636
    -- unused_imp_mods are the directly-imported modules 
    -- that are not mentioned in minimal_imports
    unused_imp_mods = [m | m <- direct_import_mods,
    		       not (maybeToBool (lookupFM minimal_imports m)),
    		       m /= pRELUDE_Name]
    
637 638
    module_unused :: Module -> Bool
    module_unused mod = moduleName mod `elem` unused_imp_mods
639 640


641
warnDeprecations this_mod my_deprecs used_names
642 643 644 645 646 647 648 649 650 651 652 653 654 655
  = doptRn Opt_WarnDeprecations				`thenRn` \ warn_drs ->
    if not warn_drs then returnRn () else

    getIfacesRn						`thenRn` \ ifaces ->
    getHomeIfaceTableRn					`thenRn` \ hit ->
    let
	pit     = iPIT ifaces
	deprecs = [ (n,txt)
                  | n <- nameSetToList used_names,
                    Just txt <- [lookup_deprec hit pit n] ]
    in			  
    mapRn_ warnDeprec deprecs

  where
656 657 658 659 660 661 662
    lookup_deprec hit pit n
	| nameIsLocalOrFrom this_mod n
	= lookupDeprec my_deprecs n 
	| otherwise
	= case lookupIface hit pit this_mod n of
		Just iface -> lookupDeprec (mi_deprecs iface) n
		Nothing    -> pprPanic "warnDeprecations:" (ppr n)
663

664
-- ToDo: deal with original imports with 'qualified' and 'as M' clauses
665
printMinimalImports this_mod imps
666
  = doptRn Opt_D_dump_minimal_imports		`thenRn` \ dump_minimal ->
667
    if not dump_minimal then returnRn () else
668

669
    mapRn to_ies (fmToList imps)		`thenRn` \ mod_ies ->
670 671 672 673 674
    ioToRnM (do { h <- openFile filename WriteMode ;
		  printForUser h (vcat (map ppr_mod_ie mod_ies))
	})					`thenRn_`
    returnRn ()
  where
675
    filename = moduleNameUserString (moduleName this_mod) ++ ".imports"
676 677 678 679 680 681 682 683
    ppr_mod_ie (mod_name, ies) 
	| mod_name == pRELUDE_Name 
	= empty
	| otherwise
	= ptext SLIT("import") <+> ppr mod_name <> 
			    parens (fsep (punctuate comma (map ppr ies)))

    to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env)	`thenRn` \ ies ->
684
			      returnRn (mod, ies)
685 686 687 688 689

    to_ie :: AvailInfo -> RnMG (IE Name)
    to_ie (Avail n)       = returnRn (IEVar n)
    to_ie (AvailTC n [m]) = ASSERT( n==m ) 
			    returnRn (IEThingAbs n)
690 691 692 693 694 695 696 697 698 699 700 701
    to_ie (AvailTC n ns)  
	= getInterfaceExports n_mod ImportBySystem		`thenRn` \ (_, avails_by_module) ->
	  case [xs | (m,as) <- avails_by_module,
		     m == n_mod,
		     AvailTC x xs <- as, 
		     x == n] of
	      [xs] | all (`elem` ns) xs -> returnRn (IEThingAll n)
		   | otherwise	        -> returnRn (IEThingWith n (filter (/= n) ns))
	      other			-> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
					   returnRn (IEVar n)
	where
	  n_mod = moduleName (nameModule n)
702

703 704
rnDump  :: [RenamedHsDecl] 	-- Renamed imported decls
	-> [RenamedHsDecl] 	-- Renamed local decls
705
	-> RnMG ()
706
rnDump imp_decls local_decls
707 708
  = doptRn Opt_D_dump_rn_trace 	`thenRn` \ dump_rn_trace ->
    doptRn Opt_D_dump_rn_stats 	`thenRn` \ dump_rn_stats ->
709
    doptRn Opt_D_dump_rn 	`thenRn` \ dump_rn ->
710 711 712 713 714 715 716 717 718 719 720
    getIfacesRn			`thenRn` \ ifaces ->

    ioToRnM (do { dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
			    "Renamer statistics"
			    (getRnStats imp_decls ifaces) ;

		  dumpIfSet dump_rn "Renamer:" 
			    (vcat (map ppr (local_decls ++ imp_decls)))
    })				`thenRn_`

    returnRn ()
721
\end{code}
722 723 724 725 726 727 728 729 730


%*********************************************************
%*							*
\subsection{Statistics}
%*							*
%*********************************************************

\begin{code}
731 732
getRnStats :: [RenamedHsDecl] -> Ifaces -> SDoc
getRnStats imported_decls ifaces
733
  = hcat [text "Renamer stats: ", stats]
734
  where
735 736
    n_mods = length [() | _ <- moduleEnvElts (iPIT ifaces)]
	-- This is really only right for a one-shot compile
737 738

    (decls_map, n_decls_slurped) = iDecls ifaces
739
    
740
    n_decls_left   = length [decl | (avail, True, (_,decl)) <- nameEnvElts decls_map
741 742 743 744 745 746
    			-- Data, newtype, and class decls are in the decls_fm
    			-- under multiple names; the tycon/class, and each
    			-- constructor/class op too.
    			-- The 'True' selects just the 'main' decl
    		     ]
    
747 748
    (insts_left, n_insts_slurped) = iInsts ifaces
    n_insts_left  = length (bagToList insts_left)
749
    
750 751
    (rules_left, n_rules_slurped) = iRules ifaces
    n_rules_left  = length (bagToList rules_left)
752 753 754
    
    stats = vcat 
    	[int n_mods <+> text "interfaces read",
755 756 757 758 759 760 761
    	 hsep [ int n_decls_slurped, text "class decls imported, out of", 
    	        int (n_decls_slurped + n_decls_left), text "read"],
    	 hsep [ int n_insts_slurped, text "instance decls imported, out of",  
    	        int (n_insts_slurped + n_insts_left), text "read"],
    	 hsep [ int n_rules_slurped, text "rule decls imported, out of",  
    	        int (n_rules_slurped + n_rules_left), text "read"]
	]
762 763 764 765 766 767 768 769 770 771

count_decls decls
  = (class_decls, 
     data_decls, 
     newtype_decls,
     syn_decls, 
     val_decls, 
     inst_decls)
  where
    tycl_decls = [d | TyClD d <- decls]
772
    (class_decls, data_decls, newtype_decls, syn_decls, val_decls) = countTyClDecls tycl_decls
773 774 775 776

    inst_decls    = length [() | InstD _  <- decls]
\end{code}    

777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796

%************************************************************************
%*									*
\subsection{Errors and warnings}
%*									*
%************************************************************************

\begin{code}
warnDeprec :: (Name, DeprecTxt) -> RnM d ()
warnDeprec (name, txt)
  = pushSrcLocRn (getSrcLoc name)	$
    addWarnRn				$
    sep [ text (occNameFlavour (nameOccName name)) <+> ppr name <+>
          text "is deprecated:", nest 4 (ppr txt) ]


dupFixityDecl rdr_name loc1 loc2
  = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
	  ptext SLIT("at ") <+> ppr loc1,
	  ptext SLIT("and") <+> ppr loc2]
797 798 799 800

badDeprec d
  = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),
	 nest 4 (ppr d)]
801 802 803 804

noMainErr
  = hsep [ptext SLIT("Module"), quotes (ppr mAIN_Name), 
	  ptext SLIT("must include a definition for"), quotes (ptext SLIT("main"))]
805
\end{code}
806 807