Warning fix for unused and redundant imports
[ghc-hetmet.git] / compiler / iface / LoadIface.lhs
1 %
2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 %
5
6 Loading interface files
7
8 \begin{code}
9 module LoadIface (
10         loadInterface, loadInterfaceForName, loadWiredInHomeIface, 
11         loadSrcInterface, loadSysInterface, loadOrphanModules, 
12         findAndReadIface, readIface,    -- Used when reading the module's old interface
13         loadDecls,      -- Should move to TcIface and be renamed
14         initExternalPackageState,
15
16         ifaceStats, pprModIface, showIface
17    ) where
18
19 #include "HsVersions.h"
20
21 import {-# SOURCE #-}   TcIface( tcIfaceDecl, tcIfaceRules, tcIfaceInst, 
22                                  tcIfaceFamInst, tcIfaceVectInfo )
23
24 import DynFlags
25 import IfaceSyn
26 import IfaceEnv
27 import HscTypes
28
29 import BasicTypes hiding (SuccessFlag(..))
30 import TcRnMonad
31 import Type
32
33 import PrelNames
34 import PrelInfo
35 import PrelRules
36 import Rules
37 import InstEnv
38 import FamInstEnv
39 import Name
40 import NameEnv
41 import MkId
42 import Module
43 import OccName
44 import SrcLoc
45 import Maybes
46 import ErrUtils
47 import Finder
48 import UniqFM
49 import StaticFlags
50 import Outputable
51 import BinIface
52 import Panic
53
54 import Data.List
55 import Data.Maybe
56 import Data.IORef
57 \end{code}
58
59
60 %************************************************************************
61 %*                                                                      *
62         loadSrcInterface, loadOrphanModules, loadHomeInterface
63
64                 These three are called from TcM-land    
65 %*                                                                      *
66 %************************************************************************
67
68 \begin{code}
69 -- | Load the interface corresponding to an @import@ directive in 
70 -- source code.  On a failure, fail in the monad with an error message.
71 loadSrcInterface :: SDoc -> ModuleName -> IsBootInterface -> RnM ModIface
72 loadSrcInterface doc mod want_boot  = do        
73   -- We must first find which Module this import refers to.  This involves
74   -- calling the Finder, which as a side effect will search the filesystem
75   -- and create a ModLocation.  If successful, loadIface will read the
76   -- interface; it will call the Finder again, but the ModLocation will be
77   -- cached from the first search.
78   hsc_env <- getTopEnv
79   res <- ioToIOEnv $ findImportedModule hsc_env mod Nothing
80   case res of
81     Found _ mod -> do
82       mb_iface <- initIfaceTcRn $ loadInterface doc mod (ImportByUser want_boot)
83       case mb_iface of
84         Failed err      -> failWithTc err
85         Succeeded iface -> return iface
86     err ->
87         let dflags = hsc_dflags hsc_env in
88         failWithTc (cannotFindInterface dflags mod err)
89
90 -- | Load interfaces for a collection of orphan modules.
91 loadOrphanModules :: [Module]         -- the modules
92                   -> Bool             -- these are family instance-modules
93                   -> TcM ()
94 loadOrphanModules mods isFamInstMod
95   | null mods = returnM ()
96   | otherwise = initIfaceTcRn $
97                 do { traceIf (text "Loading orphan modules:" <+> 
98                                  fsep (map ppr mods))
99                    ; mappM_ load mods
100                    ; returnM () }
101   where
102     load mod   = loadSysInterface (mk_doc mod) mod
103     mk_doc mod 
104       | isFamInstMod = ppr mod <+> ptext SLIT("is a family-instance module")
105       | otherwise    = ppr mod <+> ptext SLIT("is a orphan-instance module")
106
107 -- | Loads the interface for a given Name.
108 loadInterfaceForName :: SDoc -> Name -> TcRn ModIface
109 loadInterfaceForName doc name
110   = do  { 
111 #ifdef DEBUG
112                 -- Should not be called with a name from the module being compiled
113           this_mod <- getModule
114         ; ASSERT2( not (nameIsLocalOrFrom this_mod name), ppr name <+> parens doc )
115 #endif
116           initIfaceTcRn $ loadSysInterface doc (nameModule name)
117     }
118
119 -- | An 'IfM' function to load the home interface for a wired-in thing,
120 -- so that we're sure that we see its instance declarations and rules
121 loadWiredInHomeIface :: Name -> IfM lcl ()
122 loadWiredInHomeIface name
123   = ASSERT( isWiredInName name )
124     do loadSysInterface doc (nameModule name); return ()
125   where
126     doc = ptext SLIT("Need home interface for wired-in thing") <+> ppr name
127
128 -- | A wrapper for 'loadInterface' that throws an exception if it fails
129 loadSysInterface :: SDoc -> Module -> IfM lcl ModIface
130 loadSysInterface doc mod_name
131   = do  { mb_iface <- loadInterface doc mod_name ImportBySystem
132         ; case mb_iface of 
133             Failed err      -> ghcError (ProgramError (showSDoc err))
134             Succeeded iface -> return iface }
135 \end{code}
136
137
138 %*********************************************************
139 %*                                                      *
140                 loadInterface
141
142         The main function to load an interface
143         for an imported module, and put it in
144         the External Package State
145 %*                                                      *
146 %*********************************************************
147
148 \begin{code}
149 loadInterface :: SDoc -> Module -> WhereFrom
150               -> IfM lcl (MaybeErr Message ModIface)
151
152 -- loadInterface looks in both the HPT and PIT for the required interface
153 -- If not found, it loads it, and puts it in the PIT (always). 
154
155 -- If it can't find a suitable interface file, we
156 --      a) modify the PackageIfaceTable to have an empty entry
157 --              (to avoid repeated complaints)
158 --      b) return (Left message)
159 --
160 -- It's not necessarily an error for there not to be an interface
161 -- file -- perhaps the module has changed, and that interface 
162 -- is no longer used
163
164 loadInterface doc_str mod from
165   = do  {       -- Read the state
166           (eps,hpt) <- getEpsAndHpt
167
168         ; traceIf (text "Considering whether to load" <+> ppr mod <+> ppr from)
169
170                 -- Check whether we have the interface already
171         ; dflags <- getDOpts
172         ; case lookupIfaceByModule dflags hpt (eps_PIT eps) mod of {
173             Just iface 
174                 -> returnM (Succeeded iface) ;  -- Already loaded
175                         -- The (src_imp == mi_boot iface) test checks that the already-loaded
176                         -- interface isn't a boot iface.  This can conceivably happen,
177                         -- if an earlier import had a before we got to real imports.   I think.
178             other -> do {
179
180           let { hi_boot_file = case from of
181                                 ImportByUser usr_boot -> usr_boot
182                                 ImportBySystem        -> sys_boot
183
184               ; mb_dep   = lookupUFM (eps_is_boot eps) (moduleName mod)
185               ; sys_boot = case mb_dep of
186                                 Just (_, is_boot) -> is_boot
187                                 Nothing           -> False
188                         -- The boot-ness of the requested interface, 
189               }         -- based on the dependencies in directly-imported modules
190
191         -- READ THE MODULE IN
192         ; read_result <- findAndReadIface doc_str mod hi_boot_file
193         ; case read_result of {
194             Failed err -> do
195                 { let fake_iface = emptyModIface mod
196
197                 ; updateEps_ $ \eps ->
198                         eps { eps_PIT = extendModuleEnv (eps_PIT eps) (mi_module fake_iface) fake_iface }
199                         -- Not found, so add an empty iface to 
200                         -- the EPS map so that we don't look again
201                                 
202                 ; returnM (Failed err) } ;
203
204         -- Found and parsed!
205             Succeeded (iface, file_path)        -- Sanity check:
206                 | ImportBySystem <- from,       --   system-importing...
207                   modulePackageId (mi_module iface) == thisPackage dflags,
208                                                 --   a home-package module...
209                   Nothing <- mb_dep             --   that we know nothing about
210                 -> returnM (Failed (badDepMsg mod))
211
212                 | otherwise ->
213
214         let 
215             loc_doc = text file_path
216         in 
217         initIfaceLcl mod loc_doc $ do
218
219         --      Load the new ModIface into the External Package State
220         -- Even home-package interfaces loaded by loadInterface 
221         --      (which only happens in OneShot mode; in Batch/Interactive 
222         --      mode, home-package modules are loaded one by one into the HPT)
223         -- are put in the EPS.
224         --
225         -- The main thing is to add the ModIface to the PIT, but
226         -- we also take the
227         --      IfaceDecls, IfaceInst, IfaceFamInst, IfaceRules, IfaceVectInfo
228         -- out of the ModIface and put them into the big EPS pools
229
230         -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
231         ---    names is done correctly (notably, whether this is an .hi file or .hi-boot file).
232         --     If we do loadExport first the wrong info gets into the cache (unless we
233         --      explicitly tag each export which seems a bit of a bore)
234
235         ; ignore_prags      <- doptM Opt_IgnoreInterfacePragmas
236         ; new_eps_decls     <- loadDecls ignore_prags (mi_decls iface)
237         ; new_eps_insts     <- mapM tcIfaceInst (mi_insts iface)
238         ; new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
239         ; new_eps_rules     <- tcIfaceRules ignore_prags (mi_rules iface)
240         ; new_eps_vect_info <- tcIfaceVectInfo mod (mkNameEnv new_eps_decls) 
241                                                (mi_vect_info iface)
242
243         ; let { final_iface = iface {   
244                                 mi_decls     = panic "No mi_decls in PIT",
245                                 mi_insts     = panic "No mi_insts in PIT",
246                                 mi_fam_insts = panic "No mi_fam_insts in PIT",
247                                 mi_rules     = panic "No mi_rules in PIT"
248                               }
249                }
250
251         ; updateEps_  $ \ eps -> 
252             eps { 
253               eps_PIT          = extendModuleEnv (eps_PIT eps) mod final_iface,
254               eps_PTE          = addDeclsToPTE   (eps_PTE eps) new_eps_decls,
255               eps_rule_base    = extendRuleBaseList (eps_rule_base eps) 
256                                                     new_eps_rules,
257               eps_inst_env     = extendInstEnvList (eps_inst_env eps)  
258                                                    new_eps_insts,
259               eps_fam_inst_env = extendFamInstEnvList (eps_fam_inst_env eps)
260                                                       new_eps_fam_insts,
261               eps_vect_info    = plusVectInfo (eps_vect_info eps) 
262                                               new_eps_vect_info,
263               eps_mod_fam_inst_env
264                                = let
265                                    fam_inst_env = 
266                                      extendFamInstEnvList emptyFamInstEnv
267                                                           new_eps_fam_insts
268                                  in
269                                  extendModuleEnv (eps_mod_fam_inst_env eps)
270                                                  mod
271                                                  fam_inst_env,
272               eps_stats        = addEpsInStats (eps_stats eps) 
273                                                (length new_eps_decls)
274               (length new_eps_insts) (length new_eps_rules) }
275
276         ; return (Succeeded final_iface)
277     }}}}
278
279 badDepMsg mod 
280   = hang (ptext SLIT("Interface file inconsistency:"))
281        2 (sep [ptext SLIT("home-package module") <+> quotes (ppr mod) <+> ptext SLIT("is mentioned is needed,"), 
282                ptext SLIT("but is not among the dependencies of interfaces directly imported by the module being compiled")])
283
284 -----------------------------------------------------
285 --      Loading type/class/value decls
286 -- We pass the full Module name here, replete with
287 -- its package info, so that we can build a Name for
288 -- each binder with the right package info in it
289 -- All subsequent lookups, including crucially lookups during typechecking
290 -- the declaration itself, will find the fully-glorious Name
291 --
292 -- We handle ATs specially.  They are not main declarations, but also not
293 -- implict things (in particular, adding them to `implicitTyThings' would mess
294 -- things up in the renaming/type checking of source programs).
295 -----------------------------------------------------
296
297 addDeclsToPTE :: PackageTypeEnv -> [(Name,TyThing)] -> PackageTypeEnv
298 addDeclsToPTE pte things = extendNameEnvList pte things
299
300 loadDecls :: Bool
301           -> [(Version, IfaceDecl)]
302           -> IfL [(Name,TyThing)]
303 loadDecls ignore_prags ver_decls
304    = do { mod <- getIfModule
305         ; thingss <- mapM (loadDecl ignore_prags mod) ver_decls
306         ; return (concat thingss)
307         }
308
309 loadDecl :: Bool                    -- Don't load pragmas into the decl pool
310          -> Module
311           -> (Version, IfaceDecl)
312           -> IfL [(Name,TyThing)]   -- The list can be poked eagerly, but the
313                                     -- TyThings are forkM'd thunks
314 loadDecl ignore_prags mod (_version, decl)
315   = do  {       -- Populate the name cache with final versions of all 
316                 -- the names associated with the decl
317           main_name      <- mk_new_bndr mod (ifName decl)
318 --        ; traceIf (text "Loading decl for " <> ppr main_name)
319         ; implicit_names <- mapM (mk_new_bndr mod) (ifaceDeclSubBndrs decl)
320
321         -- Typecheck the thing, lazily
322         -- NB. Firstly, the laziness is there in case we never need the
323         -- declaration (in one-shot mode), and secondly it is there so that 
324         -- we don't look up the occurrence of a name before calling mk_new_bndr
325         -- on the binder.  This is important because we must get the right name
326         -- which includes its nameParent.
327
328         ; thing <- forkM doc $ do { bumpDeclStats main_name
329                                   ; tcIfaceDecl ignore_prags decl }
330
331         -- Populate the type environment with the implicitTyThings too.
332         -- 
333         -- Note [Tricky iface loop]
334         -- ~~~~~~~~~~~~~~~~~~~~~~~~
335         -- The delicate point here is that 'mini-env' should be
336         -- buildable from 'thing' without demanding any of the things 'forkM'd 
337         -- by tcIfaceDecl.  For example
338         --      class C a where { data T a; op :: T a -> Int }
339         -- We return the bindings
340         --      [("C", <cls>), ("T", lookup env "T"), ("op", lookup env "op")]
341         -- The call (lookup env "T") must return the tycon T without first demanding
342         -- op; because getting the latter will look up T, hence loop.
343         --
344         -- Of course, there is no reason in principle why (lookup env "T") should demand
345         -- anything do to with op, but take care: 
346         --      (a) implicitTyThings, and 
347         --      (b) getOccName of all the things returned by implicitThings, 
348         -- must not depend on any of the nested type-checks
349         -- 
350         -- All a bit too finely-balanced for my liking.
351
352         ; let mini_env = mkOccEnv [(getOccName t, t) | t <- implicitTyThings thing]
353               lookup n = case lookupOccEnv mini_env (getOccName n) of
354                            Just thing -> thing
355                            Nothing    -> 
356                              pprPanic "loadDecl" (ppr main_name <+> ppr n $$ ppr (decl))
357
358         ; returnM $ (main_name, thing) :  [(n, lookup n) | n <- implicit_names]
359         }
360                 -- We build a list from the *known* names, with (lookup n) thunks
361                 -- as the TyThings.  That way we can extend the PTE without poking the
362                 -- thunks
363   where
364         -- mk_new_bndr allocates in the name cache the final canonical
365         -- name for the thing, with the correct 
366         --      * parent
367         --      * location
368         -- imported name, to fix the module correctly in the cache
369     mk_new_bndr mod occ 
370         = newGlobalBinder mod occ 
371                           (importedSrcLoc (showSDoc (ppr (moduleName mod))))
372                         -- ToDo: qualify with the package name if necessary
373
374     doc = ptext SLIT("Declaration for") <+> ppr (ifName decl)
375
376 bumpDeclStats :: Name -> IfL ()         -- Record that one more declaration has actually been used
377 bumpDeclStats name
378   = do  { traceIf (text "Loading decl for" <+> ppr name)
379         ; updateEps_ (\eps -> let stats = eps_stats eps
380                               in eps { eps_stats = stats { n_decls_out = n_decls_out stats + 1 } })
381         }
382 \end{code}
383
384
385 %*********************************************************
386 %*                                                      *
387 \subsection{Reading an interface file}
388 %*                                                      *
389 %*********************************************************
390
391 \begin{code}
392 findAndReadIface :: SDoc -> Module
393                  -> IsBootInterface     -- True  <=> Look for a .hi-boot file
394                                         -- False <=> Look for .hi file
395                  -> TcRnIf gbl lcl (MaybeErr Message (ModIface, FilePath))
396         -- Nothing <=> file not found, or unreadable, or illegible
397         -- Just x  <=> successfully found and parsed 
398
399         -- It *doesn't* add an error to the monad, because 
400         -- sometimes it's ok to fail... see notes with loadInterface
401
402 findAndReadIface doc_str mod hi_boot_file
403   = do  { traceIf (sep [hsep [ptext SLIT("Reading"), 
404                               if hi_boot_file 
405                                 then ptext SLIT("[boot]") 
406                                 else empty,
407                               ptext SLIT("interface for"), 
408                               ppr mod <> semi],
409                         nest 4 (ptext SLIT("reason:") <+> doc_str)])
410
411         -- Check for GHC.Prim, and return its static interface
412         ; dflags <- getDOpts
413         ; if mod == gHC_PRIM
414           then returnM (Succeeded (ghcPrimIface, 
415                                    "<built in interface for GHC.Prim>"))
416           else do
417
418         -- Look for the file
419         ; hsc_env <- getTopEnv
420         ; mb_found <- ioToIOEnv (findExactModule hsc_env mod)
421         ; case mb_found of {
422               
423               err | notFound err -> do
424                 { traceIf (ptext SLIT("...not found"))
425                 ; dflags <- getDOpts
426                 ; returnM (Failed (cannotFindInterface dflags 
427                                         (moduleName mod) err)) } ;
428               Found loc mod -> do 
429
430         -- Found file, so read it
431         { let { file_path = addBootSuffix_maybe hi_boot_file (ml_hi_file loc) }
432
433         ; if thisPackage dflags == modulePackageId mod
434                 && not (isOneShot (ghcMode dflags))
435             then returnM (Failed (homeModError mod loc))
436             else do {
437
438         ; traceIf (ptext SLIT("readIFace") <+> text file_path)
439         ; read_result <- readIface mod file_path hi_boot_file
440         ; case read_result of
441             Failed err -> returnM (Failed (badIfaceFile file_path err))
442             Succeeded iface 
443                 | mi_module iface /= mod ->
444                   return (Failed (wrongIfaceModErr iface mod file_path))
445                 | otherwise ->
446                   returnM (Succeeded (iface, file_path))
447                         -- Don't forget to fill in the package name...
448         }}}}
449
450 notFound (Found _ _) = False
451 notFound _ = True
452 \end{code}
453
454 @readIface@ tries just the one file.
455
456 \begin{code}
457 readIface :: Module -> FilePath -> IsBootInterface 
458           -> TcRnIf gbl lcl (MaybeErr Message ModIface)
459         -- Failed err    <=> file not found, or unreadable, or illegible
460         -- Succeeded iface <=> successfully found and parsed 
461
462 readIface wanted_mod file_path is_hi_boot_file
463   = do  { dflags <- getDOpts
464         ; res <- tryMostM $ readBinIface file_path
465         ; case res of
466             Right iface 
467                 | wanted_mod == actual_mod -> return (Succeeded iface)
468                 | otherwise                -> return (Failed err)
469                 where
470                   actual_mod = mi_module iface
471                   err = hiModuleNameMismatchWarn wanted_mod actual_mod
472
473             Left exn    -> return (Failed (text (showException exn)))
474     }
475 \end{code}
476
477
478 %*********************************************************
479 %*                                                       *
480         Wired-in interface for GHC.Prim
481 %*                                                       *
482 %*********************************************************
483
484 \begin{code}
485 initExternalPackageState :: ExternalPackageState
486 initExternalPackageState
487   = EPS { 
488       eps_is_boot      = emptyUFM,
489       eps_PIT          = emptyPackageIfaceTable,
490       eps_PTE          = emptyTypeEnv,
491       eps_inst_env     = emptyInstEnv,
492       eps_fam_inst_env = emptyFamInstEnv,
493       eps_rule_base    = mkRuleBase builtinRules,
494         -- Initialise the EPS rule pool with the built-in rules
495       eps_mod_fam_inst_env
496                        = emptyModuleEnv,
497       eps_vect_info    = noVectInfo,
498       eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0
499                            , n_insts_in = 0, n_insts_out = 0
500                            , n_rules_in = length builtinRules, n_rules_out = 0 }
501     }
502 \end{code}
503
504
505 %*********************************************************
506 %*                                                       *
507         Wired-in interface for GHC.Prim
508 %*                                                       *
509 %*********************************************************
510
511 \begin{code}
512 ghcPrimIface :: ModIface
513 ghcPrimIface
514   = (emptyModIface gHC_PRIM) {
515         mi_exports  = [(gHC_PRIM, ghcPrimExports)],
516         mi_decls    = [],
517         mi_fixities = fixities,
518         mi_fix_fn  = mkIfaceFixCache fixities
519     }           
520   where
521     fixities = [(getOccName seqId, Fixity 0 InfixR)]
522                         -- seq is infixr 0
523 \end{code}
524
525 %*********************************************************
526 %*                                                      *
527 \subsection{Statistics}
528 %*                                                      *
529 %*********************************************************
530
531 \begin{code}
532 ifaceStats :: ExternalPackageState -> SDoc
533 ifaceStats eps 
534   = hcat [text "Renamer stats: ", msg]
535   where
536     stats = eps_stats eps
537     msg = vcat 
538         [int (n_ifaces_in stats) <+> text "interfaces read",
539          hsep [ int (n_decls_out stats), text "type/class/variable imported, out of", 
540                 int (n_decls_in stats), text "read"],
541          hsep [ int (n_insts_out stats), text "instance decls imported, out of",  
542                 int (n_insts_in stats), text "read"],
543          hsep [ int (n_rules_out stats), text "rule decls imported, out of",  
544                 int (n_rules_in stats), text "read"]
545         ]
546 \end{code}
547
548
549 %************************************************************************
550 %*                                                                      *
551                 Printing interfaces
552 %*                                                                      *
553 %************************************************************************
554
555 \begin{code}
556 -- | Read binary interface, and print it out
557 showIface :: HscEnv -> FilePath -> IO ()
558 showIface hsc_env filename = do
559    -- skip the version check; we don't want to worry about profiled vs.
560    -- non-profiled interfaces, for example.
561    writeIORef v_IgnoreHiWay True
562    iface <- initTcRnIf 's' hsc_env () () $ readBinIface  filename
563    printDump (pprModIface iface)
564 \end{code}
565
566 \begin{code}
567 pprModIface :: ModIface -> SDoc
568 -- Show a ModIface
569 pprModIface iface
570  = vcat [ ptext SLIT("interface")
571                 <+> ppr (mi_module iface) <+> pp_boot 
572                 <+> ppr (mi_mod_vers iface) <+> pp_sub_vers
573                 <+> (if mi_orphan iface then ptext SLIT("[orphan module]") else empty)
574                 <+> (if mi_finsts iface then ptext SLIT("[family instance module]") else empty)
575                 <+> integer opt_HiVersion
576                 <+> ptext SLIT("where")
577         , vcat (map pprExport (mi_exports iface))
578         , pprDeps (mi_deps iface)
579         , vcat (map pprUsage (mi_usages iface))
580         , pprFixities (mi_fixities iface)
581         , vcat (map pprIfaceDecl (mi_decls iface))
582         , vcat (map ppr (mi_insts iface))
583         , vcat (map ppr (mi_fam_insts iface))
584         , vcat (map ppr (mi_rules iface))
585         , pprVectInfo (mi_vect_info iface)
586         , pprDeprecs (mi_deprecs iface)
587         ]
588   where
589     pp_boot | mi_boot iface = ptext SLIT("[boot]")
590             | otherwise     = empty
591
592     exp_vers  = mi_exp_vers iface
593     rule_vers = mi_rule_vers iface
594
595     pp_sub_vers | exp_vers == initialVersion && rule_vers == initialVersion = empty
596                 | otherwise = brackets (ppr exp_vers <+> ppr rule_vers)
597 \end{code}
598
599 When printing export lists, we print like this:
600         Avail   f               f
601         AvailTC C [C, x, y]     C(x,y)
602         AvailTC C [x, y]        C!(x,y)         -- Exporting x, y but not C
603
604 \begin{code}
605 pprExport :: IfaceExport -> SDoc
606 pprExport (mod, items)
607  = hsep [ ptext SLIT("export"), ppr mod, hsep (map pp_avail items) ]
608   where
609     pp_avail :: GenAvailInfo OccName -> SDoc
610     pp_avail (Avail occ)    = ppr occ
611     pp_avail (AvailTC _ []) = empty
612     pp_avail (AvailTC n (n':ns)) 
613         | n==n'     = ppr n <> pp_export ns
614         | otherwise = ppr n <> char '|' <> pp_export (n':ns)
615     
616     pp_export []    = empty
617     pp_export names = braces (hsep (map ppr names))
618
619 pprUsage :: Usage -> SDoc
620 pprUsage usage
621   = hsep [ptext SLIT("import"), ppr (usg_name usage), 
622           int (usg_mod usage), 
623           pp_export_version (usg_exports usage),
624           int (usg_rules usage),
625           pp_versions (usg_entities usage) ]
626   where
627     pp_versions nvs = hsep [ ppr n <+> int v | (n,v) <- nvs ]
628     pp_export_version Nothing  = empty
629     pp_export_version (Just v) = int v
630
631 pprDeps :: Dependencies -> SDoc
632 pprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs,
633                 dep_finsts = finsts })
634   = vcat [ptext SLIT("module dependencies:") <+> fsep (map ppr_mod mods),
635           ptext SLIT("package dependencies:") <+> fsep (map ppr pkgs), 
636           ptext SLIT("orphans:") <+> fsep (map ppr orphs),
637           ptext SLIT("family instance modules:") <+> fsep (map ppr finsts)
638         ]
639   where
640     ppr_mod (mod_name, boot) = ppr mod_name <+> ppr_boot boot
641     ppr_boot True  = text "[boot]"
642     ppr_boot False = empty
643
644 pprIfaceDecl :: (Version, IfaceDecl) -> SDoc
645 pprIfaceDecl (ver, decl)
646   = ppr_vers ver <+> ppr decl
647   where
648         -- Print the version for the decl
649     ppr_vers v | v == initialVersion = empty
650                | otherwise           = int v
651
652 pprFixities :: [(OccName, Fixity)] -> SDoc
653 pprFixities []    = empty
654 pprFixities fixes = ptext SLIT("fixities") <+> pprWithCommas pprFix fixes
655                   where
656                     pprFix (occ,fix) = ppr fix <+> ppr occ 
657
658 pprVectInfo :: IfaceVectInfo -> SDoc
659 pprVectInfo (IfaceVectInfo names) = 
660   ptext SLIT("Closured converted:") <+> hsep (map ppr names)
661
662 pprDeprecs NoDeprecs        = empty
663 pprDeprecs (DeprecAll txt)  = ptext SLIT("Deprecate all") <+> doubleQuotes (ftext txt)
664 pprDeprecs (DeprecSome prs) = ptext SLIT("Deprecate") <+> vcat (map pprDeprec prs)
665                             where
666                               pprDeprec (name, txt) = ppr name <+> doubleQuotes (ftext txt)
667 \end{code}
668
669
670 %*********************************************************
671 %*                                                       *
672 \subsection{Errors}
673 %*                                                       *
674 %*********************************************************
675
676 \begin{code}
677 badIfaceFile file err
678   = vcat [ptext SLIT("Bad interface file:") <+> text file, 
679           nest 4 err]
680
681 hiModuleNameMismatchWarn :: Module -> Module -> Message
682 hiModuleNameMismatchWarn requested_mod read_mod = 
683   withPprStyle defaultUserStyle $
684     -- we want the Modules below to be qualified with package names,
685     -- so reset the PrintUnqualified setting.
686     hsep [ ptext SLIT("Something is amiss; requested module ")
687          , ppr requested_mod
688          , ptext SLIT("differs from name found in the interface file")
689          , ppr read_mod
690          ]
691
692 wrongIfaceModErr iface mod_name file_path 
693   = sep [ptext SLIT("Interface file") <+> iface_file,
694          ptext SLIT("contains module") <+> quotes (ppr (mi_module iface)) <> comma,
695          ptext SLIT("but we were expecting module") <+> quotes (ppr mod_name),
696          sep [ptext SLIT("Probable cause: the source code which generated"),
697              nest 2 iface_file,
698              ptext SLIT("has an incompatible module name")
699             ]
700         ]
701   where iface_file = doubleQuotes (text file_path)
702
703 homeModError mod location
704   = ptext SLIT("attempting to use module ") <> quotes (ppr mod)
705     <> (case ml_hs_file location of
706            Just file -> space <> parens (text file)
707            Nothing   -> empty)
708     <+> ptext SLIT("which is not loaded")
709 \end{code}
710