ghc/compiler/iface/LoadIface.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section{Dealing with interface files}
   5
   6 \begin{code}
   7 module LoadIface (
   8         loadHomeInterface, loadInterface, loadDecls,
   9         loadSrcInterface, loadOrphanModules,
  10         findAndReadIface, readIface,    -- Used when reading the module's old interface
  11         predInstGates, ifaceInstGates, ifaceStats, discardDeclPrags,
  12         initExternalPackageState
  13    ) where
  14
  15 #include "HsVersions.h"
  16
  17 import {-# SOURCE #-}   TcIface( tcIfaceDecl )
  18
  19 import Packages         ( PackageState(..), PackageIdH(..), isHomePackage )
  20 import DynFlags         ( DynFlags(..), DynFlag( Opt_IgnoreInterfacePragmas ),
  21                           isOneShot )
  22 import IfaceSyn         ( IfaceDecl(..), IfaceConDecl(..), IfaceClassOp(..),
  23                           IfaceConDecls(..), IfaceInst(..), IfaceRule(..),
  24                           IfaceExpr(..), IfaceTyCon(..), IfaceIdInfo(..),
  25                           IfaceType(..), IfacePredType(..), IfaceExtName,
  26                           mkIfaceExtName )
  27 import IfaceEnv         ( newGlobalBinder, lookupIfaceExt, lookupIfaceTc, lookupAvail )
  28 import HscTypes         ( ModIface(..), TyThing, emptyModIface, EpsStats(..),
  29                           addEpsInStats, ExternalPackageState(..),
  30                           PackageTypeEnv, emptyTypeEnv,  HscEnv(..),
  31                           lookupIfaceByModule, emptyPackageIfaceTable,
  32                           IsBootInterface, mkIfaceFixCache, Gated,
  33                           implicitTyThings, addRulesToPool, addInstsToPool
  34                          )
  35
  36 import BasicTypes       ( Version, Fixity(..), FixityDirection(..),
  37                           isMarkedStrict )
  38 import TcType           ( Type, tcSplitTyConApp_maybe )
  39 import Type             ( funTyCon )
  40 import TcRnMonad
  41
  42 import PrelNames        ( gHC_PRIM )
  43 import PrelInfo         ( ghcPrimExports )
  44 import PrelRules        ( builtinRules )
  45 import Rules            ( emptyRuleBase )
  46 import InstEnv          ( emptyInstEnv )
  47 import Name             ( Name {-instance NamedThing-}, getOccName,
  48                           nameModule, isInternalName )
  49 import NameEnv
  50 import MkId             ( seqId )
  51 import Module           ( Module, ModLocation(ml_hi_file), emptyModuleEnv,
  52                           addBootSuffix_maybe,
  53                           extendModuleEnv, lookupModuleEnv, moduleUserString
  54                         )
  55 import OccName          ( OccName, mkOccEnv, lookupOccEnv, mkClassTyConOcc, mkClassDataConOcc,
  56                           mkSuperDictSelOcc, mkDataConWrapperOcc, mkDataConWorkerOcc )
  57 import Class            ( Class, className )
  58 import TyCon            ( tyConName )
  59 import SrcLoc           ( importedSrcLoc )
  60 import Maybes           ( mapCatMaybes, MaybeErr(..) )
  61 import FastString       ( mkFastString )
  62 import ErrUtils         ( Message )
  63 import Finder           ( findModule, findPackageModule,  FindResult(..), cantFindError )
  64 import Outputable
  65 import BinIface         ( readBinIface )
  66 import Panic            ( ghcError, tryMost, showException, GhcException(..) )
  67 import List             ( nub )
  68
  69 import DATA_IOREF       ( readIORef )
  70 \end{code}
  71
  72
  73 %************************************************************************
  74 %*                                                                      *
  75                 loadSrcInterface, loadOrphanModules
  76
  77                 These two are called from TcM-land
  78 %*                                                                      *
  79 %************************************************************************
  80
  81 \begin{code}
  82 loadSrcInterface :: SDoc -> Module -> IsBootInterface -> RnM ModIface
  83 -- This is called for each 'import' declaration in the source code
  84 -- On a failure, fail in the monad with an error message
  85
  86 loadSrcInterface doc mod want_boot
  87   = do  { mb_iface <- initIfaceTcRn $
  88                       loadInterface doc mod (ImportByUser want_boot)
  89         ; case mb_iface of
  90             Failed err      -> failWithTc (elaborate err)
  91             Succeeded iface -> return iface
  92         }
  93   where
  94     elaborate err = hang (ptext SLIT("Failed to load interface for") <+>
  95                           quotes (ppr mod) <> colon) 4 err
  96
  97 loadOrphanModules :: [Module] -> TcM ()
  98 loadOrphanModules mods
  99   | null mods = returnM ()
 100   | otherwise = initIfaceTcRn $
 101                 do { traceIf (text "Loading orphan modules:" <+>
 102                                  fsep (map ppr mods))
 103                    ; mappM_ load mods
 104                    ; returnM () }
 105   where
 106     load mod   = loadSysInterface (mk_doc mod) mod
 107     mk_doc mod = ppr mod <+> ptext SLIT("is a orphan-instance module")
 108 \end{code}
 109
 110 %*********************************************************
 111 %*                                                      *
 112                 loadHomeInterface
 113                 Called from Iface-land
 114 %*                                                      *
 115 %*********************************************************
 116
 117 \begin{code}
 118 loadHomeInterface :: SDoc -> Name -> IfM lcl ModIface
 119 loadHomeInterface doc name
 120   = ASSERT2( not (isInternalName name), ppr name <+> parens doc )
 121     loadSysInterface doc (nameModule name)
 122
 123 loadSysInterface :: SDoc -> Module -> IfM lcl ModIface
 124 -- A wrapper for loadInterface that Throws an exception if it fails
 125 loadSysInterface doc mod_name
 126   = do  { mb_iface <- loadInterface doc mod_name ImportBySystem
 127         ; case mb_iface of
 128             Failed err      -> ghcError (ProgramError (showSDoc err))
 129             Succeeded iface -> return iface }
 130 \end{code}
 131
 132
 133 %*********************************************************
 134 %*                                                      *
 135                 loadInterface
 136
 137         The main function to load an interface
 138         for an imported module, and put it in
 139         the External Package State
 140 %*                                                      *
 141 %*********************************************************
 142
 143 \begin{code}
 144 loadInterface :: SDoc -> Module -> WhereFrom
 145               -> IfM lcl (MaybeErr Message ModIface)
 146 -- If it can't find a suitable interface file, we
 147 --      a) modify the PackageIfaceTable to have an empty entry
 148 --              (to avoid repeated complaints)
 149 --      b) return (Left message)
 150 --
 151 -- It's not necessarily an error for there not to be an interface
 152 -- file -- perhaps the module has changed, and that interface
 153 -- is no longer used
 154
 155 loadInterface doc_str mod from
 156   = do  {       -- Read the state
 157           (eps,hpt) <- getEpsAndHpt
 158
 159         ; traceIf (text "Considering whether to load" <+> ppr mod <+> ppr from)
 160
 161                 -- Check whether we have the interface already
 162         ; case lookupIfaceByModule hpt (eps_PIT eps) mod of {
 163             Just iface
 164                 -> returnM (Succeeded iface) ;  -- Already loaded
 165                         -- The (src_imp == mi_boot iface) test checks that the already-loaded
 166                         -- interface isn't a boot iface.  This can conceivably happen,
 167                         -- if an earlier import had a before we got to real imports.   I think.
 168             other -> do
 169
 170         { let { hi_boot_file = case from of
 171                                 ImportByUser usr_boot -> usr_boot
 172                                 ImportBySystem        -> sys_boot
 173
 174               ; mb_dep   = lookupModuleEnv (eps_is_boot eps) mod
 175               ; sys_boot = case mb_dep of
 176                                 Just (_, is_boot) -> is_boot
 177                                 Nothing           -> False
 178                         -- The boot-ness of the requested interface,
 179               }         -- based on the dependencies in directly-imported modules
 180
 181         -- READ THE MODULE IN
 182         ; let explicit | ImportByUser _ <- from = True
 183                        | otherwise              = False
 184         ; read_result <- findAndReadIface explicit doc_str mod hi_boot_file
 185         ; dflags <- getDOpts
 186         ; case read_result of {
 187             Failed err -> do
 188                 { let fake_iface = emptyModIface HomePackage mod
 189
 190                 ; updateEps_ $ \eps ->
 191                         eps { eps_PIT = extendModuleEnv (eps_PIT eps) (mi_module fake_iface) fake_iface }
 192                         -- Not found, so add an empty iface to
 193                         -- the EPS map so that we don't look again
 194
 195                 ; returnM (Failed err) } ;
 196
 197         -- Found and parsed!
 198             Succeeded (iface, file_path)                        -- Sanity check:
 199                 | ImportBySystem <- from,               --   system-importing...
 200                   isHomePackage (mi_package iface),     --   ...a home-package module
 201                   Nothing <- mb_dep                     --   ...that we know nothing about
 202                 -> returnM (Failed (badDepMsg mod))
 203
 204                 | otherwise ->
 205
 206         let
 207             loc_doc = text file_path <+> colon
 208         in
 209         initIfaceLcl mod loc_doc $ do
 210
 211         --      Load the new ModIface into the External Package State
 212         -- Even home-package interfaces loaded by loadInterface
 213         --      (which only happens in OneShot mode; in Batch/Interactive
 214         --      mode, home-package modules are loaded one by one into the HPT)
 215         -- are put in the EPS.
 216         --
 217         -- The main thing is to add the ModIface to the PIT, but
 218         -- we also take the
 219         --      IfaceDecls, IfaceInst, IfaceRules
 220         -- out of the ModIface and put them into the big EPS pools
 221
 222         -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
 223         ---    names is done correctly (notably, whether this is an .hi file or .hi-boot file).
 224         --     If we do loadExport first the wrong info gets into the cache (unless we
 225         --      explicitly tag each export which seems a bit of a bore)
 226
 227         ; ignore_prags <- doptM Opt_IgnoreInterfacePragmas
 228         ; new_eps_decls <- loadDecls ignore_prags (mi_decls iface)
 229         ; new_eps_insts <- mapM loadInst (mi_insts iface)
 230         ; new_eps_rules <- if ignore_prags
 231                            then return []
 232                            else mapM loadRule (mi_rules iface)
 233
 234         ; let { final_iface = iface {   mi_decls = panic "No mi_decls in PIT",
 235                                         mi_insts = panic "No mi_insts in PIT",
 236                                         mi_rules = panic "No mi_rules in PIT" } }
 237
 238         ; updateEps_  $ \ eps ->
 239                 eps {   eps_PIT   = extendModuleEnv (eps_PIT eps) mod final_iface,
 240                         eps_PTE   = addDeclsToPTE   (eps_PTE eps) new_eps_decls,
 241                         eps_rules = addRulesToPool  (eps_rules eps) new_eps_rules,
 242                         eps_insts = addInstsToPool  (eps_insts eps) new_eps_insts,
 243                         eps_stats = addEpsInStats   (eps_stats eps) (length new_eps_decls)
 244                                                     (length new_eps_insts) (length new_eps_rules) }
 245
 246         ; return (Succeeded final_iface)
 247     }}}}
 248
 249 badDepMsg mod
 250   = hang (ptext SLIT("Interface file inconsistency:"))
 251        2 (sep [ptext SLIT("home-package module") <+> quotes (ppr mod) <+> ptext SLIT("is mentioned,"),
 252                ptext SLIT("but does not appear in the dependencies of the interface")])
 253
 254 -----------------------------------------------------
 255 --      Loading type/class/value decls
 256 -- We pass the full Module name here, replete with
 257 -- its package info, so that we can build a Name for
 258 -- each binder with the right package info in it
 259 -- All subsequent lookups, including crucially lookups during typechecking
 260 -- the declaration itself, will find the fully-glorious Name
 261 -----------------------------------------------------
 262
 263 addDeclsToPTE :: PackageTypeEnv -> [(Name,TyThing)] -> PackageTypeEnv
 264 addDeclsToPTE pte things = extendNameEnvList pte things
 265
 266 loadDecls :: Bool
 267           -> [(Version, IfaceDecl)]
 268           -> IfL [(Name,TyThing)]
 269 loadDecls ignore_prags ver_decls
 270    = do { mod <- getIfModule
 271         ; thingss <- mapM (loadDecl ignore_prags mod) ver_decls
 272         ; return (concat thingss)
 273         }
 274
 275 loadDecl :: Bool                        -- Don't load pragmas into the decl pool
 276          -> Module
 277           -> (Version, IfaceDecl)
 278           -> IfL [(Name,TyThing)]       -- The list can be poked eagerly, but the
 279                                         -- TyThings are forkM'd thunks
 280 loadDecl ignore_prags mod (_version, decl)
 281   = do  {       -- Populate the name cache with final versions of all
 282                 -- the names associated with the decl
 283           main_name      <- mk_new_bndr mod Nothing (ifName decl)
 284         ; implicit_names <- mapM (mk_new_bndr mod (Just main_name)) (ifaceDeclSubBndrs decl)
 285
 286         -- Typecheck the thing, lazily
 287         -- NB. firstly, the laziness is there in case we never need the
 288         -- declaration (in one-shot mode), and secondly it is there so that
 289         -- we don't look up the occurrence of a name before calling mk_new_bndr
 290         -- on the binder.  This is important because we must get the right name
 291         -- which includes its nameParent.
 292         ; thing <- forkM doc (bumpDeclStats main_name >> tcIfaceDecl stripped_decl)
 293         ; let mini_env = mkOccEnv [(getOccName t, t) | t <- implicitTyThings thing]
 294               lookup n = case lookupOccEnv mini_env (getOccName n) of
 295                            Just thing -> thing
 296                            Nothing    -> pprPanic "loadDecl" (ppr main_name <+> ppr n)
 297
 298         ; returnM ((main_name, thing) : [(n, lookup n) | n <- implicit_names]) }
 299                 -- We build a list from the *known* names, with (lookup n) thunks
 300                 -- as the TyThings.  That way we can extend the PTE without poking the
 301                 -- thunks
 302   where
 303     stripped_decl | ignore_prags = discardDeclPrags decl
 304                   | otherwise    = decl
 305
 306         -- mk_new_bndr allocates in the name cache the final canonical
 307         -- name for the thing, with the correct
 308         --      * parent
 309         --      * location
 310         -- imported name, to fix the module correctly in the cache
 311     mk_new_bndr mod mb_parent occ
 312         = newGlobalBinder mod occ mb_parent
 313                           (importedSrcLoc (moduleUserString mod))
 314
 315     doc = ptext SLIT("Declaration for") <+> ppr (ifName decl)
 316
 317 discardDeclPrags :: IfaceDecl -> IfaceDecl
 318 discardDeclPrags decl@(IfaceId {ifIdInfo = HasInfo _}) = decl { ifIdInfo = NoInfo }
 319 discardDeclPrags decl                                  = decl
 320
 321 bumpDeclStats :: Name -> IfL ()         -- Record that one more declaration has actually been used
 322 bumpDeclStats name
 323   = do  { traceIf (text "Loading decl for" <+> ppr name)
 324         ; updateEps_ (\eps -> let stats = eps_stats eps
 325                               in eps { eps_stats = stats { n_decls_out = n_decls_out stats + 1 } })
 326         }
 327
 328 -----------------
 329 ifaceDeclSubBndrs :: IfaceDecl -> [OccName]
 330 --  *Excludes* the 'main' name, but *includes* the implicitly-bound names
 331 -- Deeply revolting, because it has to predict what gets bound,
 332 -- especially the question of whether there's a wrapper for a datacon
 333
 334 ifaceDeclSubBndrs (IfaceClass {ifCtxt = sc_ctxt, ifName = cls_occ, ifSigs = sigs })
 335   = [tc_occ, dc_occ, dcww_occ] ++
 336     [op | IfaceClassOp op _ _ <- sigs] ++
 337     [mkSuperDictSelOcc n cls_occ | n <- [1..n_ctxt]]
 338   where
 339     n_ctxt = length sc_ctxt
 340     n_sigs = length sigs
 341     tc_occ  = mkClassTyConOcc cls_occ
 342     dc_occ  = mkClassDataConOcc cls_occ
 343     dcww_occ | is_newtype = mkDataConWrapperOcc dc_occ  -- Newtypes have wrapper but no worker
 344              | otherwise  = mkDataConWorkerOcc dc_occ   -- Otherwise worker but no wrapper
 345     is_newtype = n_sigs + n_ctxt == 1                   -- Sigh
 346
 347 ifaceDeclSubBndrs (IfaceData {ifCons = IfAbstractTyCon})
 348   = []
 349 -- Newtype
 350 ifaceDeclSubBndrs (IfaceData {ifCons = IfNewTyCon (IfVanillaCon { ifConOcc = con_occ,
 351                                                                   ifConFields = fields})})
 352   = fields ++ [con_occ, mkDataConWrapperOcc con_occ]
 353         -- Wrapper, no worker; see MkId.mkDataConIds
 354
 355 ifaceDeclSubBndrs (IfaceData {ifCons = IfDataTyCon _ cons})
 356   = nub (concatMap fld_occs cons)       -- Eliminate duplicate fields
 357     ++ concatMap dc_occs cons
 358   where
 359     fld_occs (IfVanillaCon { ifConFields = fields }) = fields
 360     fld_occs (IfGadtCon {})                          = []
 361     dc_occs con_decl
 362         | has_wrapper = [con_occ, work_occ, wrap_occ]
 363         | otherwise   = [con_occ, work_occ]
 364         where
 365           con_occ = ifConOcc con_decl
 366           strs    = ifConStricts con_decl
 367           wrap_occ = mkDataConWrapperOcc con_occ
 368           work_occ = mkDataConWorkerOcc con_occ
 369           has_wrapper = any isMarkedStrict strs -- See MkId.mkDataConIds (sigh)
 370                 -- ToDo: may miss strictness in existential dicts
 371
 372 ifaceDeclSubBndrs _other                      = []
 373
 374 -----------------------------------------------------
 375 --      Loading instance decls
 376 -----------------------------------------------------
 377
 378 loadInst :: IfaceInst -> IfL (Name, Gated IfaceInst)
 379
 380 loadInst decl@(IfaceInst {ifInstHead = inst_ty})
 381   = do  {
 382         -- Find out what type constructors and classes are "gates" for the
 383         -- instance declaration.  If all these "gates" are slurped in then
 384         -- we should slurp the instance decl too.
 385         --
 386         -- We *don't* want to count names in the context part as gates, though.
 387         -- For example:
 388         --              instance Foo a => Baz (T a) where ...
 389         --
 390         -- Here the gates are Baz and T, but *not* Foo.
 391         --
 392         -- HOWEVER: functional dependencies make things more complicated
 393         --      class C a b | a->b where ...
 394         --      instance C Foo Baz where ...
 395         -- Here, the gates are really only C and Foo, *not* Baz.
 396         -- That is, if C and Foo are visible, even if Baz isn't, we must
 397         -- slurp the decl.
 398         --
 399         -- Rather than take fundeps into account "properly", we just slurp
 400         -- if C is visible and *any one* of the Names in the types
 401         -- This is a slightly brutal approximation, but most instance decls
 402         -- are regular H98 ones and it's perfect for them.
 403         --
 404         -- NOTICE that we rename the type before extracting its free
 405         -- variables.  The free-variable finder for a renamed HsType
 406         -- does the Right Thing for built-in syntax like [] and (,).
 407           let { (cls_ext, tc_exts) = ifaceInstGates inst_ty }
 408         ; cls <- lookupIfaceExt cls_ext
 409         ; tcs <- mapM lookupIfaceTc tc_exts
 410         ; (mod, doc) <- getIfCtxt
 411         ; returnM (cls, (tcs, (mod, doc, decl)))
 412         }
 413
 414 -----------------------------------------------------
 415 --      Loading Rules
 416 -----------------------------------------------------
 417
 418 loadRule :: IfaceRule -> IfL (Gated IfaceRule)
 419 -- "Gate" the rule simply by a crude notion of the free vars of
 420 -- the LHS.  It can be crude, because having too few free vars is safe.
 421 loadRule decl@(IfaceRule {ifRuleHead = fn, ifRuleArgs = args})
 422   = do  { names <- mapM lookupIfaceExt (fn : arg_fvs)
 423         ; (mod, doc) <- getIfCtxt
 424         ; returnM (names, (mod, doc, decl)) }
 425   where
 426     arg_fvs = [n | arg <- args, n <- crudeIfExprGblFvs arg]
 427
 428
 429 ---------------------------
 430 crudeIfExprGblFvs :: IfaceExpr -> [IfaceExtName]
 431 -- A crude approximation to the free external names of an IfExpr
 432 -- Returns a subset of the true answer
 433 crudeIfExprGblFvs (IfaceType ty) = get_tcs ty
 434 crudeIfExprGblFvs (IfaceExt v)   = [v]
 435 crudeIfExprGblFvs other          = []   -- Well, I said it was crude
 436
 437 get_tcs :: IfaceType -> [IfaceExtName]
 438 -- Get a crude subset of the TyCons of an IfaceType
 439 get_tcs (IfaceTyVar _)      = []
 440 get_tcs (IfaceAppTy t1 t2)  = get_tcs t1 ++ get_tcs t2
 441 get_tcs (IfaceFunTy t1 t2)  = get_tcs t1 ++ get_tcs t2
 442 get_tcs (IfaceForAllTy _ t) = get_tcs t
 443 get_tcs (IfacePredTy st)    = case st of
 444                                  IfaceClassP cl ts -> get_tcs_s ts
 445                                  IfaceIParam _ t   -> get_tcs t
 446 get_tcs (IfaceTyConApp (IfaceTc tc) ts) = tc : get_tcs_s ts
 447 get_tcs (IfaceTyConApp other        ts) = get_tcs_s ts
 448
 449 -- The lists are always small => appending is fine
 450 get_tcs_s :: [IfaceType] -> [IfaceExtName]
 451 get_tcs_s tys = foldr ((++) . get_tcs) [] tys
 452
 453
 454 ----------------
 455 getIfCtxt :: IfL (Module, SDoc)
 456 getIfCtxt = do { env <- getLclEnv; return (if_mod env, if_loc env) }
 457 \end{code}
 458
 459
 460 %*********************************************************
 461 %*                                                      *
 462                 Gating
 463 %*                                                      *
 464 %*********************************************************
 465
 466 Extract the gates of an instance declaration
 467
 468 \begin{code}
 469 ifaceInstGates :: IfaceType -> (IfaceExtName, [IfaceTyCon])
 470 -- Return the class, and the tycons mentioned in the rest of the head
 471 -- We only pick the TyCon at the root of each type, to avoid
 472 -- difficulties with overlap.  For example, suppose there are interfaces
 473 -- in the pool for
 474 --      C Int b
 475 --      C a [b]
 476 --      C a [T]
 477 -- Then, if we are trying to resolve (C Int x), we need the first
 478 --       if we are trying to resolve (C x [y]), we need *both* the latter
 479 --       two, even though T is not involved yet, so that we spot the overlap
 480
 481 ifaceInstGates (IfaceForAllTy _ t)                 = ifaceInstGates t
 482 ifaceInstGates (IfaceFunTy _ t)                    = ifaceInstGates t
 483 ifaceInstGates (IfacePredTy (IfaceClassP cls tys)) = (cls, instHeadTyconGates tys)
 484 ifaceInstGates other = pprPanic "ifaceInstGates" (ppr other)
 485         -- The other cases should not happen
 486
 487 instHeadTyconGates tys = mapCatMaybes root_tycon tys
 488   where
 489     root_tycon (IfaceFunTy _ _)      = Just (IfaceTc funTyConExtName)
 490     root_tycon (IfaceTyConApp tc _)  = Just tc
 491     root_tycon other                 = Nothing
 492
 493 funTyConExtName = mkIfaceExtName (tyConName funTyCon)
 494
 495
 496 predInstGates :: Class -> [Type] -> (Name, [Name])
 497 -- The same function, only this time on the predicate found in a dictionary
 498 predInstGates cls tys
 499   = (className cls, mapCatMaybes root_tycon tys)
 500   where
 501     root_tycon ty = case tcSplitTyConApp_maybe ty of
 502                         Just (tc, _) -> Just (tyConName tc)
 503                         Nothing      -> Nothing
 504 \end{code}
 505
 506
 507 %*********************************************************
 508 %*                                                      *
 509 \subsection{Reading an interface file}
 510 %*                                                      *
 511 %*********************************************************
 512
 513 \begin{code}
 514 findAndReadIface :: Bool                -- True <=> explicit user import
 515                  -> SDoc -> Module
 516                  -> IsBootInterface     -- True  <=> Look for a .hi-boot file
 517                                         -- False <=> Look for .hi file
 518                  -> TcRnIf gbl lcl (MaybeErr Message (ModIface, FilePath))
 519         -- Nothing <=> file not found, or unreadable, or illegible
 520         -- Just x  <=> successfully found and parsed
 521
 522         -- It *doesn't* add an error to the monad, because
 523         -- sometimes it's ok to fail... see notes with loadInterface
 524
 525 findAndReadIface explicit doc_str mod_name hi_boot_file
 526   = do  { traceIf (sep [hsep [ptext SLIT("Reading"),
 527                               if hi_boot_file
 528                                 then ptext SLIT("[boot]")
 529                                 else empty,
 530                               ptext SLIT("interface for"),
 531                               ppr mod_name <> semi],
 532                         nest 4 (ptext SLIT("reason:") <+> doc_str)])
 533
 534         -- Check for GHC.Prim, and return its static interface
 535         ; dflags <- getDOpts
 536         ; let base_pkg = basePackageId (pkgState dflags)
 537         ; if mod_name == gHC_PRIM
 538           then returnM (Succeeded (ghcPrimIface{ mi_package = base_pkg },
 539                         "<built in interface for GHC.Prim>"))
 540           else do
 541
 542         -- Look for the file
 543         ; hsc_env <- getTopEnv
 544         ; mb_found <- ioToIOEnv (findHiFile hsc_env explicit mod_name hi_boot_file)
 545         ; case mb_found of {
 546               Failed err -> do
 547                 { traceIf (ptext SLIT("...not found"))
 548                 ; dflags <- getDOpts
 549                 ; returnM (Failed (cantFindError dflags mod_name err)) } ;
 550
 551               Succeeded (file_path, pkg) -> do
 552
 553         -- Found file, so read it
 554         { traceIf (ptext SLIT("readIFace") <+> text file_path)
 555         ; read_result <- readIface mod_name file_path hi_boot_file
 556         ; case read_result of
 557             Failed err -> returnM (Failed (badIfaceFile file_path err))
 558             Succeeded iface
 559                 | mi_module iface /= mod_name ->
 560                   return (Failed (wrongIfaceModErr iface mod_name file_path))
 561                 | otherwise ->
 562                   returnM (Succeeded (iface{mi_package=pkg}, file_path))
 563                         -- Don't forget to fill in the package name...
 564         }}}
 565
 566 findHiFile :: HscEnv -> Bool -> Module -> IsBootInterface
 567            -> IO (MaybeErr FindResult (FilePath, PackageIdH))
 568 findHiFile hsc_env explicit mod_name hi_boot_file
 569  = do {
 570         -- In interactive or --make mode, we are *not allowed* to demand-load
 571         -- a home package .hi file.  So don't even look for them.
 572         -- This helps in the case where you are sitting in eg. ghc/lib/std
 573         -- and start up GHCi - it won't complain that all the modules it tries
 574         -- to load are found in the home location.
 575         let { home_allowed = isOneShot (ghcMode (hsc_dflags hsc_env)) } ;
 576         maybe_found <-  if home_allowed
 577                         then findModule        hsc_env mod_name explicit
 578                         else findPackageModule hsc_env mod_name explicit;
 579
 580         case maybe_found of
 581           Found loc pkg -> return (Succeeded (path, pkg))
 582                         where
 583                            path = addBootSuffix_maybe hi_boot_file (ml_hi_file loc)
 584
 585           err -> return (Failed err)
 586         }
 587 \end{code}
 588
 589 @readIface@ tries just the one file.
 590
 591 \begin{code}
 592 readIface :: Module -> String -> IsBootInterface
 593           -> TcRnIf gbl lcl (MaybeErr Message ModIface)
 594         -- Failed err    <=> file not found, or unreadable, or illegible
 595         -- Succeeded iface <=> successfully found and parsed
 596
 597 readIface wanted_mod file_path is_hi_boot_file
 598   = do  { dflags <- getDOpts
 599         ; ioToIOEnv $ do
 600         { res <- tryMost (readBinIface file_path)
 601         ; case res of
 602             Right iface
 603                 | wanted_mod == actual_mod -> return (Succeeded iface)
 604                 | otherwise                -> return (Failed err)
 605                 where
 606                   actual_mod = mi_module iface
 607                   err = hiModuleNameMismatchWarn wanted_mod actual_mod
 608
 609             Left exn    -> return (Failed (text (showException exn)))
 610     }}
 611 \end{code}
 612
 613
 614 %*********************************************************
 615 %*                                                       *
 616         Wired-in interface for GHC.Prim
 617 %*                                                       *
 618 %*********************************************************
 619
 620 \begin{code}
 621 initExternalPackageState :: ExternalPackageState
 622 initExternalPackageState
 623   = EPS {
 624       eps_is_boot    = emptyModuleEnv,
 625       eps_PIT        = emptyPackageIfaceTable,
 626       eps_PTE        = emptyTypeEnv,
 627       eps_inst_env   = emptyInstEnv,
 628       eps_rule_base  = emptyRuleBase,
 629       eps_insts      = emptyNameEnv,
 630       eps_rules      = addRulesToPool [] (map mk_gated_rule builtinRules),
 631         -- Initialise the EPS rule pool with the built-in rules
 632       eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0
 633                            , n_insts_in = 0, n_insts_out = 0
 634                            , n_rules_in = length builtinRules, n_rules_out = 0 }
 635     }
 636   where
 637     mk_gated_rule (fn_name, core_rule)
 638         = ([fn_name], (nameModule fn_name, ptext SLIT("<built-in rule>"),
 639            IfaceBuiltinRule (mkIfaceExtName fn_name) core_rule))
 640 \end{code}
 641
 642
 643 %*********************************************************
 644 %*                                                       *
 645         Wired-in interface for GHC.Prim
 646 %*                                                       *
 647 %*********************************************************
 648
 649 \begin{code}
 650 ghcPrimIface :: ModIface
 651 ghcPrimIface
 652   = (emptyModIface HomePackage gHC_PRIM) {
 653         mi_exports  = [(gHC_PRIM, ghcPrimExports)],
 654         mi_decls    = [],
 655         mi_fixities = fixities,
 656         mi_fix_fn  = mkIfaceFixCache fixities
 657     }
 658   where
 659     fixities = [(getOccName seqId, Fixity 0 InfixR)]
 660                         -- seq is infixr 0
 661 \end{code}
 662
 663 %*********************************************************
 664 %*                                                      *
 665 \subsection{Statistics}
 666 %*                                                      *
 667 %*********************************************************
 668
 669 \begin{code}
 670 ifaceStats :: ExternalPackageState -> SDoc
 671 ifaceStats eps
 672   = hcat [text "Renamer stats: ", msg]
 673   where
 674     stats = eps_stats eps
 675     msg = vcat
 676         [int (n_ifaces_in stats) <+> text "interfaces read",
 677          hsep [ int (n_decls_out stats), text "type/class/variable imported, out of",
 678                 int (n_decls_in stats), text "read"],
 679          hsep [ int (n_insts_out stats), text "instance decls imported, out of",
 680                 int (n_insts_in stats), text "read"],
 681          hsep [ int (n_rules_out stats), text "rule decls imported, out of",
 682                 int (n_rules_in stats), text "read"]
 683         ]
 684 \end{code}
 685
 686
 687 %*********************************************************
 688 %*                                                       *
 689 \subsection{Errors}
 690 %*                                                       *
 691 %*********************************************************
 692
 693 \begin{code}
 694 badIfaceFile file err
 695   = vcat [ptext SLIT("Bad interface file:") <+> text file,
 696           nest 4 err]
 697
 698 hiModuleNameMismatchWarn :: Module -> Module -> Message
 699 hiModuleNameMismatchWarn requested_mod read_mod =
 700     hsep [ ptext SLIT("Something is amiss; requested module name")
 701          , ppr requested_mod
 702          , ptext SLIT("differs from name found in the interface file")
 703          , ppr read_mod
 704          ]
 705
 706 wrongIfaceModErr iface mod_name file_path
 707   = sep [ptext SLIT("Interface file") <+> iface_file,
 708          ptext SLIT("contains module") <+> quotes (ppr (mi_module iface)) <> comma,
 709          ptext SLIT("but we were expecting module") <+> quotes (ppr mod_name),
 710          sep [ptext SLIT("Probable cause: the source code which generated"),
 711              nest 2 iface_file,
 712              ptext SLIT("has an incompatible module name")
 713             ]
 714         ]
 715   where iface_file = doubleQuotes (text file_path)
 716 \end{code}