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