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