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