Filter orphan rules based on imports, fixes #10294 and #10420.
[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 ; ASSERT( isExternalName tc_name )
195 when (mod /= nameModule tc_name)
196 (initIfaceTcRn (loadWiredInHomeIface tc_name))
197 -- Don't look for (non-existent) Float.hi when
198 -- compiling Float.hs, which mentions Float of course
199 -- A bit yukky to call initIfaceTcRn here
200 }
201 where
202 tc_name = tyConName tc
203
204 ifCheckWiredInThing :: TyThing -> IfL ()
205 -- Even though we are in an interface file, we want to make
206 -- sure the instances of a wired-in thing are loaded (imagine f :: Double -> Double)
207 -- Ditto want to ensure that RULES are loaded too
208 -- See Note [Loading instances for wired-in things]
209 ifCheckWiredInThing thing
210 = do { mod <- getIfModule
211 -- Check whether we are typechecking the interface for this
212 -- very module. E.g when compiling the base library in --make mode
213 -- we may typecheck GHC.Base.hi. At that point, GHC.Base is not in
214 -- the HPT, so without the test we'll demand-load it into the PIT!
215 -- C.f. the same test in checkWiredInTyCon above
216 ; let name = getName thing
217 ; ASSERT2( isExternalName name, ppr name )
218 when (needWiredInHomeIface thing && mod /= nameModule name)
219 (loadWiredInHomeIface name) }
220
221 needWiredInHomeIface :: TyThing -> Bool
222 -- Only for TyCons; see Note [Loading instances for wired-in things]
223 needWiredInHomeIface (ATyCon {}) = True
224 needWiredInHomeIface _ = False
225
226
227 {-
228 ************************************************************************
229 * *
230 loadSrcInterface, loadOrphanModules, loadInterfaceForName
231
232 These three are called from TcM-land
233 * *
234 ************************************************************************
235 -}
236
237 -- | Load the interface corresponding to an @import@ directive in
238 -- source code. On a failure, fail in the monad with an error message.
239 loadSrcInterface :: SDoc
240 -> ModuleName
241 -> IsBootInterface -- {-# SOURCE #-} ?
242 -> Maybe FastString -- "package", if any
243 -> RnM ModIface
244
245 loadSrcInterface doc mod want_boot maybe_pkg
246 = do { res <- loadSrcInterface_maybe doc mod want_boot maybe_pkg
247 ; case res of
248 Failed err -> failWithTc err
249 Succeeded iface -> return iface }
250
251 -- | Like 'loadSrcInterface', but returns a 'MaybeErr'.
252 loadSrcInterface_maybe :: SDoc
253 -> ModuleName
254 -> IsBootInterface -- {-# SOURCE #-} ?
255 -> Maybe FastString -- "package", if any
256 -> RnM (MaybeErr MsgDoc ModIface)
257
258 loadSrcInterface_maybe doc mod want_boot maybe_pkg
259 -- We must first find which Module this import refers to. This involves
260 -- calling the Finder, which as a side effect will search the filesystem
261 -- and create a ModLocation. If successful, loadIface will read the
262 -- interface; it will call the Finder again, but the ModLocation will be
263 -- cached from the first search.
264 = do { hsc_env <- getTopEnv
265 ; res <- liftIO $ findImportedModule hsc_env mod maybe_pkg
266 ; case res of
267 Found _ mod -> initIfaceTcRn $ loadInterface doc mod (ImportByUser want_boot)
268 err -> return (Failed (cannotFindInterface (hsc_dflags hsc_env) mod err)) }
269
270 -- | Load interface directly for a fully qualified 'Module'. (This is a fairly
271 -- rare operation, but in particular it is used to load orphan modules
272 -- in order to pull their instances into the global package table and to
273 -- handle some operations in GHCi).
274 loadModuleInterface :: SDoc -> Module -> TcM ModIface
275 loadModuleInterface doc mod = initIfaceTcRn (loadSysInterface doc mod)
276
277 -- | Load interfaces for a collection of modules.
278 loadModuleInterfaces :: SDoc -> [Module] -> TcM ()
279 loadModuleInterfaces doc mods
280 | null mods = return ()
281 | otherwise = initIfaceTcRn (mapM_ load mods)
282 where
283 load mod = loadSysInterface (doc <+> parens (ppr mod)) mod
284
285 -- | Loads the interface for a given Name.
286 -- Should only be called for an imported name;
287 -- otherwise loadSysInterface may not find the interface
288 loadInterfaceForName :: SDoc -> Name -> TcRn ModIface
289 loadInterfaceForName doc name
290 = do { when debugIsOn $ -- Check pre-condition
291 do { this_mod <- getModule
292 ; MASSERT2( not (nameIsLocalOrFrom this_mod name), ppr name <+> parens doc ) }
293 ; ASSERT2( isExternalName name, ppr name )
294 initIfaceTcRn $ loadSysInterface doc (nameModule name) }
295
296 -- | Loads the interface for a given Module.
297 loadInterfaceForModule :: SDoc -> Module -> TcRn ModIface
298 loadInterfaceForModule doc m
299 = do
300 -- Should not be called with this module
301 when debugIsOn $ do
302 this_mod <- getModule
303 MASSERT2( this_mod /= m, ppr m <+> parens doc )
304 initIfaceTcRn $ loadSysInterface doc m
305
306 {-
307 *********************************************************
308 * *
309 loadInterface
310
311 The main function to load an interface
312 for an imported module, and put it in
313 the External Package State
314 * *
315 *********************************************************
316 -}
317
318 -- | An 'IfM' function to load the home interface for a wired-in thing,
319 -- so that we're sure that we see its instance declarations and rules
320 -- See Note [Loading instances for wired-in things] in TcIface
321 loadWiredInHomeIface :: Name -> IfM lcl ()
322 loadWiredInHomeIface name
323 = ASSERT( isWiredInName name )
324 do _ <- loadSysInterface doc (nameModule name); return ()
325 where
326 doc = ptext (sLit "Need home interface for wired-in thing") <+> ppr name
327
328 ------------------
329 -- | Loads a system interface and throws an exception if it fails
330 loadSysInterface :: SDoc -> Module -> IfM lcl ModIface
331 loadSysInterface doc mod_name = loadInterfaceWithException doc mod_name ImportBySystem
332
333 ------------------
334 -- | Loads a user interface and throws an exception if it fails. The first parameter indicates
335 -- whether we should import the boot variant of the module
336 loadUserInterface :: Bool -> SDoc -> Module -> IfM lcl ModIface
337 loadUserInterface is_boot doc mod_name
338 = loadInterfaceWithException doc mod_name (ImportByUser is_boot)
339
340 loadPluginInterface :: SDoc -> Module -> IfM lcl ModIface
341 loadPluginInterface doc mod_name
342 = loadInterfaceWithException doc mod_name ImportByPlugin
343
344 ------------------
345 -- | A wrapper for 'loadInterface' that throws an exception if it fails
346 loadInterfaceWithException :: SDoc -> Module -> WhereFrom -> IfM lcl ModIface
347 loadInterfaceWithException doc mod_name where_from
348 = do { mb_iface <- loadInterface doc mod_name where_from
349 ; dflags <- getDynFlags
350 ; case mb_iface of
351 Failed err -> liftIO $ throwGhcExceptionIO (ProgramError (showSDoc dflags err))
352 Succeeded iface -> return iface }
353
354 ------------------
355 loadInterface :: SDoc -> Module -> WhereFrom
356 -> IfM lcl (MaybeErr MsgDoc ModIface)
357
358 -- loadInterface looks in both the HPT and PIT for the required interface
359 -- If not found, it loads it, and puts it in the PIT (always).
360
361 -- If it can't find a suitable interface file, we
362 -- a) modify the PackageIfaceTable to have an empty entry
363 -- (to avoid repeated complaints)
364 -- b) return (Left message)
365 --
366 -- It's not necessarily an error for there not to be an interface
367 -- file -- perhaps the module has changed, and that interface
368 -- is no longer used
369
370 loadInterface doc_str mod from
371 = do { -- Read the state
372 (eps,hpt) <- getEpsAndHpt
373 ; gbl_env <- getGblEnv
374
375 ; traceIf (text "Considering whether to load" <+> ppr mod <+> ppr from)
376
377 -- Check whether we have the interface already
378 ; dflags <- getDynFlags
379 ; case lookupIfaceByModule dflags hpt (eps_PIT eps) mod of {
380 Just iface
381 -> return (Succeeded iface) ; -- Already loaded
382 -- The (src_imp == mi_boot iface) test checks that the already-loaded
383 -- interface isn't a boot iface. This can conceivably happen,
384 -- if an earlier import had a before we got to real imports. I think.
385 _ -> do {
386
387 -- READ THE MODULE IN
388 ; read_result <- case (wantHiBootFile dflags eps mod from) of
389 Failed err -> return (Failed err)
390 Succeeded hi_boot_file ->
391 -- Stoutly warn against an EPS-updating import
392 -- of one's own boot file! (one-shot only)
393 --See Note [Do not update EPS with your own hi-boot]
394 -- in MkIface.
395 WARN( hi_boot_file &&
396 fmap fst (if_rec_types gbl_env) == Just mod,
397 ppr mod )
398 findAndReadIface doc_str mod hi_boot_file
399 ; case read_result of {
400 Failed err -> do
401 { let fake_iface = emptyModIface mod
402
403 ; updateEps_ $ \eps ->
404 eps { eps_PIT = extendModuleEnv (eps_PIT eps) (mi_module fake_iface) fake_iface }
405 -- Not found, so add an empty iface to
406 -- the EPS map so that we don't look again
407
408 ; return (Failed err) } ;
409
410 -- Found and parsed!
411 -- We used to have a sanity check here that looked for:
412 -- * System importing ..
413 -- * a home package module ..
414 -- * that we know nothing about (mb_dep == Nothing)!
415 --
416 -- But this is no longer valid because thNameToGhcName allows users to
417 -- cause the system to load arbitrary interfaces (by supplying an appropriate
418 -- Template Haskell original-name).
419 Succeeded (iface, file_path) ->
420
421 let
422 loc_doc = text file_path
423 in
424 initIfaceLcl mod loc_doc $ do
425
426 -- Load the new ModIface into the External Package State
427 -- Even home-package interfaces loaded by loadInterface
428 -- (which only happens in OneShot mode; in Batch/Interactive
429 -- mode, home-package modules are loaded one by one into the HPT)
430 -- are put in the EPS.
431 --
432 -- The main thing is to add the ModIface to the PIT, but
433 -- we also take the
434 -- IfaceDecls, IfaceClsInst, IfaceFamInst, IfaceRules, IfaceVectInfo
435 -- out of the ModIface and put them into the big EPS pools
436
437 -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
438 --- names is done correctly (notably, whether this is an .hi file or .hi-boot file).
439 -- If we do loadExport first the wrong info gets into the cache (unless we
440 -- explicitly tag each export which seems a bit of a bore)
441
442 ; ignore_prags <- goptM Opt_IgnoreInterfacePragmas
443 ; new_eps_decls <- loadDecls ignore_prags (mi_decls iface)
444 ; new_eps_insts <- mapM tcIfaceInst (mi_insts iface)
445 ; new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
446 ; new_eps_rules <- tcIfaceRules ignore_prags (mi_rules iface)
447 ; new_eps_anns <- tcIfaceAnnotations (mi_anns iface)
448 ; new_eps_vect_info <- tcIfaceVectInfo mod (mkNameEnv new_eps_decls) (mi_vect_info iface)
449
450 ; let { final_iface = iface {
451 mi_decls = panic "No mi_decls in PIT",
452 mi_insts = panic "No mi_insts in PIT",
453 mi_fam_insts = panic "No mi_fam_insts in PIT",
454 mi_rules = panic "No mi_rules in PIT",
455 mi_anns = panic "No mi_anns in PIT"
456 }
457 }
458
459 ; updateEps_ $ \ eps ->
460 if elemModuleEnv mod (eps_PIT eps) then eps else
461 eps {
462 eps_PIT = extendModuleEnv (eps_PIT eps) mod final_iface,
463 eps_PTE = addDeclsToPTE (eps_PTE eps) new_eps_decls,
464 eps_rule_base = extendRuleBaseList (eps_rule_base eps)
465 new_eps_rules,
466 eps_inst_env = extendInstEnvList (eps_inst_env eps)
467 new_eps_insts,
468 eps_fam_inst_env = extendFamInstEnvList (eps_fam_inst_env eps)
469 new_eps_fam_insts,
470 eps_vect_info = plusVectInfo (eps_vect_info eps)
471 new_eps_vect_info,
472 eps_ann_env = extendAnnEnvList (eps_ann_env eps)
473 new_eps_anns,
474 eps_mod_fam_inst_env
475 = let
476 fam_inst_env =
477 extendFamInstEnvList emptyFamInstEnv
478 new_eps_fam_insts
479 in
480 extendModuleEnv (eps_mod_fam_inst_env eps)
481 mod
482 fam_inst_env,
483 eps_stats = addEpsInStats (eps_stats eps)
484 (length new_eps_decls)
485 (length new_eps_insts)
486 (length new_eps_rules) }
487
488 ; return (Succeeded final_iface)
489 }}}}
490
491 wantHiBootFile :: DynFlags -> ExternalPackageState -> Module -> WhereFrom
492 -> MaybeErr MsgDoc IsBootInterface
493 -- Figure out whether we want Foo.hi or Foo.hi-boot
494 wantHiBootFile dflags eps mod from
495 = case from of
496 ImportByUser usr_boot
497 | usr_boot && not this_package
498 -> Failed (badSourceImport mod)
499 | otherwise -> Succeeded usr_boot
500
501 ImportByPlugin
502 -> Succeeded False
503
504 ImportBySystem
505 | not this_package -- If the module to be imported is not from this package
506 -> Succeeded False -- don't look it up in eps_is_boot, because that is keyed
507 -- on the ModuleName of *home-package* modules only.
508 -- We never import boot modules from other packages!
509
510 | otherwise
511 -> case lookupUFM (eps_is_boot eps) (moduleName mod) of
512 Just (_, is_boot) -> Succeeded is_boot
513 Nothing -> Succeeded False
514 -- The boot-ness of the requested interface,
515 -- based on the dependencies in directly-imported modules
516 where
517 this_package = thisPackage dflags == modulePackageKey mod
518
519 badSourceImport :: Module -> SDoc
520 badSourceImport mod
521 = hang (ptext (sLit "You cannot {-# SOURCE #-} import a module from another package"))
522 2 (ptext (sLit "but") <+> quotes (ppr mod) <+> ptext (sLit "is from package")
523 <+> quotes (ppr (modulePackageKey mod)))
524
525 -----------------------------------------------------
526 -- Loading type/class/value decls
527 -- We pass the full Module name here, replete with
528 -- its package info, so that we can build a Name for
529 -- each binder with the right package info in it
530 -- All subsequent lookups, including crucially lookups during typechecking
531 -- the declaration itself, will find the fully-glorious Name
532 --
533 -- We handle ATs specially. They are not main declarations, but also not
534 -- implicit things (in particular, adding them to `implicitTyThings' would mess
535 -- things up in the renaming/type checking of source programs).
536 -----------------------------------------------------
537
538 addDeclsToPTE :: PackageTypeEnv -> [(Name,TyThing)] -> PackageTypeEnv
539 addDeclsToPTE pte things = extendNameEnvList pte things
540
541 loadDecls :: Bool
542 -> [(Fingerprint, IfaceDecl)]
543 -> IfL [(Name,TyThing)]
544 loadDecls ignore_prags ver_decls
545 = do { mod <- getIfModule
546 ; thingss <- mapM (loadDecl ignore_prags mod) ver_decls
547 ; return (concat thingss)
548 }
549
550 loadDecl :: Bool -- Don't load pragmas into the decl pool
551 -> Module
552 -> (Fingerprint, IfaceDecl)
553 -> IfL [(Name,TyThing)] -- The list can be poked eagerly, but the
554 -- TyThings are forkM'd thunks
555 loadDecl ignore_prags mod (_version, decl)
556 = do { -- Populate the name cache with final versions of all
557 -- the names associated with the decl
558 main_name <- lookupOrig mod (ifName decl)
559
560 -- Typecheck the thing, lazily
561 -- NB. Firstly, the laziness is there in case we never need the
562 -- declaration (in one-shot mode), and secondly it is there so that
563 -- we don't look up the occurrence of a name before calling mk_new_bndr
564 -- on the binder. This is important because we must get the right name
565 -- which includes its nameParent.
566
567 ; thing <- forkM doc $ do { bumpDeclStats main_name
568 ; tcIfaceDecl ignore_prags decl }
569
570 -- Populate the type environment with the implicitTyThings too.
571 --
572 -- Note [Tricky iface loop]
573 -- ~~~~~~~~~~~~~~~~~~~~~~~~
574 -- Summary: The delicate point here is that 'mini-env' must be
575 -- buildable from 'thing' without demanding any of the things
576 -- 'forkM'd by tcIfaceDecl.
577 --
578 -- In more detail: Consider the example
579 -- data T a = MkT { x :: T a }
580 -- The implicitTyThings of T are: [ <datacon MkT>, <selector x>]
581 -- (plus their workers, wrappers, coercions etc etc)
582 --
583 -- We want to return an environment
584 -- [ "MkT" -> <datacon MkT>, "x" -> <selector x>, ... ]
585 -- (where the "MkT" is the *Name* associated with MkT, etc.)
586 --
587 -- We do this by mapping the implicit_names to the associated
588 -- TyThings. By the invariant on ifaceDeclImplicitBndrs and
589 -- implicitTyThings, we can use getOccName on the implicit
590 -- TyThings to make this association: each Name's OccName should
591 -- be the OccName of exactly one implicitTyThing. So the key is
592 -- to define a "mini-env"
593 --
594 -- [ 'MkT' -> <datacon MkT>, 'x' -> <selector x>, ... ]
595 -- where the 'MkT' here is the *OccName* associated with MkT.
596 --
597 -- However, there is a subtlety: due to how type checking needs
598 -- to be staged, we can't poke on the forkM'd thunks inside the
599 -- implicitTyThings while building this mini-env.
600 -- If we poke these thunks too early, two problems could happen:
601 -- (1) When processing mutually recursive modules across
602 -- hs-boot boundaries, poking too early will do the
603 -- type-checking before the recursive knot has been tied,
604 -- so things will be type-checked in the wrong
605 -- environment, and necessary variables won't be in
606 -- scope.
607 --
608 -- (2) Looking up one OccName in the mini_env will cause
609 -- others to be looked up, which might cause that
610 -- original one to be looked up again, and hence loop.
611 --
612 -- The code below works because of the following invariant:
613 -- getOccName on a TyThing does not force the suspended type
614 -- checks in order to extract the name. For example, we don't
615 -- poke on the "T a" type of <selector x> on the way to
616 -- extracting <selector x>'s OccName. Of course, there is no
617 -- reason in principle why getting the OccName should force the
618 -- thunks, but this means we need to be careful in
619 -- implicitTyThings and its helper functions.
620 --
621 -- All a bit too finely-balanced for my liking.
622
623 -- This mini-env and lookup function mediates between the
624 --'Name's n and the map from 'OccName's to the implicit TyThings
625 ; let mini_env = mkOccEnv [(getOccName t, t) | t <- implicitTyThings thing]
626 lookup n = case lookupOccEnv mini_env (getOccName n) of
627 Just thing -> thing
628 Nothing ->
629 pprPanic "loadDecl" (ppr main_name <+> ppr n $$ ppr (decl))
630
631 ; implicit_names <- mapM (lookupOrig mod) (ifaceDeclImplicitBndrs decl)
632
633 -- ; traceIf (text "Loading decl for " <> ppr main_name $$ ppr implicit_names)
634 ; return $ (main_name, thing) :
635 -- uses the invariant that implicit_names and
636 -- implicitTyThings are bijective
637 [(n, lookup n) | n <- implicit_names]
638 }
639 where
640 doc = ptext (sLit "Declaration for") <+> ppr (ifName decl)
641
642 bumpDeclStats :: Name -> IfL () -- Record that one more declaration has actually been used
643 bumpDeclStats name
644 = do { traceIf (text "Loading decl for" <+> ppr name)
645 ; updateEps_ (\eps -> let stats = eps_stats eps
646 in eps { eps_stats = stats { n_decls_out = n_decls_out stats + 1 } })
647 }
648
649 {-
650 *********************************************************
651 * *
652 \subsection{Reading an interface file}
653 * *
654 *********************************************************
655
656 Note [Home module load error]
657 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
658 If the sought-for interface is in the current package (as determined
659 by -package-name flag) then it jolly well should already be in the HPT
660 because we process home-package modules in dependency order. (Except
661 in one-shot mode; see notes with hsc_HPT decl in HscTypes).
662
663 It is possible (though hard) to get this error through user behaviour.
664 * Suppose package P (modules P1, P2) depends on package Q (modules Q1,
665 Q2, with Q2 importing Q1)
666 * We compile both packages.
667 * Now we edit package Q so that it somehow depends on P
668 * Now recompile Q with --make (without recompiling P).
669 * Then Q1 imports, say, P1, which in turn depends on Q2. So Q2
670 is a home-package module which is not yet in the HPT! Disaster.
671
672 This actually happened with P=base, Q=ghc-prim, via the AMP warnings.
673 See Trac #8320.
674 -}
675
676 findAndReadIface :: SDoc -> Module
677 -> IsBootInterface -- True <=> Look for a .hi-boot file
678 -- False <=> Look for .hi file
679 -> TcRnIf gbl lcl (MaybeErr MsgDoc (ModIface, FilePath))
680 -- Nothing <=> file not found, or unreadable, or illegible
681 -- Just x <=> successfully found and parsed
682
683 -- It *doesn't* add an error to the monad, because
684 -- sometimes it's ok to fail... see notes with loadInterface
685
686 findAndReadIface doc_str mod hi_boot_file
687 = do traceIf (sep [hsep [ptext (sLit "Reading"),
688 if hi_boot_file
689 then ptext (sLit "[boot]")
690 else Outputable.empty,
691 ptext (sLit "interface for"),
692 ppr mod <> semi],
693 nest 4 (ptext (sLit "reason:") <+> doc_str)])
694
695 -- Check for GHC.Prim, and return its static interface
696 if mod == gHC_PRIM
697 then do
698 iface <- getHooked ghcPrimIfaceHook ghcPrimIface
699 return (Succeeded (iface,
700 "<built in interface for GHC.Prim>"))
701 else do
702 dflags <- getDynFlags
703 -- Look for the file
704 hsc_env <- getTopEnv
705 mb_found <- liftIO (findExactModule hsc_env mod)
706 case mb_found of
707 Found loc mod -> do
708
709 -- Found file, so read it
710 let file_path = addBootSuffix_maybe hi_boot_file
711 (ml_hi_file loc)
712
713 -- See Note [Home module load error]
714 if thisPackage dflags == modulePackageKey mod &&
715 not (isOneShot (ghcMode dflags))
716 then return (Failed (homeModError mod loc))
717 else do r <- read_file file_path
718 checkBuildDynamicToo r
719 return r
720 err -> do
721 traceIf (ptext (sLit "...not found"))
722 dflags <- getDynFlags
723 return (Failed (cannotFindInterface dflags
724 (moduleName mod) err))
725 where read_file file_path = do
726 traceIf (ptext (sLit "readIFace") <+> text file_path)
727 read_result <- readIface mod file_path
728 case read_result of
729 Failed err -> return (Failed (badIfaceFile file_path err))
730 Succeeded iface
731 | mi_module iface /= mod ->
732 return (Failed (wrongIfaceModErr iface mod file_path))
733 | otherwise ->
734 return (Succeeded (iface, file_path))
735 -- Don't forget to fill in the package name...
736 checkBuildDynamicToo (Succeeded (iface, filePath)) = do
737 dflags <- getDynFlags
738 whenGeneratingDynamicToo dflags $ withDoDynamicToo $ do
739 let ref = canGenerateDynamicToo dflags
740 dynFilePath = addBootSuffix_maybe hi_boot_file
741 $ replaceExtension filePath (dynHiSuf dflags)
742 r <- read_file dynFilePath
743 case r of
744 Succeeded (dynIface, _)
745 | mi_mod_hash iface == mi_mod_hash dynIface ->
746 return ()
747 | otherwise ->
748 do traceIf (text "Dynamic hash doesn't match")
749 liftIO $ writeIORef ref False
750 Failed err ->
751 do traceIf (text "Failed to load dynamic interface file:" $$ err)
752 liftIO $ writeIORef ref False
753 checkBuildDynamicToo _ = return ()
754
755 -- @readIface@ tries just the one file.
756
757 readIface :: Module -> FilePath
758 -> TcRnIf gbl lcl (MaybeErr MsgDoc ModIface)
759 -- Failed err <=> file not found, or unreadable, or illegible
760 -- Succeeded iface <=> successfully found and parsed
761
762 readIface wanted_mod file_path
763 = do { res <- tryMostM $
764 readBinIface CheckHiWay QuietBinIFaceReading file_path
765 ; case res of
766 Right iface
767 | wanted_mod == actual_mod -> return (Succeeded iface)
768 | otherwise -> return (Failed err)
769 where
770 actual_mod = mi_module iface
771 err = hiModuleNameMismatchWarn wanted_mod actual_mod
772
773 Left exn -> return (Failed (text (showException exn)))
774 }
775
776 {-
777 *********************************************************
778 * *
779 Wired-in interface for GHC.Prim
780 * *
781 *********************************************************
782 -}
783
784 initExternalPackageState :: ExternalPackageState
785 initExternalPackageState
786 = EPS {
787 eps_is_boot = emptyUFM,
788 eps_PIT = emptyPackageIfaceTable,
789 eps_PTE = emptyTypeEnv,
790 eps_inst_env = emptyInstEnv,
791 eps_fam_inst_env = emptyFamInstEnv,
792 eps_rule_base = mkRuleBase builtinRules,
793 -- Initialise the EPS rule pool with the built-in rules
794 eps_mod_fam_inst_env
795 = emptyModuleEnv,
796 eps_vect_info = noVectInfo,
797 eps_ann_env = emptyAnnEnv,
798 eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0
799 , n_insts_in = 0, n_insts_out = 0
800 , n_rules_in = length builtinRules, n_rules_out = 0 }
801 }
802
803 {-
804 *********************************************************
805 * *
806 Wired-in interface for GHC.Prim
807 * *
808 *********************************************************
809 -}
810
811 ghcPrimIface :: ModIface
812 ghcPrimIface
813 = (emptyModIface gHC_PRIM) {
814 mi_exports = ghcPrimExports,
815 mi_decls = [],
816 mi_fixities = fixities,
817 mi_fix_fn = mkIfaceFixCache fixities
818 }
819 where
820 fixities = (getOccName seqId, Fixity 0 InfixR) -- seq is infixr 0
821 : (occName funTyConName, funTyFixity) -- trac #10145
822 : mapMaybe mkFixity allThePrimOps
823 mkFixity op = (,) (primOpOcc op) <$> primOpFixity op
824
825 {-
826 *********************************************************
827 * *
828 \subsection{Statistics}
829 * *
830 *********************************************************
831 -}
832
833 ifaceStats :: ExternalPackageState -> SDoc
834 ifaceStats eps
835 = hcat [text "Renamer stats: ", msg]
836 where
837 stats = eps_stats eps
838 msg = vcat
839 [int (n_ifaces_in stats) <+> text "interfaces read",
840 hsep [ int (n_decls_out stats), text "type/class/variable imported, out of",
841 int (n_decls_in stats), text "read"],
842 hsep [ int (n_insts_out stats), text "instance decls imported, out of",
843 int (n_insts_in stats), text "read"],
844 hsep [ int (n_rules_out stats), text "rule decls imported, out of",
845 int (n_rules_in stats), text "read"]
846 ]
847
848 {-
849 ************************************************************************
850 * *
851 Printing interfaces
852 * *
853 ************************************************************************
854 -}
855
856 -- | Read binary interface, and print it out
857 showIface :: HscEnv -> FilePath -> IO ()
858 showIface hsc_env filename = do
859 -- skip the hi way check; we don't want to worry about profiled vs.
860 -- non-profiled interfaces, for example.
861 iface <- initTcRnIf 's' hsc_env () () $
862 readBinIface IgnoreHiWay TraceBinIFaceReading filename
863 let dflags = hsc_dflags hsc_env
864 log_action dflags dflags SevDump noSrcSpan defaultDumpStyle (pprModIface iface)
865
866 pprModIface :: ModIface -> SDoc
867 -- Show a ModIface
868 pprModIface iface
869 = vcat [ ptext (sLit "interface")
870 <+> ppr (mi_module iface) <+> pp_boot
871 <+> (if mi_orphan iface then ptext (sLit "[orphan module]") else Outputable.empty)
872 <+> (if mi_finsts iface then ptext (sLit "[family instance module]") else Outputable.empty)
873 <+> (if mi_hpc iface then ptext (sLit "[hpc]") else Outputable.empty)
874 <+> integer hiVersion
875 , nest 2 (text "interface hash:" <+> ppr (mi_iface_hash iface))
876 , nest 2 (text "ABI hash:" <+> ppr (mi_mod_hash iface))
877 , nest 2 (text "export-list hash:" <+> ppr (mi_exp_hash iface))
878 , nest 2 (text "orphan hash:" <+> ppr (mi_orphan_hash iface))
879 , nest 2 (text "flag hash:" <+> ppr (mi_flag_hash iface))
880 , nest 2 (text "sig of:" <+> ppr (mi_sig_of iface))
881 , nest 2 (text "used TH splices:" <+> ppr (mi_used_th iface))
882 , nest 2 (ptext (sLit "where"))
883 , ptext (sLit "exports:")
884 , nest 2 (vcat (map pprExport (mi_exports iface)))
885 , pprDeps (mi_deps iface)
886 , vcat (map pprUsage (mi_usages iface))
887 , vcat (map pprIfaceAnnotation (mi_anns iface))
888 , pprFixities (mi_fixities iface)
889 , vcat [ppr ver $$ nest 2 (ppr decl) | (ver,decl) <- mi_decls iface]
890 , vcat (map ppr (mi_insts iface))
891 , vcat (map ppr (mi_fam_insts iface))
892 , vcat (map ppr (mi_rules iface))
893 , pprVectInfo (mi_vect_info iface)
894 , ppr (mi_warns iface)
895 , pprTrustInfo (mi_trust iface)
896 , pprTrustPkg (mi_trust_pkg iface)
897 ]
898 where
899 pp_boot | mi_boot iface = ptext (sLit "[boot]")
900 | otherwise = 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")