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