[project @ 2001-01-30 10:55:04 by simonmar]
[ghc-hetmet.git] / ghc / compiler / rename / Rename.lhs
1 %
2 % (c) The GRASP Project, Glasgow University, 1992-1998
3 %
4 \section[Rename]{Renaming and dependency analysis passes}
5
6 \begin{code}
7 module Rename ( renameModule, renameExpr, closeIfaceDecls, checkOldIface ) where
8
9 #include "HsVersions.h"
10
11 import HsSyn
12 import RdrHsSyn         ( RdrNameHsModule, RdrNameHsDecl, RdrNameDeprecation, RdrNameHsExpr,
13                           RdrNameTyClDecl, RdrNameRuleDecl, RdrNameInstDecl, RdrNameImportDecl
14                         )
15 import RnHsSyn          ( RenamedHsDecl, RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl,
16                           extractHsTyNames, RenamedHsExpr,
17                           instDeclFVs, tyClDeclFVs, ruleDeclFVs
18                         )
19
20 import CmdLineOpts      ( DynFlags, DynFlag(..) )
21 import RnMonad
22 import RnExpr           ( rnExpr )
23 import RnNames          ( getGlobalNames, exportsFromAvail )
24 import RnSource         ( rnSourceDecls, rnTyClDecl, rnIfaceRuleDecl, rnInstDecl )
25 import RnIfaces         ( slurpImpDecls, mkImportInfo, recordLocalSlurps,
26                           getInterfaceExports, closeDecls,
27                           RecompileRequired, outOfDate, recompileRequired
28                         )
29 import RnHiFiles        ( readIface, removeContext, loadInterface,
30                           loadExports, loadFixDecls, loadDeprecs,
31                           tryLoadInterface )
32 import RnEnv            ( availsToNameSet, availName, mkIfaceGlobalRdrEnv,
33                           emptyAvailEnv, unitAvailEnv, availEnvElts, 
34                           plusAvailEnv, groupAvails, warnUnusedImports, 
35                           warnUnusedLocalBinds, warnUnusedModules, 
36                           lookupOrigNames, lookupSrcName, 
37                           newGlobalName, unQualInScope
38                         )
39 import Module           ( Module, ModuleName, WhereFrom(..),
40                           moduleNameUserString, moduleName,
41                           moduleEnvElts
42                         )
43 import Name             ( Name, NamedThing(..), getSrcLoc,
44                           nameIsLocalOrFrom, nameOccName, nameModule,
45                         )
46 import Name             ( mkNameEnv, nameEnvElts, extendNameEnv )
47 import RdrName          ( foldRdrEnv, isQual )
48 import OccName          ( occNameFlavour )
49 import NameSet
50 import TysWiredIn       ( unitTyCon, intTyCon, boolTyCon )
51 import PrelNames        ( mAIN_Name, pREL_MAIN_Name, pRELUDE_Name,
52                           ioTyConName, printName,
53                           unpackCStringName, unpackCStringFoldrName, unpackCStringUtf8Name,
54                           eqStringName
55                         )
56 import PrelInfo         ( derivingOccurrences )
57 import Type             ( funTyCon )
58 import ErrUtils         ( dumpIfSet, dumpIfSet_dyn, showPass, 
59                           printErrorsAndWarnings, errorsFound )
60 import Bag              ( bagToList )
61 import FiniteMap        ( FiniteMap, fmToList, emptyFM, lookupFM, 
62                           addToFM_C, elemFM, addToFM
63                         )
64 import UniqFM           ( lookupWithDefaultUFM )
65 import Maybes           ( maybeToBool, catMaybes )
66 import Outputable
67 import IO               ( openFile, IOMode(..) )
68 import HscTypes         ( PersistentCompilerState, HomeIfaceTable, HomeSymbolTable, 
69                           ModIface(..), WhatsImported(..), 
70                           VersionInfo(..), ImportVersion, IsExported,
71                           IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
72                           GlobalRdrEnv, pprGlobalRdrEnv,
73                           AvailEnv, GenAvailInfo(..), AvailInfo, Avails,
74                           Provenance(..), ImportReason(..), initialVersionInfo,
75                           Deprecations(..), lookupDeprec, lookupIface
76                          )
77 import CmStaticInfo     ( GhciMode(..) )
78 import List             ( partition, nub )
79 \end{code}
80
81
82
83
84 %*********************************************************
85 %*                                                       *
86 \subsection{The two main wrappers}
87 %*                                                       *
88 %*********************************************************
89
90 \begin{code}
91 renameModule :: DynFlags
92              -> HomeIfaceTable -> HomeSymbolTable
93              -> PersistentCompilerState 
94              -> Module -> RdrNameHsModule 
95              -> IO (PersistentCompilerState, Maybe (PrintUnqualified, (IsExported, ModIface, [RenamedHsDecl])))
96         -- Nothing => some error occurred in the renamer
97
98 renameModule dflags hit hst pcs this_module rdr_module
99   = renameSource dflags hit hst pcs this_module $
100     rename this_module rdr_module
101 \end{code}
102
103
104 \begin{code}
105 renameExpr :: DynFlags
106            -> HomeIfaceTable -> HomeSymbolTable
107            -> PersistentCompilerState 
108            -> Module -> RdrNameHsExpr
109            -> IO ( PersistentCompilerState, 
110                    Maybe (PrintUnqualified, (RenamedHsExpr, [RenamedHsDecl]))
111                  )
112
113 renameExpr dflags hit hst pcs this_module expr
114   = renameSource dflags hit hst pcs this_module $
115           tryLoadInterface doc (moduleName this_module) ImportByUser 
116                                                 `thenRn` \ (iface, maybe_err) ->
117           case maybe_err of {
118             Just msg -> ioToRnM (printErrs alwaysQualify 
119                                  (ptext SLIT("failed to load interface for") 
120                                   <+> quotes (ppr this_module) 
121                                   <>  char ':' <+> msg)) `thenRn_`
122                         returnRn Nothing;
123             Nothing -> 
124
125           let rdr_env      = mi_globals iface
126               print_unqual = unQualInScope rdr_env
127           in 
128  
129           initRnMS rdr_env emptyLocalFixityEnv CmdLineMode (rnExpr expr)        
130                                                 `thenRn` \ (e,fvs) -> 
131
132           checkErrsRn                           `thenRn` \ no_errs_so_far ->
133           if not no_errs_so_far then
134                 -- Found errors already, so exit now
135                 doDump e [] `thenRn_` 
136                 returnRn Nothing
137           else
138
139           let
140             implicit_fvs = fvs `plusFV` string_names
141                                `plusFV` default_tycon_names
142                                `plusFV` unitFV printName
143                                         -- print :: a -> IO () may be needed later
144           in
145           slurpImpDecls (fvs `plusFV` implicit_fvs)     `thenRn` \ decls ->
146
147           doDump e decls  `thenRn_`
148           returnRn (Just (print_unqual, (e, decls)))
149         }
150   where
151      doc = text "context for compiling expression"
152
153      doDump :: RenamedHsExpr -> [RenamedHsDecl] -> RnMG (Either IOError ())
154      doDump e decls = 
155         getDOptsRn  `thenRn` \ dflags ->
156         ioToRnM (dumpIfSet_dyn dflags Opt_D_dump_rn "Renamer:" 
157                         (vcat (ppr e : map ppr decls)))
158 \end{code}
159
160
161 %*********************************************************
162 %*                                                       *
163 \subsection{The main function: rename}
164 %*                                                       *
165 %*********************************************************
166
167 \begin{code}
168 renameSource :: DynFlags
169              -> HomeIfaceTable -> HomeSymbolTable
170              -> PersistentCompilerState 
171              -> Module 
172              -> RnMG (Maybe (PrintUnqualified, r))
173              -> IO (PersistentCompilerState, Maybe (PrintUnqualified, r))
174         -- Nothing => some error occurred in the renamer
175
176 renameSource dflags hit hst old_pcs this_module thing_inside
177   = do  { showPass dflags "Renamer"
178
179                 -- Initialise the renamer monad
180         ; (new_pcs, msgs, maybe_rn_stuff) <- initRn dflags hit hst old_pcs this_module thing_inside
181
182                 -- Print errors from renaming
183         ;  let print_unqual = case maybe_rn_stuff of
184                                 Just (unqual, _) -> unqual
185                                 Nothing          -> alwaysQualify
186
187         ;  printErrorsAndWarnings print_unqual msgs ;
188
189                 -- Return results.  No harm in updating the PCS
190         ; if errorsFound msgs then
191             return (new_pcs, Nothing)
192           else      
193             return (new_pcs, maybe_rn_stuff)
194     }
195 \end{code}
196
197 \begin{code}
198 rename :: Module -> RdrNameHsModule -> RnMG (Maybe (PrintUnqualified, (IsExported, ModIface, [RenamedHsDecl])))
199 rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec loc)
200   = pushSrcLocRn loc            $
201
202         -- FIND THE GLOBAL NAME ENVIRONMENT
203     getGlobalNames this_module contents         `thenRn` \ (gbl_env, local_gbl_env, all_avails@(_, global_avail_env)) ->
204
205         -- Exit if we've found any errors
206     checkErrsRn                         `thenRn` \ no_errs_so_far ->
207     if not no_errs_so_far then
208         -- Found errors already, so exit now
209         rnDump [] []            `thenRn_`
210         returnRn Nothing 
211     else
212         
213         -- PROCESS EXPORT LIST 
214     exportsFromAvail mod_name exports all_avails gbl_env        `thenRn` \ export_avails ->
215         
216     traceRn (text "Local top-level environment" $$ 
217              nest 4 (pprGlobalRdrEnv local_gbl_env))    `thenRn_`
218
219         -- DEAL WITH DEPRECATIONS
220     rnDeprecs local_gbl_env mod_deprec 
221               [d | DeprecD d <- local_decls]            `thenRn` \ my_deprecs ->
222
223         -- DEAL WITH LOCAL FIXITIES
224     fixitiesFromLocalDecls local_gbl_env local_decls    `thenRn` \ local_fixity_env ->
225
226         -- RENAME THE SOURCE
227     rnSourceDecls gbl_env local_fixity_env local_decls  `thenRn` \ (rn_local_decls, source_fvs) ->
228
229         -- EXIT IF ERRORS FOUND
230         -- We exit here if there are any errors in the source, *before*
231         -- we attempt to slurp the decls from the interfaces, otherwise
232         -- the slurped decls may get lost when we return up the stack
233         -- to hscMain/hscExpr.
234     checkErrsRn                                 `thenRn` \ no_errs_so_far ->
235     if not no_errs_so_far then
236         -- Found errors already, so exit now
237         rnDump [] rn_local_decls                `thenRn_` 
238         returnRn Nothing
239     else
240
241         -- SLURP IN ALL THE NEEDED DECLARATIONS
242     implicitFVs mod_name rn_local_decls         `thenRn` \ implicit_fvs -> 
243     let
244         slurp_fvs = implicit_fvs `plusFV` source_fvs
245                 -- It's important to do the "plus" this way round, so that
246                 -- when compiling the prelude, locally-defined (), Bool, etc
247                 -- override the implicit ones. 
248     in
249     traceRn (text "Source FVs:" <+> fsep (map ppr (nameSetToList slurp_fvs)))   `thenRn_`
250     slurpImpDecls slurp_fvs             `thenRn` \ rn_imp_decls ->
251
252     rnDump rn_imp_decls rn_local_decls          `thenRn_` 
253
254         -- GENERATE THE VERSION/USAGE INFO
255     mkImportInfo mod_name imports                       `thenRn` \ my_usages ->
256
257         -- BUILD THE MODULE INTERFACE
258     let
259         -- We record fixities even for things that aren't exported,
260         -- so that we can change into the context of this moodule easily
261         fixities = mkNameEnv [ (name, fixity)
262                              | FixitySig name fixity loc <- nameEnvElts local_fixity_env
263                              ]
264
265         -- Sort the exports to make them easier to compare for versions
266         my_exports = groupAvails this_module export_avails
267         
268         final_decls = rn_local_decls ++ rn_imp_decls
269         is_orphan   = any (isOrphanDecl this_module) rn_local_decls
270
271         mod_iface = ModIface {  mi_module   = this_module,
272                                 mi_version  = initialVersionInfo,
273                                 mi_usages   = my_usages,
274                                 mi_boot     = False,
275                                 mi_orphan   = is_orphan,
276                                 mi_exports  = my_exports,
277                                 mi_globals  = gbl_env,
278                                 mi_fixities = fixities,
279                                 mi_deprecs  = my_deprecs,
280                                 mi_decls    = panic "mi_decls"
281                     }
282
283         print_unqualified = unQualInScope gbl_env
284         is_exported name  = name `elemNameSet` exported_names
285         exported_names    = availsToNameSet export_avails
286     in
287
288         -- REPORT UNUSED NAMES, AND DEBUG DUMP 
289     reportUnusedNames mod_iface print_unqualified 
290                       imports global_avail_env
291                       source_fvs export_avails rn_imp_decls     `thenRn_`
292
293     returnRn (Just (print_unqualified, (is_exported, mod_iface, final_decls)))
294   where
295     mod_name = moduleName this_module
296 \end{code}
297
298 @implicitFVs@ forces the renamer to slurp in some things which aren't
299 mentioned explicitly, but which might be needed by the type checker.
300
301 \begin{code}
302 implicitFVs mod_name decls
303   = lookupOrigNames deriv_occs          `thenRn` \ deriving_names ->
304     returnRn (default_tycon_names  `plusFV`
305               string_names         `plusFV`
306               deriving_names       `plusFV`
307               implicit_main)
308   where
309
310         -- Add occurrences for IO or PrimIO
311     implicit_main |  mod_name == mAIN_Name
312                   || mod_name == pREL_MAIN_Name = unitFV ioTyConName
313                   |  otherwise                  = emptyFVs
314
315     deriv_occs = [occ | TyClD (TyData {tcdDerivs = Just deriv_classes}) <- decls,
316                         cls <- deriv_classes,
317                         occ <- lookupWithDefaultUFM derivingOccurrences [] cls ]
318
319 -- Virtually every program has error messages in it somewhere
320 string_names = mkFVs [unpackCStringName, unpackCStringFoldrName, 
321                       unpackCStringUtf8Name, eqStringName]
322
323 -- Add occurrences for Int, and (), because they
324 -- are the types to which ambigious type variables may be defaulted by
325 -- the type checker; so they won't always appear explicitly.
326 -- [The () one is a GHC extension for defaulting CCall results.]
327 -- ALSO: funTyCon, since it occurs implicitly everywhere!
328 --       (we don't want to be bothered with making funTyCon a
329 --        free var at every function application!)
330 -- Double is dealt with separately in getGates
331 default_tycon_names = mkFVs (map getName [unitTyCon, funTyCon, boolTyCon, intTyCon])
332 \end{code}
333
334 \begin{code}
335 isOrphanDecl this_mod (InstD (InstDecl inst_ty _ _ _ _))
336   = not (foldNameSet ((||) . nameIsLocalOrFrom this_mod) False 
337                      (extractHsTyNames (removeContext inst_ty)))
338         -- The 'removeContext' is because of
339         --      instance Foo a => Baz T where ...
340         -- The decl is an orphan if Baz and T are both not locally defined,
341         --      even if Foo *is* locally defined
342
343 isOrphanDecl this_mod (RuleD (HsRule _ _ _ lhs _ _))
344   = check lhs
345   where
346         -- At the moment we just check for common LHS forms
347         -- Expand as necessary.  Getting it wrong just means
348         -- more orphans than necessary
349     check (HsVar v)       = not (nameIsLocalOrFrom this_mod v)
350     check (HsApp f a)     = check f && check a
351     check (HsLit _)       = False
352     check (HsOverLit _)   = False
353     check (OpApp l o _ r) = check l && check o && check r
354     check (NegApp e _)    = check e
355     check (HsPar e)       = check e
356     check (SectionL e o)  = check e && check o
357     check (SectionR o e)  = check e && check o
358
359     check other           = True        -- Safe fall through
360
361 isOrphanDecl _ _  = False
362 \end{code}
363
364
365 %*********************************************************
366 %*                                                       *
367 \subsection{Fixities}
368 %*                                                       *
369 %*********************************************************
370
371 \begin{code}
372 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG LocalFixityEnv
373 fixitiesFromLocalDecls gbl_env decls
374   = foldlRn getFixities emptyNameEnv decls                              `thenRn` \ env -> 
375     traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts env)))    `thenRn_`
376     returnRn env
377   where
378     getFixities :: LocalFixityEnv -> RdrNameHsDecl -> RnMG LocalFixityEnv
379     getFixities acc (FixD fix)
380       = fix_decl acc fix
381
382     getFixities acc (TyClD (ClassDecl { tcdSigs = sigs}))
383       = foldlRn fix_decl acc [sig | FixSig sig <- sigs]
384                 -- Get fixities from class decl sigs too.
385     getFixities acc other_decl
386       = returnRn acc
387
388     fix_decl acc sig@(FixitySig rdr_name fixity loc)
389         =       -- Check for fixity decl for something not declared
390           pushSrcLocRn loc                      $
391           lookupSrcName gbl_env rdr_name        `thenRn` \ name ->
392
393                 -- Check for duplicate fixity decl
394           case lookupNameEnv acc name of
395             Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc')     `thenRn_`
396                                          returnRn acc ;
397
398             Nothing                   -> returnRn (extendNameEnv acc name (FixitySig name fixity loc))
399 \end{code}
400
401
402 %*********************************************************
403 %*                                                       *
404 \subsection{Deprecations}
405 %*                                                       *
406 %*********************************************************
407
408 For deprecations, all we do is check that the names are in scope.
409 It's only imported deprecations, dealt with in RnIfaces, that we
410 gather them together.
411
412 \begin{code}
413 rnDeprecs :: GlobalRdrEnv -> Maybe DeprecTxt
414            -> [RdrNameDeprecation] -> RnMG Deprecations
415 rnDeprecs gbl_env Nothing []
416  = returnRn NoDeprecs
417
418 rnDeprecs gbl_env (Just txt) decls
419  = mapRn (addErrRn . badDeprec) decls   `thenRn_` 
420    returnRn (DeprecAll txt)
421
422 rnDeprecs gbl_env Nothing decls
423   = mapRn rn_deprec decls       `thenRn` \ pairs ->
424     returnRn (DeprecSome (mkNameEnv (catMaybes pairs)))
425  where
426    rn_deprec (Deprecation rdr_name txt loc)
427      = pushSrcLocRn loc                         $
428        lookupSrcName gbl_env rdr_name           `thenRn` \ name ->
429        returnRn (Just (name, (name,txt)))
430 \end{code}
431
432
433 %************************************************************************
434 %*                                                                      *
435 \subsection{Grabbing the old interface file and checking versions}
436 %*                                                                      *
437 %************************************************************************
438
439 \begin{code}
440 checkOldIface :: GhciMode
441               -> DynFlags
442               -> HomeIfaceTable -> HomeSymbolTable
443               -> PersistentCompilerState
444               -> FilePath
445               -> Bool                   -- Source unchanged
446               -> Maybe ModIface         -- Old interface from compilation manager, if any
447               -> IO (PersistentCompilerState, Bool, (RecompileRequired, Maybe ModIface))
448                                 -- True <=> errors happened
449
450 checkOldIface ghci_mode dflags hit hst pcs iface_path source_unchanged maybe_iface
451     = runRn dflags hit hst pcs (panic "Bogus module") $
452
453         -- CHECK WHETHER THE SOURCE HAS CHANGED
454     ( if not source_unchanged then
455         traceHiDiffsRn (nest 4 (text "Source file changed or recompilation check turned off"))    
456       else returnRn () )   `thenRn_`
457
458      -- If the source has changed and we're in interactive mode, avoid reading
459      -- an interface; just return the one we might have been supplied with.
460     if ghci_mode == Interactive && not source_unchanged then
461          returnRn (outOfDate, maybe_iface)
462     else
463
464     case maybe_iface of
465        Just old_iface -> -- Use the one we already have
466                          setModuleRn (mi_module old_iface) (check_versions old_iface)
467
468        Nothing -- try and read it from a file
469           -> readIface iface_path       `thenRn` \ read_result ->
470              case read_result of
471                Left err -> -- Old interface file not found, or garbled; give up
472                            traceRn (text "Bad old interface file" $$ nest 4 err) `thenRn_`
473                            returnRn (outOfDate, Nothing)
474
475                Right parsed_iface
476                       -> setModuleRn (pi_mod parsed_iface) $
477                          loadOldIface parsed_iface `thenRn` \ m_iface ->
478                          check_versions m_iface
479     where
480        check_versions :: ModIface -> RnMG (RecompileRequired, Maybe ModIface)
481        check_versions iface
482           | not source_unchanged
483           = returnRn (outOfDate, Just iface)
484           | otherwise
485           = -- Check versions
486             recompileRequired iface_path iface  `thenRn` \ recompile ->
487             returnRn (recompile, Just iface)
488 \end{code}
489
490 I think the following function should now have a more representative name,
491 but what?
492
493 \begin{code}
494 loadOldIface :: ParsedIface -> RnMG ModIface
495
496 loadOldIface parsed_iface
497   = let iface = parsed_iface 
498         mod = pi_mod iface
499     in
500     initIfaceRnMS mod (
501         loadHomeDecls (pi_decls iface)  `thenRn` \ decls ->
502         loadHomeRules (pi_rules iface)  `thenRn` \ rules -> 
503         loadHomeInsts (pi_insts iface)  `thenRn` \ insts ->
504         returnRn (decls, rules, insts)
505     )   
506         `thenRn` \ ((decls_vers, new_decls), (rule_vers, new_rules), new_insts) ->
507
508     mapRn loadHomeUsage (pi_usages iface)       `thenRn` \ usages ->
509     loadExports         (pi_exports iface)      `thenRn` \ (export_vers, avails) ->
510     loadFixDecls mod    (pi_fixity iface)       `thenRn` \ fix_env ->
511     loadDeprecs mod     (pi_deprecs iface)      `thenRn` \ deprec_env ->
512     let
513         version = VersionInfo { vers_module  = pi_vers iface, 
514                                 vers_exports = export_vers,
515                                 vers_rules   = rule_vers,
516                                 vers_decls   = decls_vers }
517
518         decls = mkIfaceDecls new_decls new_rules new_insts
519
520         mod_iface = ModIface { mi_module = mod, mi_version = version,
521                                mi_exports = avails, mi_usages  = usages,
522                                mi_boot = False, mi_orphan = pi_orphan iface, 
523                                mi_fixities = fix_env, mi_deprecs = deprec_env,
524                                mi_decls   = decls,
525                                mi_globals = mkIfaceGlobalRdrEnv avails
526                     }
527     in
528     returnRn mod_iface
529 \end{code}
530
531 \begin{code}
532 loadHomeDecls :: [(Version, RdrNameTyClDecl)]
533               -> RnMS (NameEnv Version, [RenamedTyClDecl])
534 loadHomeDecls decls = foldlRn loadHomeDecl (emptyNameEnv, []) decls
535
536 loadHomeDecl :: (NameEnv Version, [RenamedTyClDecl])
537              -> (Version, RdrNameTyClDecl)
538              -> RnMS (NameEnv Version, [RenamedTyClDecl])
539 loadHomeDecl (version_map, decls) (version, decl)
540   = rnTyClDecl decl     `thenRn` \ decl' ->
541     returnRn (extendNameEnv version_map (tyClDeclName decl') version, decl':decls)
542
543 ------------------
544 loadHomeRules :: (Version, [RdrNameRuleDecl])
545               -> RnMS (Version, [RenamedRuleDecl])
546 loadHomeRules (version, rules)
547   = mapRn rnIfaceRuleDecl rules `thenRn` \ rules' ->
548     returnRn (version, rules')
549
550 ------------------
551 loadHomeInsts :: [RdrNameInstDecl]
552               -> RnMS [RenamedInstDecl]
553 loadHomeInsts insts = mapRn rnInstDecl insts
554
555 ------------------
556 loadHomeUsage :: ImportVersion OccName
557               -> RnMG (ImportVersion Name)
558 loadHomeUsage (mod_name, orphans, is_boot, whats_imported)
559   = rn_imps whats_imported      `thenRn` \ whats_imported' ->
560     returnRn (mod_name, orphans, is_boot, whats_imported')
561   where
562     rn_imps NothingAtAll                  = returnRn NothingAtAll
563     rn_imps (Everything v)                = returnRn (Everything v)
564     rn_imps (Specifically mv ev items rv) = mapRn rn_imp items  `thenRn` \ items' ->
565                                             returnRn (Specifically mv ev items' rv)
566     rn_imp (occ,vers) = newGlobalName mod_name occ      `thenRn` \ name ->
567                         returnRn (name,vers)
568 \end{code}
569
570
571
572 %*********************************************************
573 %*                                                       *
574 \subsection{Closing up the interface decls}
575 %*                                                       *
576 %*********************************************************
577
578 Suppose we discover we don't need to recompile.   Then we start from the
579 IfaceDecls in the ModIface, and fluff them up by sucking in all the decls they need.
580
581 \begin{code}
582 closeIfaceDecls :: DynFlags
583                 -> HomeIfaceTable -> HomeSymbolTable
584                 -> PersistentCompilerState
585                 -> ModIface     -- Get the decls from here
586                 -> IO (PersistentCompilerState, Bool, [RenamedHsDecl])
587                                 -- True <=> errors happened
588 closeIfaceDecls dflags hit hst pcs
589                 mod_iface@(ModIface { mi_module = mod, mi_decls = iface_decls })
590   = runRn dflags hit hst pcs mod $
591
592     let
593         rule_decls = dcl_rules iface_decls
594         inst_decls = dcl_insts iface_decls
595         tycl_decls = dcl_tycl  iface_decls
596         decls = map RuleD rule_decls ++
597                 map InstD inst_decls ++
598                 map TyClD tycl_decls
599         needed = unionManyNameSets (map ruleDeclFVs rule_decls) `unionNameSets`
600                  unionManyNameSets (map instDeclFVs inst_decls) `unionNameSets`
601                  unionManyNameSets (map tyClDeclFVs tycl_decls)
602         local_names    = foldl add emptyNameSet tycl_decls
603         add names decl = addListToNameSet names (map fst (tyClDeclSysNames decl ++ tyClDeclNames decl))
604     in
605
606     recordLocalSlurps local_names       `thenRn_`
607
608         -- Do the transitive closure
609     closeDecls decls (needed `plusFV` implicit_fvs) `thenRn` \closed_decls ->
610     rnDump [] closed_decls `thenRn_`
611     returnRn closed_decls
612   where
613     implicit_fvs = string_names -- Data type decls with record selectors,
614                                 -- which may appear in the decls, need unpackCString
615                                 -- and friends. It's easier to just grab them right now.
616 \end{code}
617
618 %*********************************************************
619 %*                                                       *
620 \subsection{Unused names}
621 %*                                                       *
622 %*********************************************************
623
624 \begin{code}
625 reportUnusedNames :: ModIface -> PrintUnqualified
626                   -> [RdrNameImportDecl] 
627                   -> AvailEnv
628                   -> NameSet            -- Used in this module
629                   -> Avails             -- Exported by this module
630                   -> [RenamedHsDecl] 
631                   -> RnMG ()
632 reportUnusedNames my_mod_iface unqual imports avail_env 
633                   source_fvs export_avails imported_decls
634   = warnUnusedModules unused_imp_mods                           `thenRn_`
635     warnUnusedLocalBinds bad_locals                             `thenRn_`
636     warnUnusedImports bad_imp_names                             `thenRn_`
637     printMinimalImports this_mod unqual minimal_imports         `thenRn_`
638     warnDeprecations this_mod export_avails my_deprecs 
639                      really_used_names
640
641   where
642     this_mod   = mi_module my_mod_iface
643     gbl_env    = mi_globals my_mod_iface
644     my_deprecs = mi_deprecs my_mod_iface
645     
646         -- The export_fvs make the exported names look just as if they
647         -- occurred in the source program.  
648     export_fvs = availsToNameSet export_avails
649     used_names = source_fvs `plusFV` export_fvs
650
651     -- Now, a use of C implies a use of T,
652     -- if C was brought into scope by T(..) or T(C)
653     really_used_names = used_names `unionNameSets`
654       mkNameSet [ parent_name
655                 | sub_name <- nameSetToList used_names
656     
657                 -- Usually, every used name will appear in avail_env, but there 
658                 -- is one time when it doesn't: tuples and other built in syntax.  When you
659                 -- write (a,b) that gives rise to a *use* of "(,)", so that the
660                 -- instances will get pulled in, but the tycon "(,)" isn't actually
661                 -- in scope.  Also, (-x) gives rise to an implicit use of 'negate'; 
662                 -- similarly,   3.5 gives rise to an implcit use of :%
663                 -- Hence the silent 'False' in all other cases
664               
665                 , Just parent_name <- [case lookupNameEnv avail_env sub_name of
666                                         Just (AvailTC n _) -> Just n
667                                         other              -> Nothing]
668             ]
669     
670         -- Collect the defined names from the in-scope environment
671         -- Look for the qualified ones only, else get duplicates
672     defined_names :: [(Name,Provenance)]
673     defined_names = foldRdrEnv add [] gbl_env
674     add rdr_name ns acc | isQual rdr_name = ns ++ acc
675                         | otherwise       = acc
676
677     defined_and_used, defined_but_not_used :: [(Name,Provenance)]
678     (defined_and_used, defined_but_not_used) = partition used defined_names
679     used (name,_)                            = name `elemNameSet` really_used_names
680     
681     -- Filter out the ones only defined implicitly
682     bad_locals :: [Name]
683     bad_locals     = [n     | (n,LocalDef) <- defined_but_not_used]
684     
685     bad_imp_names :: [(Name,Provenance)]
686     bad_imp_names  = [(n,p) | (n,p@(NonLocalDef (UserImport mod _ True))) <- defined_but_not_used,
687                               not (module_unused mod)]
688     
689     -- inst_mods are directly-imported modules that 
690     --  contain instance decl(s) that the renamer decided to suck in
691     -- It's not necessarily redundant to import such modules.
692     --
693     -- NOTE: Consider 
694     --        module This
695     --          import M ()
696     --
697     --   The import M() is not *necessarily* redundant, even if
698     --   we suck in no instance decls from M (e.g. it contains 
699     --   no instance decls, or This contains no code).  It may be 
700     --   that we import M solely to ensure that M's orphan instance 
701     --   decls (or those in its imports) are visible to people who 
702     --   import This.  Sigh. 
703     --   There's really no good way to detect this, so the error message 
704     --   in RnEnv.warnUnusedModules is weakened instead
705     inst_mods :: [ModuleName]
706     inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
707                  let m = moduleName (nameModule dfun),
708                  m `elem` direct_import_mods
709             ]
710     
711     -- To figure out the minimal set of imports, start with the things
712     -- that are in scope (i.e. in gbl_env).  Then just combine them
713     -- into a bunch of avails, so they are properly grouped
714     minimal_imports :: FiniteMap ModuleName AvailEnv
715     minimal_imports0 = emptyFM
716     minimal_imports1 = foldr add_name     minimal_imports0 defined_and_used
717     minimal_imports  = foldr add_inst_mod minimal_imports1 inst_mods
718     
719         -- We've carefully preserved the provenance so that we can
720         -- construct minimal imports that import the name by (one of)
721         -- the same route(s) as the programmer originally did.
722     add_name (n,NonLocalDef (UserImport m _ _)) acc = addToFM_C plusAvailEnv acc (moduleName m)
723                                                                 (unitAvailEnv (mk_avail n))
724     add_name (n,other_prov)                     acc = acc
725
726     mk_avail n = case lookupNameEnv avail_env n of
727                 Just (AvailTC m _) | n==m      -> AvailTC n [n]
728                                    | otherwise -> AvailTC m [n,m]
729                 Just avail         -> Avail n
730                 Nothing            -> pprPanic "mk_avail" (ppr n)
731     
732     add_inst_mod m acc 
733       | m `elemFM` acc = acc    -- We import something already
734       | otherwise      = addToFM acc m emptyAvailEnv
735         -- Add an empty collection of imports for a module
736         -- from which we have sucked only instance decls
737    
738     direct_import_mods :: [ModuleName]
739     direct_import_mods = nub [m | ImportDecl m _ _ _ _ _ <- imports]
740
741     -- unused_imp_mods are the directly-imported modules 
742     -- that are not mentioned in minimal_imports
743     unused_imp_mods = [m | m <- direct_import_mods,
744                        not (maybeToBool (lookupFM minimal_imports m)),
745                        m /= pRELUDE_Name]
746     
747     module_unused :: Module -> Bool
748     module_unused mod = moduleName mod `elem` unused_imp_mods
749
750 warnDeprecations this_mod export_avails my_deprecs used_names
751   = doptRn Opt_WarnDeprecations                         `thenRn` \ warn_drs ->
752     if not warn_drs then returnRn () else
753
754         -- The home modules for things in the export list
755         -- may not have been loaded yet; do it now, so 
756         -- that we can see their deprecations, if any
757     mapRn_ load_home export_mods                `thenRn_`
758
759     getIfacesRn                                 `thenRn` \ ifaces ->
760     getHomeIfaceTableRn                         `thenRn` \ hit ->
761     let
762         pit     = iPIT ifaces
763         deprecs = [ (n,txt)
764                   | n <- nameSetToList used_names,
765                     not (nameIsLocalOrFrom this_mod n),
766                     Just txt <- [lookup_deprec hit pit n] ]
767         -- nameIsLocalOrFrom: don't complain about locally defined names
768         -- For a start, we may be exporting a deprecated thing
769         -- Also we may use a deprecated thing in the defn of another
770         -- deprecated things.  We may even use a deprecated thing in
771         -- the defn of a non-deprecated thing, when changing a module's 
772         -- interface
773     in                    
774     mapRn_ warnDeprec deprecs
775
776   where
777     export_mods = nub [ moduleName mod
778                       | avail <- export_avails,
779                         let mod = nameModule (availName avail),
780                         mod /= this_mod ]
781   
782     load_home m = loadInterface (text "Check deprecations for" <+> ppr m) m ImportBySystem
783
784     lookup_deprec hit pit n
785         = case lookupIface hit pit n of
786                 Just iface -> lookupDeprec (mi_deprecs iface) n
787                 Nothing    -> pprPanic "warnDeprecations:" (ppr n)
788
789 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
790 printMinimalImports this_mod unqual imps
791   = doptRn Opt_D_dump_minimal_imports           `thenRn` \ dump_minimal ->
792     if not dump_minimal then returnRn () else
793
794     mapRn to_ies (fmToList imps)                `thenRn` \ mod_ies ->
795     ioToRnM (do { h <- openFile filename WriteMode ;
796                   printForUser h unqual (vcat (map ppr_mod_ie mod_ies))
797         })                                      `thenRn_`
798     returnRn ()
799   where
800     filename = moduleNameUserString (moduleName this_mod) ++ ".imports"
801     ppr_mod_ie (mod_name, ies) 
802         | mod_name == pRELUDE_Name 
803         = empty
804         | otherwise
805         = ptext SLIT("import") <+> ppr mod_name <> 
806                             parens (fsep (punctuate comma (map ppr ies)))
807
808     to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env)      `thenRn` \ ies ->
809                               returnRn (mod, ies)
810
811     to_ie :: AvailInfo -> RnMG (IE Name)
812     to_ie (Avail n)       = returnRn (IEVar n)
813     to_ie (AvailTC n [m]) = ASSERT( n==m ) 
814                             returnRn (IEThingAbs n)
815     to_ie (AvailTC n ns)  
816         = getInterfaceExports n_mod ImportBySystem              `thenRn` \ (_, avails_by_module) ->
817           case [xs | (m,as) <- avails_by_module,
818                      m == n_mod,
819                      AvailTC x xs <- as, 
820                      x == n] of
821               [xs] | all (`elem` ns) xs -> returnRn (IEThingAll n)
822                    | otherwise          -> returnRn (IEThingWith n (filter (/= n) ns))
823               other                     -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
824                                            returnRn (IEVar n)
825         where
826           n_mod = moduleName (nameModule n)
827
828 rnDump  :: [RenamedHsDecl]      -- Renamed imported decls
829         -> [RenamedHsDecl]      -- Renamed local decls
830         -> RnMG ()
831 rnDump imp_decls local_decls
832   = doptRn Opt_D_dump_rn_trace  `thenRn` \ dump_rn_trace ->
833     doptRn Opt_D_dump_rn_stats  `thenRn` \ dump_rn_stats ->
834     doptRn Opt_D_dump_rn        `thenRn` \ dump_rn ->
835     getIfacesRn                 `thenRn` \ ifaces ->
836
837     ioToRnM (do { dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
838                             "Renamer statistics"
839                             (getRnStats imp_decls ifaces) ;
840
841                   dumpIfSet dump_rn "Renamer:" 
842                             (vcat (map ppr (local_decls ++ imp_decls)))
843     })                          `thenRn_`
844
845     returnRn ()
846 \end{code}
847
848
849 %*********************************************************
850 %*                                                      *
851 \subsection{Statistics}
852 %*                                                      *
853 %*********************************************************
854
855 \begin{code}
856 getRnStats :: [RenamedHsDecl] -> Ifaces -> SDoc
857 getRnStats imported_decls ifaces
858   = hcat [text "Renamer stats: ", stats]
859   where
860     n_mods = length [() | _ <- moduleEnvElts (iPIT ifaces)]
861         -- This is really only right for a one-shot compile
862
863     (decls_map, n_decls_slurped) = iDecls ifaces
864     
865     n_decls_left   = length [decl | (avail, True, (_,decl)) <- nameEnvElts decls_map
866                         -- Data, newtype, and class decls are in the decls_fm
867                         -- under multiple names; the tycon/class, and each
868                         -- constructor/class op too.
869                         -- The 'True' selects just the 'main' decl
870                      ]
871     
872     (insts_left, n_insts_slurped) = iInsts ifaces
873     n_insts_left  = length (bagToList insts_left)
874     
875     (rules_left, n_rules_slurped) = iRules ifaces
876     n_rules_left  = length (bagToList rules_left)
877     
878     stats = vcat 
879         [int n_mods <+> text "interfaces read",
880          hsep [ int n_decls_slurped, text "type/class/variable imported, out of", 
881                 int (n_decls_slurped + n_decls_left), text "read"],
882          hsep [ int n_insts_slurped, text "instance decls imported, out of",  
883                 int (n_insts_slurped + n_insts_left), text "read"],
884          hsep [ int n_rules_slurped, text "rule decls imported, out of",  
885                 int (n_rules_slurped + n_rules_left), text "read"]
886         ]
887 \end{code}    
888
889
890 %************************************************************************
891 %*                                                                      *
892 \subsection{Errors and warnings}
893 %*                                                                      *
894 %************************************************************************
895
896 \begin{code}
897 warnDeprec :: (Name, DeprecTxt) -> RnM d ()
898 warnDeprec (name, txt)
899   = pushSrcLocRn (getSrcLoc name)       $
900     addWarnRn                           $
901     sep [ text (occNameFlavour (nameOccName name)) <+> quotes (ppr name) <+>
902           text "is deprecated:", nest 4 (ppr txt) ]
903
904
905 dupFixityDecl rdr_name loc1 loc2
906   = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
907           ptext SLIT("at ") <+> ppr loc1,
908           ptext SLIT("and") <+> ppr loc2]
909
910 badDeprec d
911   = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),
912          nest 4 (ppr d)]
913 \end{code}
914
915