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")