Fix a nasty recursive loop in typechecking interface files
[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 )
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, IfaceRules
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
241         ; let { final_iface = iface {   
242                                 mi_decls     = panic "No mi_decls in PIT",
243                                 mi_insts     = panic "No mi_insts in PIT",
244                                 mi_fam_insts = panic "No mi_fam_insts in PIT",
245                                 mi_rules     = panic "No mi_rules in PIT"
246                               } }
247
248         ; updateEps_  $ \ eps -> 
249             eps { 
250               eps_PIT          = extendModuleEnv (eps_PIT eps) mod final_iface,
251               eps_PTE          = addDeclsToPTE   (eps_PTE eps) new_eps_decls,
252               eps_rule_base    = extendRuleBaseList (eps_rule_base eps) 
253                                                     new_eps_rules,
254               eps_inst_env     = extendInstEnvList (eps_inst_env eps)  
255                                                    new_eps_insts,
256               eps_fam_inst_env = extendFamInstEnvList (eps_fam_inst_env eps)
257                                                       new_eps_fam_insts,
258               eps_mod_fam_inst_env
259                                = let
260                                    fam_inst_env = 
261                                      extendFamInstEnvList emptyFamInstEnv
262                                                           new_eps_fam_insts
263                                  in
264                                  extendModuleEnv (eps_mod_fam_inst_env eps)
265                                                  mod
266                                                  fam_inst_env,
267               eps_stats        = addEpsInStats (eps_stats eps) 
268                                                (length new_eps_decls)
269               (length new_eps_insts) (length new_eps_rules) }
270
271         ; return (Succeeded final_iface)
272     }}}}
273
274 badDepMsg mod 
275   = hang (ptext SLIT("Interface file inconsistency:"))
276        2 (sep [ptext SLIT("home-package module") <+> quotes (ppr mod) <+> ptext SLIT("is mentioned is needed,"), 
277                ptext SLIT("but is not among the dependencies of interfaces directly imported by the module being compiled")])
278
279 -----------------------------------------------------
280 --      Loading type/class/value decls
281 -- We pass the full Module name here, replete with
282 -- its package info, so that we can build a Name for
283 -- each binder with the right package info in it
284 -- All subsequent lookups, including crucially lookups during typechecking
285 -- the declaration itself, will find the fully-glorious Name
286 --
287 -- We handle ATs specially.  They are not main declarations, but also not
288 -- implict things (in particular, adding them to `implicitTyThings' would mess
289 -- things up in the renaming/type checking of source programs).
290 -----------------------------------------------------
291
292 addDeclsToPTE :: PackageTypeEnv -> [(Name,TyThing)] -> PackageTypeEnv
293 addDeclsToPTE pte things = extendNameEnvList pte things
294
295 loadDecls :: Bool
296           -> [(Version, IfaceDecl)]
297           -> IfL [(Name,TyThing)]
298 loadDecls ignore_prags ver_decls
299    = do { mod <- getIfModule
300         ; thingss <- mapM (loadDecl ignore_prags mod) ver_decls
301         ; return (concat thingss)
302         }
303
304 loadDecl :: Bool                    -- Don't load pragmas into the decl pool
305          -> Module
306           -> (Version, IfaceDecl)
307           -> IfL [(Name,TyThing)]   -- The list can be poked eagerly, but the
308                                     -- TyThings are forkM'd thunks
309 loadDecl ignore_prags mod (_version, decl)
310   = do  {       -- Populate the name cache with final versions of all 
311                 -- the names associated with the decl
312           main_name      <- mk_new_bndr mod (ifName decl)
313         ; traceIf (text "Loading decl for " <> ppr main_name)
314         ; implicit_names <- mapM (mk_new_bndr mod) (ifaceDeclSubBndrs decl)
315
316         -- Typecheck the thing, lazily
317         -- NB. Firstly, the laziness is there in case we never need the
318         -- declaration (in one-shot mode), and secondly it is there so that 
319         -- we don't look up the occurrence of a name before calling mk_new_bndr
320         -- on the binder.  This is important because we must get the right name
321         -- which includes its nameParent.
322
323         ; thing <- forkM doc $ do { bumpDeclStats main_name
324                                   ; tcIfaceDecl ignore_prags decl }
325
326         -- Populate the type environment with the implicitTyThings too.
327         -- 
328         -- Note [Tricky iface loop]
329         -- ~~~~~~~~~~~~~~~~~~~~~~~~
330         -- The delicate point here is that 'mini-env' should be
331         -- buildable from 'thing' without demanding any of the things 'forkM'd 
332         -- by tcIfaceDecl.  For example
333         --      class C a where { data T a; op :: T a -> Int }
334         -- We return the bindings
335         --      [("C", <cls>), ("T", lookup env "T"), ("op", lookup env "op")]
336         -- The call (lookup env "T") must return the tycon T without first demanding
337         -- op; because getting the latter will look up T, hence loop.
338         --
339         -- Of course, there is no reason in principle why (lookup env "T") should demand
340         -- anything do to with op, but take care: 
341         --      (a) implicitTyThings, and 
342         --      (b) getOccName of all the things returned by implicitThings, 
343         -- must not depend on any of the nested type-checks
344         -- 
345         -- All a bit too finely-balanced for my liking.
346
347         ; let mini_env = mkOccEnv [(getOccName t, t) | t <- implicitTyThings thing]
348               lookup n = case lookupOccEnv mini_env (getOccName n) of
349                            Just thing -> thing
350                            Nothing    -> 
351                              pprPanic "loadDecl" (ppr main_name <+> ppr n $$ ppr (decl))
352
353         ; returnM $ (main_name, thing) :  [(n, lookup n) | n <- implicit_names]
354         }
355                 -- We build a list from the *known* names, with (lookup n) thunks
356                 -- as the TyThings.  That way we can extend the PTE without poking the
357                 -- thunks
358   where
359         -- mk_new_bndr allocates in the name cache the final canonical
360         -- name for the thing, with the correct 
361         --      * parent
362         --      * location
363         -- imported name, to fix the module correctly in the cache
364     mk_new_bndr mod occ 
365         = newGlobalBinder mod occ 
366                           (importedSrcLoc (showSDoc (ppr (moduleName mod))))
367                         -- ToDo: qualify with the package name if necessary
368
369     doc = ptext SLIT("Declaration for") <+> ppr (ifName decl)
370
371 bumpDeclStats :: Name -> IfL ()         -- Record that one more declaration has actually been used
372 bumpDeclStats name
373   = do  { traceIf (text "Loading decl for" <+> ppr name)
374         ; updateEps_ (\eps -> let stats = eps_stats eps
375                               in eps { eps_stats = stats { n_decls_out = n_decls_out stats + 1 } })
376         }
377 \end{code}
378
379
380 %*********************************************************
381 %*                                                      *
382 \subsection{Reading an interface file}
383 %*                                                      *
384 %*********************************************************
385
386 \begin{code}
387 findAndReadIface :: SDoc -> Module
388                  -> IsBootInterface     -- True  <=> Look for a .hi-boot file
389                                         -- False <=> Look for .hi file
390                  -> TcRnIf gbl lcl (MaybeErr Message (ModIface, FilePath))
391         -- Nothing <=> file not found, or unreadable, or illegible
392         -- Just x  <=> successfully found and parsed 
393
394         -- It *doesn't* add an error to the monad, because 
395         -- sometimes it's ok to fail... see notes with loadInterface
396
397 findAndReadIface doc_str mod hi_boot_file
398   = do  { traceIf (sep [hsep [ptext SLIT("Reading"), 
399                               if hi_boot_file 
400                                 then ptext SLIT("[boot]") 
401                                 else empty,
402                               ptext SLIT("interface for"), 
403                               ppr mod <> semi],
404                         nest 4 (ptext SLIT("reason:") <+> doc_str)])
405
406         -- Check for GHC.Prim, and return its static interface
407         ; dflags <- getDOpts
408         ; if mod == gHC_PRIM
409           then returnM (Succeeded (ghcPrimIface, 
410                                    "<built in interface for GHC.Prim>"))
411           else do
412
413         -- Look for the file
414         ; hsc_env <- getTopEnv
415         ; mb_found <- ioToIOEnv (findHiFile hsc_env mod hi_boot_file)
416         ; case mb_found of {
417               Failed err -> do
418                 { traceIf (ptext SLIT("...not found"))
419                 ; dflags <- getDOpts
420                 ; returnM (Failed (cannotFindInterface dflags 
421                                         (moduleName mod) err)) } ;
422
423               Succeeded file_path -> do 
424
425         -- Found file, so read it
426         { traceIf (ptext SLIT("readIFace") <+> text file_path)
427         ; read_result <- readIface mod file_path hi_boot_file
428         ; case read_result of
429             Failed err -> returnM (Failed (badIfaceFile file_path err))
430             Succeeded iface 
431                 | mi_module iface /= mod ->
432                   return (Failed (wrongIfaceModErr iface mod file_path))
433                 | otherwise ->
434                   returnM (Succeeded (iface, file_path))
435                         -- Don't forget to fill in the package name...
436         }}}
437
438 findHiFile :: HscEnv -> Module -> IsBootInterface
439            -> IO (MaybeErr FindResult FilePath)
440 findHiFile hsc_env mod hi_boot_file
441   = do
442       maybe_found <- findExactModule hsc_env mod
443       case maybe_found of
444         Found loc mod -> return (Succeeded path)
445                 where
446                    path = addBootSuffix_maybe hi_boot_file (ml_hi_file loc)
447         err -> return (Failed err)
448 \end{code}
449
450 @readIface@ tries just the one file.
451
452 \begin{code}
453 readIface :: Module -> FilePath -> IsBootInterface 
454           -> TcRnIf gbl lcl (MaybeErr Message ModIface)
455         -- Failed err    <=> file not found, or unreadable, or illegible
456         -- Succeeded iface <=> successfully found and parsed 
457
458 readIface wanted_mod file_path is_hi_boot_file
459   = do  { dflags <- getDOpts
460         ; res <- tryMostM $ readBinIface file_path
461         ; case res of
462             Right iface 
463                 | wanted_mod == actual_mod -> return (Succeeded iface)
464                 | otherwise                -> return (Failed err)
465                 where
466                   actual_mod = mi_module iface
467                   err = hiModuleNameMismatchWarn wanted_mod actual_mod
468
469             Left exn    -> return (Failed (text (showException exn)))
470     }
471 \end{code}
472
473
474 %*********************************************************
475 %*                                                       *
476         Wired-in interface for GHC.Prim
477 %*                                                       *
478 %*********************************************************
479
480 \begin{code}
481 initExternalPackageState :: ExternalPackageState
482 initExternalPackageState
483   = EPS { 
484       eps_is_boot      = emptyUFM,
485       eps_PIT          = emptyPackageIfaceTable,
486       eps_PTE          = emptyTypeEnv,
487       eps_inst_env     = emptyInstEnv,
488       eps_fam_inst_env = emptyFamInstEnv,
489       eps_rule_base    = mkRuleBase builtinRules,
490         -- Initialise the EPS rule pool with the built-in rules
491       eps_mod_fam_inst_env
492                        = emptyModuleEnv,
493       eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0
494                            , n_insts_in = 0, n_insts_out = 0
495                            , n_rules_in = length builtinRules, n_rules_out = 0 }
496     }
497 \end{code}
498
499
500 %*********************************************************
501 %*                                                       *
502         Wired-in interface for GHC.Prim
503 %*                                                       *
504 %*********************************************************
505
506 \begin{code}
507 ghcPrimIface :: ModIface
508 ghcPrimIface
509   = (emptyModIface gHC_PRIM) {
510         mi_exports  = [(gHC_PRIM, ghcPrimExports)],
511         mi_decls    = [],
512         mi_fixities = fixities,
513         mi_fix_fn  = mkIfaceFixCache fixities
514     }           
515   where
516     fixities = [(getOccName seqId, Fixity 0 InfixR)]
517                         -- seq is infixr 0
518 \end{code}
519
520 %*********************************************************
521 %*                                                      *
522 \subsection{Statistics}
523 %*                                                      *
524 %*********************************************************
525
526 \begin{code}
527 ifaceStats :: ExternalPackageState -> SDoc
528 ifaceStats eps 
529   = hcat [text "Renamer stats: ", msg]
530   where
531     stats = eps_stats eps
532     msg = vcat 
533         [int (n_ifaces_in stats) <+> text "interfaces read",
534          hsep [ int (n_decls_out stats), text "type/class/variable imported, out of", 
535                 int (n_decls_in stats), text "read"],
536          hsep [ int (n_insts_out stats), text "instance decls imported, out of",  
537                 int (n_insts_in stats), text "read"],
538          hsep [ int (n_rules_out stats), text "rule decls imported, out of",  
539                 int (n_rules_in stats), text "read"]
540         ]
541 \end{code}
542
543
544 %************************************************************************
545 %*                                                                      *
546                 Printing interfaces
547 %*                                                                      *
548 %************************************************************************
549
550 \begin{code}
551 -- | Read binary interface, and print it out
552 showIface :: HscEnv -> FilePath -> IO ()
553 showIface hsc_env filename = do
554    -- skip the version check; we don't want to worry about profiled vs.
555    -- non-profiled interfaces, for example.
556    writeIORef v_IgnoreHiWay True
557    iface <- initTcRnIf 's' hsc_env () () $ readBinIface  filename
558    printDump (pprModIface iface)
559 \end{code}
560
561 \begin{code}
562 pprModIface :: ModIface -> SDoc
563 -- Show a ModIface
564 pprModIface iface
565  = vcat [ ptext SLIT("interface")
566                 <+> ppr (mi_module iface) <+> pp_boot 
567                 <+> ppr (mi_mod_vers iface) <+> pp_sub_vers
568                 <+> (if mi_orphan iface then ptext SLIT("[orphan module]") else empty)
569                 <+> (if mi_finsts iface then ptext SLIT("[family instance module]") else empty)
570                 <+> int opt_HiVersion
571                 <+> ptext SLIT("where")
572         , vcat (map pprExport (mi_exports iface))
573         , pprDeps (mi_deps iface)
574         , vcat (map pprUsage (mi_usages iface))
575         , pprFixities (mi_fixities iface)
576         , vcat (map pprIfaceDecl (mi_decls iface))
577         , vcat (map ppr (mi_insts iface))
578         , vcat (map ppr (mi_fam_insts iface))
579         , vcat (map ppr (mi_rules iface))
580         , pprDeprecs (mi_deprecs iface)
581         ]
582   where
583     pp_boot | mi_boot iface = ptext SLIT("[boot]")
584             | otherwise     = empty
585
586     exp_vers  = mi_exp_vers iface
587     rule_vers = mi_rule_vers iface
588
589     pp_sub_vers | exp_vers == initialVersion && rule_vers == initialVersion = empty
590                 | otherwise = brackets (ppr exp_vers <+> ppr rule_vers)
591 \end{code}
592
593 When printing export lists, we print like this:
594         Avail   f               f
595         AvailTC C [C, x, y]     C(x,y)
596         AvailTC C [x, y]        C!(x,y)         -- Exporting x, y but not C
597
598 \begin{code}
599 pprExport :: IfaceExport -> SDoc
600 pprExport (mod, items)
601  = hsep [ ptext SLIT("export"), ppr mod, hsep (map pp_avail items) ]
602   where
603     pp_avail :: GenAvailInfo OccName -> SDoc
604     pp_avail (Avail occ)    = ppr occ
605     pp_avail (AvailTC _ []) = empty
606     pp_avail (AvailTC n (n':ns)) 
607         | n==n'     = ppr n <> pp_export ns
608         | otherwise = ppr n <> char '|' <> pp_export (n':ns)
609     
610     pp_export []    = empty
611     pp_export names = braces (hsep (map ppr names))
612
613 pprUsage :: Usage -> SDoc
614 pprUsage usage
615   = hsep [ptext SLIT("import"), ppr (usg_name usage), 
616           int (usg_mod usage), 
617           pp_export_version (usg_exports usage),
618           int (usg_rules usage),
619           pp_versions (usg_entities usage) ]
620   where
621     pp_versions nvs = hsep [ ppr n <+> int v | (n,v) <- nvs ]
622     pp_export_version Nothing  = empty
623     pp_export_version (Just v) = int v
624
625 pprDeps :: Dependencies -> SDoc
626 pprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs,
627                 dep_finsts = finsts })
628   = vcat [ptext SLIT("module dependencies:") <+> fsep (map ppr_mod mods),
629           ptext SLIT("package dependencies:") <+> fsep (map ppr pkgs), 
630           ptext SLIT("orphans:") <+> fsep (map ppr orphs),
631           ptext SLIT("family instance modules:") <+> fsep (map ppr finsts)
632         ]
633   where
634     ppr_mod (mod_name, boot) = ppr mod_name <+> ppr_boot boot
635     ppr_boot True  = text "[boot]"
636     ppr_boot False = empty
637
638 pprIfaceDecl :: (Version, IfaceDecl) -> SDoc
639 pprIfaceDecl (ver, decl)
640   = ppr_vers ver <+> ppr decl
641   where
642         -- Print the version for the decl
643     ppr_vers v | v == initialVersion = empty
644                | otherwise           = int v
645
646 pprFixities :: [(OccName, Fixity)] -> SDoc
647 pprFixities []    = empty
648 pprFixities fixes = ptext SLIT("fixities") <+> pprWithCommas pprFix fixes
649                   where
650                     pprFix (occ,fix) = ppr fix <+> ppr occ 
651
652 pprDeprecs NoDeprecs        = empty
653 pprDeprecs (DeprecAll txt)  = ptext SLIT("Deprecate all") <+> doubleQuotes (ftext txt)
654 pprDeprecs (DeprecSome prs) = ptext SLIT("Deprecate") <+> vcat (map pprDeprec prs)
655                             where
656                               pprDeprec (name, txt) = ppr name <+> doubleQuotes (ftext txt)
657 \end{code}
658
659
660 %*********************************************************
661 %*                                                       *
662 \subsection{Errors}
663 %*                                                       *
664 %*********************************************************
665
666 \begin{code}
667 badIfaceFile file err
668   = vcat [ptext SLIT("Bad interface file:") <+> text file, 
669           nest 4 err]
670
671 hiModuleNameMismatchWarn :: Module -> Module -> Message
672 hiModuleNameMismatchWarn requested_mod read_mod = 
673   withPprStyle defaultUserStyle $
674     -- we want the Modules below to be qualified with package names,
675     -- so reset the PrintUnqualified setting.
676     hsep [ ptext SLIT("Something is amiss; requested module ")
677          , ppr requested_mod
678          , ptext SLIT("differs from name found in the interface file")
679          , ppr read_mod
680          ]
681
682 wrongIfaceModErr iface mod_name file_path 
683   = sep [ptext SLIT("Interface file") <+> iface_file,
684          ptext SLIT("contains module") <+> quotes (ppr (mi_module iface)) <> comma,
685          ptext SLIT("but we were expecting module") <+> quotes (ppr mod_name),
686          sep [ptext SLIT("Probable cause: the source code which generated"),
687              nest 2 iface_file,
688              ptext SLIT("has an incompatible module name")
689             ]
690         ]
691   where iface_file = doubleQuotes (text file_path)
692 \end{code}
693