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