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