Major refactoring of CoAxioms
[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, IfaceClsInst, 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) (mi_vect_info iface)
254
255         ; let { final_iface = iface {   
256                                 mi_decls     = panic "No mi_decls in PIT",
257                                 mi_insts     = panic "No mi_insts in PIT",
258                                 mi_fam_insts = panic "No mi_fam_insts in PIT",
259                                 mi_rules     = panic "No mi_rules in PIT",
260                                 mi_anns      = panic "No mi_anns in PIT"
261                               }
262                }
263
264         ; updateEps_  $ \ eps -> 
265            if elemModuleEnv mod (eps_PIT eps) then eps else
266             eps { 
267               eps_PIT          = extendModuleEnv (eps_PIT eps) mod final_iface,
268               eps_PTE          = addDeclsToPTE   (eps_PTE eps) new_eps_decls,
269               eps_rule_base    = extendRuleBaseList (eps_rule_base eps) 
270                                                     new_eps_rules,
271               eps_inst_env     = extendInstEnvList (eps_inst_env eps)  
272                                                    new_eps_insts,
273               eps_fam_inst_env = extendFamInstEnvList (eps_fam_inst_env eps)
274                                                       new_eps_fam_insts,
275               eps_vect_info    = plusVectInfo (eps_vect_info eps) 
276                                               new_eps_vect_info,
277               eps_ann_env      = extendAnnEnvList (eps_ann_env eps)
278                                                   new_eps_anns,
279               eps_mod_fam_inst_env
280                                = let
281                                    fam_inst_env = 
282                                      extendFamInstEnvList emptyFamInstEnv
283                                                           new_eps_fam_insts
284                                  in
285                                  extendModuleEnv (eps_mod_fam_inst_env eps)
286                                                  mod
287                                                  fam_inst_env,
288               eps_stats        = addEpsInStats (eps_stats eps) 
289                                                (length new_eps_decls)
290                                                (length new_eps_insts)
291                                                (length new_eps_rules) }
292
293         ; return (Succeeded final_iface)
294     }}}}
295
296 wantHiBootFile :: DynFlags -> ExternalPackageState -> Module -> WhereFrom
297                -> MaybeErr Message IsBootInterface
298 -- Figure out whether we want Foo.hi or Foo.hi-boot
299 wantHiBootFile dflags eps mod from
300   = case from of
301        ImportByUser usr_boot 
302           | usr_boot && not this_package
303           -> Failed (badSourceImport mod)
304           | otherwise -> Succeeded usr_boot
305
306        ImportBySystem
307           | not this_package   -- If the module to be imported is not from this package
308           -> Succeeded False   -- don't look it up in eps_is_boot, because that is keyed
309                                -- on the ModuleName of *home-package* modules only. 
310                                -- We never import boot modules from other packages!
311
312           | otherwise
313           -> case lookupUFM (eps_is_boot eps) (moduleName mod) of
314                 Just (_, is_boot) -> Succeeded is_boot
315                 Nothing           -> Succeeded False
316                      -- The boot-ness of the requested interface, 
317                      -- based on the dependencies in directly-imported modules
318   where
319     this_package = thisPackage dflags == modulePackageId mod
320
321 badSourceImport :: Module -> SDoc
322 badSourceImport mod
323   = hang (ptext (sLit "You cannot {-# SOURCE #-} import a module from another package"))
324        2 (ptext (sLit "but") <+> quotes (ppr mod) <+> ptext (sLit "is from package")
325           <+> quotes (ppr (modulePackageId mod)))
326 \end{code}
327
328 {-
329 Used to be used for the loadInterface sanity check on system imports. That has been removed, but I'm leaving this in pending
330 review of this decision by SPJ - MCB 10/2008
331
332 badDepMsg :: Module -> SDoc
333 badDepMsg mod 
334   = hang (ptext (sLit "Interface file inconsistency:"))
335        2 (sep [ptext (sLit "home-package module") <+> quotes (ppr mod) <+> ptext (sLit "is needed,"), 
336                ptext (sLit "but is not listed in the dependencies of the interfaces directly imported by the module being compiled")])
337 -}
338
339 \begin{code}
340 -----------------------------------------------------
341 --      Loading type/class/value decls
342 -- We pass the full Module name here, replete with
343 -- its package info, so that we can build a Name for
344 -- each binder with the right package info in it
345 -- All subsequent lookups, including crucially lookups during typechecking
346 -- the declaration itself, will find the fully-glorious Name
347 --
348 -- We handle ATs specially.  They are not main declarations, but also not
349 -- implict things (in particular, adding them to `implicitTyThings' would mess
350 -- things up in the renaming/type checking of source programs).
351 -----------------------------------------------------
352
353 addDeclsToPTE :: PackageTypeEnv -> [(Name,TyThing)] -> PackageTypeEnv
354 addDeclsToPTE pte things = extendNameEnvList pte things
355
356 loadDecls :: Bool
357           -> [(Fingerprint, IfaceDecl)]
358           -> IfL [(Name,TyThing)]
359 loadDecls ignore_prags ver_decls
360    = do { mod <- getIfModule
361         ; thingss <- mapM (loadDecl ignore_prags mod) ver_decls
362         ; return (concat thingss)
363         }
364
365 loadDecl :: Bool                    -- Don't load pragmas into the decl pool
366          -> Module
367           -> (Fingerprint, IfaceDecl)
368           -> IfL [(Name,TyThing)]   -- The list can be poked eagerly, but the
369                                     -- TyThings are forkM'd thunks
370 loadDecl ignore_prags mod (_version, decl)
371   = do  {       -- Populate the name cache with final versions of all 
372                 -- the names associated with the decl
373           main_name      <- lookupOrig mod (ifName decl)
374 --        ; traceIf (text "Loading decl for " <> ppr main_name)
375         ; implicit_names <- mapM (lookupOrig mod) (ifaceDeclImplicitBndrs decl)
376
377         -- Typecheck the thing, lazily
378         -- NB. Firstly, the laziness is there in case we never need the
379         -- declaration (in one-shot mode), and secondly it is there so that 
380         -- we don't look up the occurrence of a name before calling mk_new_bndr
381         -- on the binder.  This is important because we must get the right name
382         -- which includes its nameParent.
383
384         ; thing <- forkM doc $ do { bumpDeclStats main_name
385                                   ; tcIfaceDecl ignore_prags decl }
386
387         -- Populate the type environment with the implicitTyThings too.
388         -- 
389         -- Note [Tricky iface loop]
390         -- ~~~~~~~~~~~~~~~~~~~~~~~~
391         -- Summary: The delicate point here is that 'mini-env' must be
392         -- buildable from 'thing' without demanding any of the things
393         -- 'forkM'd by tcIfaceDecl.
394         --
395         -- In more detail: Consider the example
396         --      data T a = MkT { x :: T a }
397         -- The implicitTyThings of T are:  [ <datacon MkT>, <selector x>]
398         -- (plus their workers, wrappers, coercions etc etc)
399         -- 
400         -- We want to return an environment 
401         --      [ "MkT" -> <datacon MkT>, "x" -> <selector x>, ... ]
402         -- (where the "MkT" is the *Name* associated with MkT, etc.)
403         --
404         -- We do this by mapping the implict_names to the associated
405         -- TyThings.  By the invariant on ifaceDeclImplicitBndrs and
406         -- implicitTyThings, we can use getOccName on the implicit
407         -- TyThings to make this association: each Name's OccName should
408         -- be the OccName of exactly one implictTyThing.  So the key is
409         -- to define a "mini-env"
410         --
411         -- [ 'MkT' -> <datacon MkT>, 'x' -> <selector x>, ... ]
412         -- where the 'MkT' here is the *OccName* associated with MkT.
413         --
414         -- However, there is a subtlety: due to how type checking needs
415         -- to be staged, we can't poke on the forkM'd thunks inside the
416         -- implictTyThings while building this mini-env.  
417         -- If we poke these thunks too early, two problems could happen:
418         --    (1) When processing mutually recursive modules across
419         --        hs-boot boundaries, poking too early will do the
420         --        type-checking before the recursive knot has been tied,
421         --        so things will be type-checked in the wrong
422         --        environment, and necessary variables won't be in
423         --        scope.
424         --        
425         --    (2) Looking up one OccName in the mini_env will cause
426         --        others to be looked up, which might cause that
427         --        original one to be looked up again, and hence loop.
428         --
429         -- The code below works because of the following invariant:
430         -- getOccName on a TyThing does not force the suspended type
431         -- checks in order to extract the name. For example, we don't
432         -- poke on the "T a" type of <selector x> on the way to
433         -- extracting <selector x>'s OccName. Of course, there is no
434         -- reason in principle why getting the OccName should force the
435         -- thunks, but this means we need to be careful in
436         -- implicitTyThings and its helper functions.
437         --
438         -- All a bit too finely-balanced for my liking.
439
440         -- This mini-env and lookup function mediates between the
441         --'Name's n and the map from 'OccName's to the implicit TyThings
442         ; let mini_env = mkOccEnv [(getOccName t, t) | t <- implicitTyThings thing]
443               lookup n = case lookupOccEnv mini_env (getOccName n) of
444                            Just thing -> thing
445                            Nothing    -> 
446                              pprPanic "loadDecl" (ppr main_name <+> ppr n $$ ppr (decl))
447
448         ; return $ (main_name, thing) :
449                       -- uses the invariant that implicit_names and
450                       -- implictTyThings are bijective
451                       [(n, lookup n) | n <- implicit_names]
452         }
453   where
454     doc = ptext (sLit "Declaration for") <+> ppr (ifName decl)
455
456 bumpDeclStats :: Name -> IfL ()         -- Record that one more declaration has actually been used
457 bumpDeclStats name
458   = do  { traceIf (text "Loading decl for" <+> ppr name)
459         ; updateEps_ (\eps -> let stats = eps_stats eps
460                               in eps { eps_stats = stats { n_decls_out = n_decls_out stats + 1 } })
461         }
462 \end{code}
463
464
465 %*********************************************************
466 %*                                                      *
467 \subsection{Reading an interface file}
468 %*                                                      *
469 %*********************************************************
470
471 \begin{code}
472 findAndReadIface :: SDoc -> Module
473                  -> IsBootInterface     -- True  <=> Look for a .hi-boot file
474                                         -- False <=> Look for .hi file
475                  -> TcRnIf gbl lcl (MaybeErr Message (ModIface, FilePath))
476         -- Nothing <=> file not found, or unreadable, or illegible
477         -- Just x  <=> successfully found and parsed 
478
479         -- It *doesn't* add an error to the monad, because 
480         -- sometimes it's ok to fail... see notes with loadInterface
481
482 findAndReadIface doc_str mod hi_boot_file
483   = do  { traceIf (sep [hsep [ptext (sLit "Reading"), 
484                               if hi_boot_file 
485                                 then ptext (sLit "[boot]") 
486                                 else empty,
487                               ptext (sLit "interface for"), 
488                               ppr mod <> semi],
489                         nest 4 (ptext (sLit "reason:") <+> doc_str)])
490
491         -- Check for GHC.Prim, and return its static interface
492         ; dflags <- getDOpts
493         ; if mod == gHC_PRIM
494           then return (Succeeded (ghcPrimIface,
495                                    "<built in interface for GHC.Prim>"))
496           else do
497
498         -- Look for the file
499         ; hsc_env <- getTopEnv
500         ; mb_found <- liftIO (findExactModule hsc_env mod)
501         ; case mb_found of {
502               
503               Found loc mod -> do 
504
505         -- Found file, so read it
506         { let { file_path = addBootSuffix_maybe hi_boot_file (ml_hi_file loc) }
507
508         -- If the interface is in the current package then if we could
509         -- load it would already be in the HPT and we assume that our
510         -- callers checked that.
511         ; if thisPackage dflags == modulePackageId mod
512                 && not (isOneShot (ghcMode dflags))
513             then return (Failed (homeModError mod loc))
514             else do {
515
516         ; traceIf (ptext (sLit "readIFace") <+> text file_path)
517         ; read_result <- readIface mod file_path hi_boot_file
518         ; case read_result of
519             Failed err -> return (Failed (badIfaceFile file_path err))
520             Succeeded iface 
521                 | mi_module iface /= mod ->
522                   return (Failed (wrongIfaceModErr iface mod file_path))
523                 | otherwise ->
524                   return (Succeeded (iface, file_path))
525                         -- Don't forget to fill in the package name...
526         }}
527             ; err -> do
528                 { traceIf (ptext (sLit "...not found"))
529                 ; dflags <- getDOpts
530                 ; return (Failed (cannotFindInterface dflags 
531                                         (moduleName mod) err)) }
532         }
533         }
534 \end{code}
535
536 @readIface@ tries just the one file.
537
538 \begin{code}
539 readIface :: Module -> FilePath -> IsBootInterface 
540           -> TcRnIf gbl lcl (MaybeErr Message ModIface)
541         -- Failed err    <=> file not found, or unreadable, or illegible
542         -- Succeeded iface <=> successfully found and parsed 
543
544 readIface wanted_mod file_path _
545   = do  { res <- tryMostM $
546                  readBinIface CheckHiWay QuietBinIFaceReading file_path
547         ; case res of
548             Right iface 
549                 | wanted_mod == actual_mod -> return (Succeeded iface)
550                 | otherwise                -> return (Failed err)
551                 where
552                   actual_mod = mi_module iface
553                   err = hiModuleNameMismatchWarn wanted_mod actual_mod
554
555             Left exn    -> return (Failed (text (showException exn)))
556     }
557 \end{code}
558
559
560 %*********************************************************
561 %*                                                       *
562         Wired-in interface for GHC.Prim
563 %*                                                       *
564 %*********************************************************
565
566 \begin{code}
567 initExternalPackageState :: ExternalPackageState
568 initExternalPackageState
569   = EPS { 
570       eps_is_boot      = emptyUFM,
571       eps_PIT          = emptyPackageIfaceTable,
572       eps_PTE          = emptyTypeEnv,
573       eps_inst_env     = emptyInstEnv,
574       eps_fam_inst_env = emptyFamInstEnv,
575       eps_rule_base    = mkRuleBase builtinRules,
576         -- Initialise the EPS rule pool with the built-in rules
577       eps_mod_fam_inst_env
578                        = emptyModuleEnv,
579       eps_vect_info    = noVectInfo,
580       eps_ann_env      = emptyAnnEnv,
581       eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0
582                            , n_insts_in = 0, n_insts_out = 0
583                            , n_rules_in = length builtinRules, n_rules_out = 0 }
584     }
585 \end{code}
586
587
588 %*********************************************************
589 %*                                                       *
590         Wired-in interface for GHC.Prim
591 %*                                                       *
592 %*********************************************************
593
594 \begin{code}
595 ghcPrimIface :: ModIface
596 ghcPrimIface
597   = (emptyModIface gHC_PRIM) {
598         mi_exports  = ghcPrimExports,
599         mi_decls    = [],
600         mi_fixities = fixities,
601         mi_fix_fn  = mkIfaceFixCache fixities
602     }           
603   where
604     fixities = [(getOccName seqId, Fixity 0 InfixR)]
605                         -- seq is infixr 0
606 \end{code}
607
608 %*********************************************************
609 %*                                                      *
610 \subsection{Statistics}
611 %*                                                      *
612 %*********************************************************
613
614 \begin{code}
615 ifaceStats :: ExternalPackageState -> SDoc
616 ifaceStats eps 
617   = hcat [text "Renamer stats: ", msg]
618   where
619     stats = eps_stats eps
620     msg = vcat 
621         [int (n_ifaces_in stats) <+> text "interfaces read",
622          hsep [ int (n_decls_out stats), text "type/class/variable imported, out of", 
623                 int (n_decls_in stats), text "read"],
624          hsep [ int (n_insts_out stats), text "instance decls imported, out of",  
625                 int (n_insts_in stats), text "read"],
626          hsep [ int (n_rules_out stats), text "rule decls imported, out of",  
627                 int (n_rules_in stats), text "read"]
628         ]
629 \end{code}
630
631
632 %************************************************************************
633 %*                                                                      *
634                 Printing interfaces
635 %*                                                                      *
636 %************************************************************************
637
638 \begin{code}
639 -- | Read binary interface, and print it out
640 showIface :: HscEnv -> FilePath -> IO ()
641 showIface hsc_env filename = do
642    -- skip the hi way check; we don't want to worry about profiled vs.
643    -- non-profiled interfaces, for example.
644    iface <- initTcRnIf 's' hsc_env () () $
645        readBinIface IgnoreHiWay TraceBinIFaceReading filename
646    printDump (pprModIface iface)
647 \end{code}
648
649 \begin{code}
650 pprModIface :: ModIface -> SDoc
651 -- Show a ModIface
652 pprModIface iface
653  = vcat [ ptext (sLit "interface")
654                 <+> ppr (mi_module iface) <+> pp_boot
655                 <+> (if mi_orphan iface then ptext (sLit "[orphan module]") else empty)
656                 <+> (if mi_finsts iface then ptext (sLit "[family instance module]") else empty)
657                 <+> (if mi_hpc    iface then ptext (sLit "[hpc]") else empty)
658                 <+> integer opt_HiVersion
659         , nest 2 (text "interface hash:" <+> ppr (mi_iface_hash iface))
660         , nest 2 (text "ABI hash:" <+> ppr (mi_mod_hash iface))
661         , nest 2 (text "export-list hash:" <+> ppr (mi_exp_hash iface))
662         , nest 2 (text "orphan hash:" <+> ppr (mi_orphan_hash iface))
663         , nest 2 (text "flag hash:" <+> ppr (mi_flag_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 pprUsage usage@UsageFile{}
712   = hsep [ptext (sLit "addDependentFile"),
713           doubleQuotes (text (usg_file_path usage))]
714
715 pprUsageImport :: Outputable a => Usage -> (Usage -> a) -> SDoc
716 pprUsageImport usage usg_mod'
717   = hsep [ptext (sLit "import"), safe, ppr (usg_mod' usage),
718                        ppr (usg_mod_hash usage)]
719     where
720         safe | usg_safe usage = ptext $ sLit "safe"
721              | otherwise      = ptext $ sLit " -/ "
722
723 pprDeps :: Dependencies -> SDoc
724 pprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs,
725                 dep_finsts = finsts })
726   = vcat [ptext (sLit "module dependencies:") <+> fsep (map ppr_mod mods),
727           ptext (sLit "package dependencies:") <+> fsep (map ppr_pkg pkgs),
728           ptext (sLit "orphans:") <+> fsep (map ppr orphs),
729           ptext (sLit "family instance modules:") <+> fsep (map ppr finsts)
730         ]
731   where
732     ppr_mod (mod_name, boot) = ppr mod_name <+> ppr_boot boot
733     ppr_pkg (pkg,trust_req)  = ppr pkg <>
734                                (if trust_req then text "*" else empty)
735     ppr_boot True  = text "[boot]"
736     ppr_boot False = empty
737
738 pprIfaceDecl :: (Fingerprint, IfaceDecl) -> SDoc
739 pprIfaceDecl (ver, decl)
740   = ppr ver $$ nest 2 (ppr decl)
741
742 pprFixities :: [(OccName, Fixity)] -> SDoc
743 pprFixities []    = empty
744 pprFixities fixes = ptext (sLit "fixities") <+> pprWithCommas pprFix fixes
745                   where
746                     pprFix (occ,fix) = ppr fix <+> ppr occ 
747
748 pprVectInfo :: IfaceVectInfo -> SDoc
749 pprVectInfo (IfaceVectInfo { ifaceVectInfoVar          = vars
750                            , ifaceVectInfoTyCon        = tycons
751                            , ifaceVectInfoTyConReuse   = tyconsReuse
752                            , ifaceVectInfoScalarVars   = scalarVars
753                            , ifaceVectInfoScalarTyCons = scalarTyCons
754                            }) = 
755   vcat 
756   [ ptext (sLit "vectorised variables:") <+> hsep (map ppr vars)
757   , ptext (sLit "vectorised tycons:") <+> hsep (map ppr tycons)
758   , ptext (sLit "vectorised reused tycons:") <+> hsep (map ppr tyconsReuse)
759   , ptext (sLit "scalar variables:") <+> hsep (map ppr scalarVars)
760   , ptext (sLit "scalar tycons:") <+> hsep (map ppr scalarTyCons)
761   ]
762
763 pprTrustInfo :: IfaceTrustInfo -> SDoc
764 pprTrustInfo trust = ptext (sLit "trusted:") <+> ppr trust
765
766 pprTrustPkg :: Bool -> SDoc
767 pprTrustPkg tpkg = ptext (sLit "require own pkg trusted:") <+> ppr tpkg
768
769 instance Outputable Warnings where
770     ppr = pprWarns
771
772 pprWarns :: Warnings -> SDoc
773 pprWarns NoWarnings         = empty
774 pprWarns (WarnAll txt)  = ptext (sLit "Warn all") <+> ppr txt
775 pprWarns (WarnSome prs) = ptext (sLit "Warnings")
776                         <+> vcat (map pprWarning prs)
777     where pprWarning (name, txt) = ppr name <+> ppr txt
778
779 pprIfaceAnnotation :: IfaceAnnotation -> SDoc
780 pprIfaceAnnotation (IfaceAnnotation { ifAnnotatedTarget = target, ifAnnotatedValue = serialized })
781   = ppr target <+> ptext (sLit "annotated by") <+> ppr serialized
782 \end{code}
783
784
785 %*********************************************************
786 %*                                                       *
787 \subsection{Errors}
788 %*                                                       *
789 %*********************************************************
790
791 \begin{code}
792 badIfaceFile :: String -> SDoc -> SDoc
793 badIfaceFile file err
794   = vcat [ptext (sLit "Bad interface file:") <+> text file, 
795           nest 4 err]
796
797 hiModuleNameMismatchWarn :: Module -> Module -> Message
798 hiModuleNameMismatchWarn requested_mod read_mod = 
799   withPprStyle defaultUserStyle $
800     -- we want the Modules below to be qualified with package names,
801     -- so reset the PrintUnqualified setting.
802     hsep [ ptext (sLit "Something is amiss; requested module ")
803          , ppr requested_mod
804          , ptext (sLit "differs from name found in the interface file")
805          , ppr read_mod
806          ]
807
808 wrongIfaceModErr :: ModIface -> Module -> String -> SDoc
809 wrongIfaceModErr iface mod_name file_path 
810   = sep [ptext (sLit "Interface file") <+> iface_file,
811          ptext (sLit "contains module") <+> quotes (ppr (mi_module iface)) <> comma,
812          ptext (sLit "but we were expecting module") <+> quotes (ppr mod_name),
813          sep [ptext (sLit "Probable cause: the source code which generated"),
814              nest 2 iface_file,
815              ptext (sLit "has an incompatible module name")
816             ]
817         ]
818   where iface_file = doubleQuotes (text file_path)
819
820 homeModError :: Module -> ModLocation -> SDoc
821 homeModError mod location
822   = ptext (sLit "attempting to use module ") <> quotes (ppr mod)
823     <> (case ml_hs_file location of
824            Just file -> space <> parens (text file)
825            Nothing   -> empty)
826     <+> ptext (sLit "which is not loaded")
827 \end{code}
828