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