compiler/iface/LoadIface.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   4 %
   5
   6 Loading interface files
   7
   8 \begin{code}
   9 module LoadIface (
  10         loadInterface, loadInterfaceForName, loadWiredInHomeIface,
  11         loadSrcInterface, loadSysInterface, loadUserInterface, loadOrphanModules,
  12         findAndReadIface, readIface,    -- Used when reading the module's old interface
  13         loadDecls,      -- Should move to TcIface and be renamed
  14         initExternalPackageState,
  15
  16         ifaceStats, pprModIface, showIface
  17    ) where
  18
  19 #include "HsVersions.h"
  20
  21 import {-# SOURCE #-}   TcIface( tcIfaceDecl, tcIfaceRules, tcIfaceInst,
  22                                  tcIfaceFamInst, tcIfaceVectInfo, tcIfaceAnnotations )
  23
  24 import DynFlags
  25 import IfaceSyn
  26 import IfaceEnv
  27 import HscTypes
  28
  29 import BasicTypes hiding (SuccessFlag(..))
  30 import TcRnMonad
  31
  32 import PrelNames
  33 import PrelInfo
  34 import Rules
  35 import Annotations
  36 import InstEnv
  37 import FamInstEnv
  38 import Name
  39 import NameEnv
  40 import Module
  41 import Maybes
  42 import ErrUtils
  43 import Finder
  44 import UniqFM
  45 import StaticFlags
  46 import Outputable
  47 import BinIface
  48 import Panic
  49 import Util
  50 import FastString
  51 import Fingerprint
  52
  53 import Control.Monad
  54 \end{code}
  55
  56
  57 %************************************************************************
  58 %*                                                                      *
  59         loadSrcInterface, loadOrphanModules, loadHomeInterface
  60
  61                 These three are called from TcM-land
  62 %*                                                                      *
  63 %************************************************************************
  64
  65 \begin{code}
  66 -- | Load the interface corresponding to an @import@ directive in
  67 -- source code.  On a failure, fail in the monad with an error message.
  68 loadSrcInterface :: SDoc
  69                  -> ModuleName
  70                  -> IsBootInterface     -- {-# SOURCE #-} ?
  71                  -> Maybe FastString    -- "package", if any
  72                  -> RnM ModIface
  73
  74 loadSrcInterface doc mod want_boot maybe_pkg  = do
  75   -- We must first find which Module this import refers to.  This involves
  76   -- calling the Finder, which as a side effect will search the filesystem
  77   -- and create a ModLocation.  If successful, loadIface will read the
  78   -- interface; it will call the Finder again, but the ModLocation will be
  79   -- cached from the first search.
  80   hsc_env <- getTopEnv
  81   res <- liftIO $ findImportedModule hsc_env mod maybe_pkg
  82   case res of
  83     Found _ mod -> do
  84       mb_iface <- initIfaceTcRn $ loadInterface doc mod (ImportByUser want_boot)
  85       case mb_iface of
  86         Failed err      -> failWithTc err
  87         Succeeded iface -> return iface
  88     err ->
  89         let dflags = hsc_dflags hsc_env in
  90         failWithTc (cannotFindInterface dflags mod err)
  91
  92 -- | Load interfaces for a collection of orphan modules.
  93 loadOrphanModules :: [Module]         -- the modules
  94                   -> Bool             -- these are family instance-modules
  95                   -> TcM ()
  96 loadOrphanModules mods isFamInstMod
  97   | null mods = return ()
  98   | otherwise = initIfaceTcRn $
  99                 do { traceIf (text "Loading orphan modules:" <+>
 100                                  fsep (map ppr mods))
 101                    ; mapM_ load mods
 102                    ; return () }
 103   where
 104     load mod   = loadSysInterface (mk_doc mod) mod
 105     mk_doc mod
 106       | isFamInstMod = ppr mod <+> ptext (sLit "is a family-instance module")
 107       | otherwise    = ppr mod <+> ptext (sLit "is a orphan-instance module")
 108
 109 -- | Loads the interface for a given Name.
 110 loadInterfaceForName :: SDoc -> Name -> TcRn ModIface
 111 loadInterfaceForName doc name
 112   = do {
 113     when debugIsOn $ do
 114         -- Should not be called with a name from the module being compiled
 115         { this_mod <- getModule
 116         ; MASSERT2( not (nameIsLocalOrFrom this_mod name), ppr name <+> parens doc )
 117         }
 118   ; ASSERT2( isExternalName name, ppr name )
 119     initIfaceTcRn $ loadSysInterface doc (nameModule name)
 120   }
 121
 122 -- | An 'IfM' function to load the home interface for a wired-in thing,
 123 -- so that we're sure that we see its instance declarations and rules
 124 -- See Note [Loading instances for wired-in things] in TcIface
 125 loadWiredInHomeIface :: Name -> IfM lcl ()
 126 loadWiredInHomeIface name
 127   = ASSERT( isWiredInName name )
 128     do _ <- loadSysInterface doc (nameModule name); return ()
 129   where
 130     doc = ptext (sLit "Need home interface for wired-in thing") <+> ppr name
 131
 132 -- | Loads a system interface and throws an exception if it fails
 133 loadSysInterface :: SDoc -> Module -> IfM lcl ModIface
 134 loadSysInterface doc mod_name = loadInterfaceWithException doc mod_name ImportBySystem
 135
 136 -- | Loads a user interface and throws an exception if it fails. The first parameter indicates
 137 -- whether we should import the boot variant of the module
 138 loadUserInterface :: Bool -> SDoc -> Module -> IfM lcl ModIface
 139 loadUserInterface is_boot doc mod_name = loadInterfaceWithException doc mod_name (ImportByUser is_boot)
 140
 141 -- | A wrapper for 'loadInterface' that throws an exception if it fails
 142 loadInterfaceWithException :: SDoc -> Module -> WhereFrom -> IfM lcl ModIface
 143 loadInterfaceWithException doc mod_name where_from
 144   = do  { mb_iface <- loadInterface doc mod_name where_from
 145         ; case mb_iface of
 146             Failed err      -> ghcError (ProgramError (showSDoc err))
 147             Succeeded iface -> return iface }
 148 \end{code}
 149
 150
 151 %*********************************************************
 152 %*                                                      *
 153                 loadInterface
 154
 155         The main function to load an interface
 156         for an imported module, and put it in
 157         the External Package State
 158 %*                                                      *
 159 %*********************************************************
 160
 161 \begin{code}
 162 loadInterface :: SDoc -> Module -> WhereFrom
 163               -> IfM lcl (MaybeErr Message ModIface)
 164
 165 -- loadInterface looks in both the HPT and PIT for the required interface
 166 -- If not found, it loads it, and puts it in the PIT (always).
 167
 168 -- If it can't find a suitable interface file, we
 169 --      a) modify the PackageIfaceTable to have an empty entry
 170 --              (to avoid repeated complaints)
 171 --      b) return (Left message)
 172 --
 173 -- It's not necessarily an error for there not to be an interface
 174 -- file -- perhaps the module has changed, and that interface
 175 -- is no longer used
 176
 177 loadInterface doc_str mod from
 178   = do  {       -- Read the state
 179           (eps,hpt) <- getEpsAndHpt
 180
 181         ; traceIf (text "Considering whether to load" <+> ppr mod <+> ppr from)
 182
 183                 -- Check whether we have the interface already
 184         ; dflags <- getDOpts
 185         ; case lookupIfaceByModule dflags hpt (eps_PIT eps) mod of {
 186             Just iface
 187                 -> return (Succeeded iface) ;   -- Already loaded
 188                         -- The (src_imp == mi_boot iface) test checks that the already-loaded
 189                         -- interface isn't a boot iface.  This can conceivably happen,
 190                         -- if an earlier import had a before we got to real imports.   I think.
 191             _ -> do {
 192
 193         -- READ THE MODULE IN
 194         ; read_result <- case (wantHiBootFile dflags eps mod from) of
 195                            Failed err             -> return (Failed err)
 196                            Succeeded hi_boot_file -> findAndReadIface doc_str mod hi_boot_file
 197         ; case read_result of {
 198             Failed err -> do
 199                 { let fake_iface = emptyModIface mod
 200
 201                 ; updateEps_ $ \eps ->
 202                         eps { eps_PIT = extendModuleEnv (eps_PIT eps) (mi_module fake_iface) fake_iface }
 203                         -- Not found, so add an empty iface to
 204                         -- the EPS map so that we don't look again
 205
 206                 ; return (Failed err) } ;
 207
 208         -- Found and parsed!
 209         -- We used to have a sanity check here that looked for:
 210         --  * System importing ..
 211         --  * a home package module ..
 212         --  * that we know nothing about (mb_dep == Nothing)!
 213         --
 214         -- But this is no longer valid because thNameToGhcName allows users to
 215         -- cause the system to load arbitrary interfaces (by supplying an appropriate
 216         -- Template Haskell original-name).
 217             Succeeded (iface, file_path) ->
 218
 219         let
 220             loc_doc = text file_path
 221         in
 222         initIfaceLcl mod loc_doc $ do
 223
 224         --      Load the new ModIface into the External Package State
 225         -- Even home-package interfaces loaded by loadInterface
 226         --      (which only happens in OneShot mode; in Batch/Interactive
 227         --      mode, home-package modules are loaded one by one into the HPT)
 228         -- are put in the EPS.
 229         --
 230         -- The main thing is to add the ModIface to the PIT, but
 231         -- we also take the
 232         --      IfaceDecls, IfaceInst, IfaceFamInst, IfaceRules, IfaceVectInfo
 233         -- out of the ModIface and put them into the big EPS pools
 234
 235         -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
 236         ---    names is done correctly (notably, whether this is an .hi file or .hi-boot file).
 237         --     If we do loadExport first the wrong info gets into the cache (unless we
 238         --      explicitly tag each export which seems a bit of a bore)
 239
 240         ; ignore_prags      <- doptM Opt_IgnoreInterfacePragmas
 241         ; new_eps_decls     <- loadDecls ignore_prags (mi_decls iface)
 242         ; new_eps_insts     <- mapM tcIfaceInst (mi_insts iface)
 243         ; new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
 244         ; new_eps_rules     <- tcIfaceRules ignore_prags (mi_rules iface)
 245         ; new_eps_anns      <- tcIfaceAnnotations (mi_anns iface)
 246         ; new_eps_vect_info <- tcIfaceVectInfo mod (mkNameEnv new_eps_decls)
 247                                                (mi_vect_info iface)
 248
 249         ; let { final_iface = iface {
 250                                 mi_decls     = panic "No mi_decls in PIT",
 251                                 mi_insts     = panic "No mi_insts in PIT",
 252                                 mi_fam_insts = panic "No mi_fam_insts in PIT",
 253                                 mi_rules     = panic "No mi_rules in PIT",
 254                                 mi_anns      = panic "No mi_anns in PIT"
 255                               }
 256                }
 257
 258         ; updateEps_  $ \ eps ->
 259            if elemModuleEnv mod (eps_PIT eps) then eps else
 260             eps {
 261               eps_PIT          = extendModuleEnv (eps_PIT eps) mod final_iface,
 262               eps_PTE          = addDeclsToPTE   (eps_PTE eps) new_eps_decls,
 263               eps_rule_base    = extendRuleBaseList (eps_rule_base eps)
 264                                                     new_eps_rules,
 265               eps_inst_env     = extendInstEnvList (eps_inst_env eps)
 266                                                    new_eps_insts,
 267               eps_fam_inst_env = extendFamInstEnvList (eps_fam_inst_env eps)
 268                                                       new_eps_fam_insts,
 269               eps_vect_info    = plusVectInfo (eps_vect_info eps)
 270                                               new_eps_vect_info,
 271               eps_ann_env      = extendAnnEnvList (eps_ann_env eps)
 272                                                   new_eps_anns,
 273               eps_mod_fam_inst_env
 274                                = let
 275                                    fam_inst_env =
 276                                      extendFamInstEnvList emptyFamInstEnv
 277                                                           new_eps_fam_insts
 278                                  in
 279                                  extendModuleEnv (eps_mod_fam_inst_env eps)
 280                                                  mod
 281                                                  fam_inst_env,
 282               eps_stats        = addEpsInStats (eps_stats eps)
 283                                                (length new_eps_decls)
 284                                                (length new_eps_insts)
 285                                                (length new_eps_rules) }
 286
 287         ; return (Succeeded final_iface)
 288     }}}}
 289
 290 wantHiBootFile :: DynFlags -> ExternalPackageState -> Module -> WhereFrom
 291                -> MaybeErr Message IsBootInterface
 292 -- Figure out whether we want Foo.hi or Foo.hi-boot
 293 wantHiBootFile dflags eps mod from
 294   = case from of
 295        ImportByUser usr_boot
 296           | usr_boot && not this_package
 297           -> Failed (badSourceImport mod)
 298           | otherwise -> Succeeded usr_boot
 299
 300        ImportBySystem
 301           | not this_package   -- If the module to be imported is not from this package
 302           -> Succeeded False   -- don't look it up in eps_is_boot, because that is keyed
 303                                -- on the ModuleName of *home-package* modules only.
 304                                -- We never import boot modules from other packages!
 305
 306           | otherwise
 307           -> case lookupUFM (eps_is_boot eps) (moduleName mod) of
 308                 Just (_, is_boot) -> Succeeded is_boot
 309                 Nothing           -> Succeeded False
 310                      -- The boot-ness of the requested interface,
 311                      -- based on the dependencies in directly-imported modules
 312   where
 313     this_package = thisPackage dflags == modulePackageId mod
 314
 315 badSourceImport :: Module -> SDoc
 316 badSourceImport mod
 317   = hang (ptext (sLit "You cannot {-# SOURCE #-} import a module from another package"))
 318        2 (ptext (sLit "but") <+> quotes (ppr mod) <+> ptext (sLit "is from package")
 319           <+> quotes (ppr (modulePackageId mod)))
 320 \end{code}
 321
 322 {-
 323 Used to be used for the loadInterface sanity check on system imports. That has been removed, but I'm leaving this in pending
 324 review of this decision by SPJ - MCB 10/2008
 325
 326 badDepMsg :: Module -> SDoc
 327 badDepMsg mod
 328   = hang (ptext (sLit "Interface file inconsistency:"))
 329        2 (sep [ptext (sLit "home-package module") <+> quotes (ppr mod) <+> ptext (sLit "is needed,"),
 330                ptext (sLit "but is not listed in the dependencies of the interfaces directly imported by the module being compiled")])
 331 -}
 332
 333 \begin{code}
 334 -----------------------------------------------------
 335 --      Loading type/class/value decls
 336 -- We pass the full Module name here, replete with
 337 -- its package info, so that we can build a Name for
 338 -- each binder with the right package info in it
 339 -- All subsequent lookups, including crucially lookups during typechecking
 340 -- the declaration itself, will find the fully-glorious Name
 341 --
 342 -- We handle ATs specially.  They are not main declarations, but also not
 343 -- implict things (in particular, adding them to `implicitTyThings' would mess
 344 -- things up in the renaming/type checking of source programs).
 345 -----------------------------------------------------
 346
 347 addDeclsToPTE :: PackageTypeEnv -> [(Name,TyThing)] -> PackageTypeEnv
 348 addDeclsToPTE pte things = extendNameEnvList pte things
 349
 350 loadDecls :: Bool
 351           -> [(Fingerprint, IfaceDecl)]
 352           -> IfL [(Name,TyThing)]
 353 loadDecls ignore_prags ver_decls
 354    = do { mod <- getIfModule
 355         ; thingss <- mapM (loadDecl ignore_prags mod) ver_decls
 356         ; return (concat thingss)
 357         }
 358
 359 loadDecl :: Bool                    -- Don't load pragmas into the decl pool
 360          -> Module
 361           -> (Fingerprint, IfaceDecl)
 362           -> IfL [(Name,TyThing)]   -- The list can be poked eagerly, but the
 363                                     -- TyThings are forkM'd thunks
 364 loadDecl ignore_prags mod (_version, decl)
 365   = do  {       -- Populate the name cache with final versions of all
 366                 -- the names associated with the decl
 367           main_name      <- lookupOrig mod (ifName decl)
 368 --        ; traceIf (text "Loading decl for " <> ppr main_name)
 369         ; implicit_names <- mapM (lookupOrig mod) (ifaceDeclSubBndrs decl)
 370
 371         -- Typecheck the thing, lazily
 372         -- NB. Firstly, the laziness is there in case we never need the
 373         -- declaration (in one-shot mode), and secondly it is there so that
 374         -- we don't look up the occurrence of a name before calling mk_new_bndr
 375         -- on the binder.  This is important because we must get the right name
 376         -- which includes its nameParent.
 377
 378         ; thing <- forkM doc $ do { bumpDeclStats main_name
 379                                   ; tcIfaceDecl ignore_prags decl }
 380
 381         -- Populate the type environment with the implicitTyThings too.
 382         --
 383         -- Note [Tricky iface loop]
 384         -- ~~~~~~~~~~~~~~~~~~~~~~~~
 385         -- Summary: The delicate point here is that 'mini-env' must be
 386         -- buildable from 'thing' without demanding any of the things
 387         -- 'forkM'd by tcIfaceDecl.
 388         --
 389         -- In more detail: Consider the example
 390         --      data T a = MkT { x :: T a }
 391         -- The implicitTyThings of T are:  [ <datacon MkT>, <selector x>]
 392         -- (plus their workers, wrappers, coercions etc etc)
 393         --
 394         -- We want to return an environment
 395         --      [ "MkT" -> <datacon MkT>, "x" -> <selector x>, ... ]
 396         -- (where the "MkT" is the *Name* associated with MkT, etc.)
 397         --
 398         -- We do this by mapping the implict_names to the associated
 399         -- TyThings.  By the invariant on ifaceDeclSubBndrs and
 400         -- implicitTyThings, we can use getOccName on the implicit
 401         -- TyThings to make this association: each Name's OccName should
 402         -- be the OccName of exactly one implictTyThing.  So the key is
 403         -- to define a "mini-env"
 404         --
 405         -- [ 'MkT' -> <datacon MkT>, 'x' -> <selector x>, ... ]
 406         -- where the 'MkT' here is the *OccName* associated with MkT.
 407         --
 408         -- However, there is a subtlety: due to how type checking needs
 409         -- to be staged, we can't poke on the forkM'd thunks inside the
 410         -- implictTyThings while building this mini-env.
 411         -- If we poke these thunks too early, two problems could happen:
 412         --    (1) When processing mutually recursive modules across
 413         --        hs-boot boundaries, poking too early will do the
 414         --        type-checking before the recursive knot has been tied,
 415         --        so things will be type-checked in the wrong
 416         --        environment, and necessary variables won't be in
 417         --        scope.
 418         --
 419         --    (2) Looking up one OccName in the mini_env will cause
 420         --        others to be looked up, which might cause that
 421         --        original one to be looked up again, and hence loop.
 422         --
 423         -- The code below works because of the following invariant:
 424         -- getOccName on a TyThing does not force the suspended type
 425         -- checks in order to extract the name. For example, we don't
 426         -- poke on the "T a" type of <selector x> on the way to
 427         -- extracting <selector x>'s OccName. Of course, there is no
 428         -- reason in principle why getting the OccName should force the
 429         -- thunks, but this means we need to be careful in
 430         -- implicitTyThings and its helper functions.
 431         --
 432         -- All a bit too finely-balanced for my liking.
 433
 434         -- This mini-env and lookup function mediates between the
 435         --'Name's n and the map from 'OccName's to the implicit TyThings
 436         ; let mini_env = mkOccEnv [(getOccName t, t) | t <- implicitTyThings thing]
 437               lookup n = case lookupOccEnv mini_env (getOccName n) of
 438                            Just thing -> thing
 439                            Nothing    ->
 440                              pprPanic "loadDecl" (ppr main_name <+> ppr n $$ ppr (decl))
 441
 442         ; return $ (main_name, thing) :
 443                       -- uses the invariant that implicit_names and
 444                       -- implictTyThings are bijective
 445                       [(n, lookup n) | n <- implicit_names]
 446         }
 447   where
 448     doc = ptext (sLit "Declaration for") <+> ppr (ifName decl)
 449
 450 bumpDeclStats :: Name -> IfL ()         -- Record that one more declaration has actually been used
 451 bumpDeclStats name
 452   = do  { traceIf (text "Loading decl for" <+> ppr name)
 453         ; updateEps_ (\eps -> let stats = eps_stats eps
 454                               in eps { eps_stats = stats { n_decls_out = n_decls_out stats + 1 } })
 455         }
 456 \end{code}
 457
 458
 459 %*********************************************************
 460 %*                                                      *
 461 \subsection{Reading an interface file}
 462 %*                                                      *
 463 %*********************************************************
 464
 465 \begin{code}
 466 findAndReadIface :: SDoc -> Module
 467                  -> IsBootInterface     -- True  <=> Look for a .hi-boot file
 468                                         -- False <=> Look for .hi file
 469                  -> TcRnIf gbl lcl (MaybeErr Message (ModIface, FilePath))
 470         -- Nothing <=> file not found, or unreadable, or illegible
 471         -- Just x  <=> successfully found and parsed
 472
 473         -- It *doesn't* add an error to the monad, because
 474         -- sometimes it's ok to fail... see notes with loadInterface
 475
 476 findAndReadIface doc_str mod hi_boot_file
 477   = do  { traceIf (sep [hsep [ptext (sLit "Reading"),
 478                               if hi_boot_file
 479                                 then ptext (sLit "[boot]")
 480                                 else empty,
 481                               ptext (sLit "interface for"),
 482                               ppr mod <> semi],
 483                         nest 4 (ptext (sLit "reason:") <+> doc_str)])
 484
 485         -- Check for GHC.Prim, and return its static interface
 486         ; dflags <- getDOpts
 487         ; if mod == gHC_PRIM
 488           then return (Succeeded (ghcPrimIface,
 489                                    "<built in interface for GHC.Prim>"))
 490           else do
 491
 492         -- Look for the file
 493         ; hsc_env <- getTopEnv
 494         ; mb_found <- liftIO (findExactModule hsc_env mod)
 495         ; case mb_found of {
 496
 497               Found loc mod -> do
 498
 499         -- Found file, so read it
 500         { let { file_path = addBootSuffix_maybe hi_boot_file (ml_hi_file loc) }
 501
 502         -- If the interface is in the current package then if we could
 503         -- load it would already be in the HPT and we assume that our
 504         -- callers checked that.
 505         ; if thisPackage dflags == modulePackageId mod
 506                 && not (isOneShot (ghcMode dflags))
 507             then return (Failed (homeModError mod loc))
 508             else do {
 509
 510         ; traceIf (ptext (sLit "readIFace") <+> text file_path)
 511         ; read_result <- readIface mod file_path hi_boot_file
 512         ; case read_result of
 513             Failed err -> return (Failed (badIfaceFile file_path err))
 514             Succeeded iface
 515                 | mi_module iface /= mod ->
 516                   return (Failed (wrongIfaceModErr iface mod file_path))
 517                 | otherwise ->
 518                   return (Succeeded (iface, file_path))
 519                         -- Don't forget to fill in the package name...
 520         }}
 521             ; err -> do
 522                 { traceIf (ptext (sLit "...not found"))
 523                 ; dflags <- getDOpts
 524                 ; return (Failed (cannotFindInterface dflags
 525                                         (moduleName mod) err)) }
 526         }
 527         }
 528 \end{code}
 529
 530 @readIface@ tries just the one file.
 531
 532 \begin{code}
 533 readIface :: Module -> FilePath -> IsBootInterface
 534           -> TcRnIf gbl lcl (MaybeErr Message ModIface)
 535         -- Failed err    <=> file not found, or unreadable, or illegible
 536         -- Succeeded iface <=> successfully found and parsed
 537
 538 readIface wanted_mod file_path _
 539   = do  { res <- tryMostM $
 540                  readBinIface CheckHiWay QuietBinIFaceReading file_path
 541         ; case res of
 542             Right iface
 543                 | wanted_mod == actual_mod -> return (Succeeded iface)
 544                 | otherwise                -> return (Failed err)
 545                 where
 546                   actual_mod = mi_module iface
 547                   err = hiModuleNameMismatchWarn wanted_mod actual_mod
 548
 549             Left exn    -> return (Failed (text (showException exn)))
 550     }
 551 \end{code}
 552
 553
 554 %*********************************************************
 555 %*                                                       *
 556         Wired-in interface for GHC.Prim
 557 %*                                                       *
 558 %*********************************************************
 559
 560 \begin{code}
 561 initExternalPackageState :: ExternalPackageState
 562 initExternalPackageState
 563   = EPS {
 564       eps_is_boot      = emptyUFM,
 565       eps_PIT          = emptyPackageIfaceTable,
 566       eps_PTE          = emptyTypeEnv,
 567       eps_inst_env     = emptyInstEnv,
 568       eps_fam_inst_env = emptyFamInstEnv,
 569       eps_rule_base    = mkRuleBase builtinRules,
 570         -- Initialise the EPS rule pool with the built-in rules
 571       eps_mod_fam_inst_env
 572                        = emptyModuleEnv,
 573       eps_vect_info    = noVectInfo,
 574       eps_ann_env      = emptyAnnEnv,
 575       eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0
 576                            , n_insts_in = 0, n_insts_out = 0
 577                            , n_rules_in = length builtinRules, n_rules_out = 0 }
 578     }
 579 \end{code}
 580
 581
 582 %*********************************************************
 583 %*                                                       *
 584         Wired-in interface for GHC.Prim
 585 %*                                                       *
 586 %*********************************************************
 587
 588 \begin{code}
 589 ghcPrimIface :: ModIface
 590 ghcPrimIface
 591   = (emptyModIface gHC_PRIM) {
 592         mi_exports  = [(gHC_PRIM, ghcPrimExports)],
 593         mi_decls    = [],
 594         mi_fixities = fixities,
 595         mi_fix_fn  = mkIfaceFixCache fixities
 596     }
 597   where
 598     fixities = [(getOccName seqId, Fixity 0 InfixR)]
 599                         -- seq is infixr 0
 600 \end{code}
 601
 602 %*********************************************************
 603 %*                                                      *
 604 \subsection{Statistics}
 605 %*                                                      *
 606 %*********************************************************
 607
 608 \begin{code}
 609 ifaceStats :: ExternalPackageState -> SDoc
 610 ifaceStats eps
 611   = hcat [text "Renamer stats: ", msg]
 612   where
 613     stats = eps_stats eps
 614     msg = vcat
 615         [int (n_ifaces_in stats) <+> text "interfaces read",
 616          hsep [ int (n_decls_out stats), text "type/class/variable imported, out of",
 617                 int (n_decls_in stats), text "read"],
 618          hsep [ int (n_insts_out stats), text "instance decls imported, out of",
 619                 int (n_insts_in stats), text "read"],
 620          hsep [ int (n_rules_out stats), text "rule decls imported, out of",
 621                 int (n_rules_in stats), text "read"]
 622         ]
 623 \end{code}
 624
 625
 626 %************************************************************************
 627 %*                                                                      *
 628                 Printing interfaces
 629 %*                                                                      *
 630 %************************************************************************
 631
 632 \begin{code}
 633 -- | Read binary interface, and print it out
 634 showIface :: HscEnv -> FilePath -> IO ()
 635 showIface hsc_env filename = do
 636    -- skip the hi way check; we don't want to worry about profiled vs.
 637    -- non-profiled interfaces, for example.
 638    iface <- initTcRnIf 's' hsc_env () () $
 639        readBinIface IgnoreHiWay TraceBinIFaceReading filename
 640    printDump (pprModIface iface)
 641 \end{code}
 642
 643 \begin{code}
 644 pprModIface :: ModIface -> SDoc
 645 -- Show a ModIface
 646 pprModIface iface
 647  = vcat [ ptext (sLit "interface")
 648                 <+> ppr (mi_module iface) <+> pp_boot
 649                 <+> (if mi_orphan iface then ptext (sLit "[orphan module]") else empty)
 650                 <+> (if mi_finsts iface then ptext (sLit "[family instance module]") else empty)
 651                 <+> (if mi_hpc    iface then ptext (sLit "[hpc]") else empty)
 652                 <+> integer opt_HiVersion
 653         , nest 2 (text "interface hash:" <+> ppr (mi_iface_hash iface))
 654         , nest 2 (text "ABI hash:" <+> ppr (mi_mod_hash iface))
 655         , nest 2 (text "export-list hash:" <+> ppr (mi_exp_hash iface))
 656         , nest 2 (text "orphan hash:" <+> ppr (mi_orphan_hash iface))
 657         , nest 2 (ptext (sLit "where"))
 658         , vcat (map pprExport (mi_exports iface))
 659         , pprDeps (mi_deps iface)
 660         , vcat (map pprUsage (mi_usages iface))
 661         , vcat (map pprIfaceAnnotation (mi_anns iface))
 662         , pprFixities (mi_fixities iface)
 663         , vcat (map pprIfaceDecl (mi_decls iface))
 664         , vcat (map ppr (mi_insts iface))
 665         , vcat (map ppr (mi_fam_insts iface))
 666         , vcat (map ppr (mi_rules iface))
 667         , pprVectInfo (mi_vect_info iface)
 668         , ppr (mi_warns iface)
 669         ]
 670   where
 671     pp_boot | mi_boot iface = ptext (sLit "[boot]")
 672             | otherwise     = empty
 673 \end{code}
 674
 675 When printing export lists, we print like this:
 676         Avail   f               f
 677         AvailTC C [C, x, y]     C(x,y)
 678         AvailTC C [x, y]        C!(x,y)         -- Exporting x, y but not C
 679
 680 \begin{code}
 681 pprExport :: IfaceExport -> SDoc
 682 pprExport (mod, items)
 683  = hsep [ ptext (sLit "export"), ppr mod, hsep (map pp_avail items) ]
 684   where
 685     pp_avail :: GenAvailInfo OccName -> SDoc
 686     pp_avail (Avail occ)    = ppr occ
 687     pp_avail (AvailTC _ []) = empty
 688     pp_avail (AvailTC n (n':ns))
 689         | n==n'     = ppr n <> pp_export ns
 690         | otherwise = ppr n <> char '|' <> pp_export (n':ns)
 691
 692     pp_export []    = empty
 693     pp_export names = braces (hsep (map ppr names))
 694
 695 pprUsage :: Usage -> SDoc
 696 pprUsage usage@UsagePackageModule{}
 697   = hsep [ptext (sLit "import"), ppr (usg_mod usage),
 698           ppr (usg_mod_hash usage)]
 699 pprUsage usage@UsageHomeModule{}
 700   = hsep [ptext (sLit "import"), ppr (usg_mod_name usage),
 701           ppr (usg_mod_hash usage)] $$
 702     nest 2 (
 703         maybe empty (\v -> text "exports: " <> ppr v) (usg_exports usage) $$
 704         vcat [ ppr n <+> ppr v | (n,v) <- usg_entities usage ]
 705         )
 706
 707 pprDeps :: Dependencies -> SDoc
 708 pprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs,
 709                 dep_finsts = finsts })
 710   = vcat [ptext (sLit "module dependencies:") <+> fsep (map ppr_mod mods),
 711           ptext (sLit "package dependencies:") <+> fsep (map ppr pkgs),
 712           ptext (sLit "orphans:") <+> fsep (map ppr orphs),
 713           ptext (sLit "family instance modules:") <+> fsep (map ppr finsts)
 714         ]
 715   where
 716     ppr_mod (mod_name, boot) = ppr mod_name <+> ppr_boot boot
 717     ppr_boot True  = text "[boot]"
 718     ppr_boot False = empty
 719
 720 pprIfaceDecl :: (Fingerprint, IfaceDecl) -> SDoc
 721 pprIfaceDecl (ver, decl)
 722   = ppr ver $$ nest 2 (ppr decl)
 723
 724 pprFixities :: [(OccName, Fixity)] -> SDoc
 725 pprFixities []    = empty
 726 pprFixities fixes = ptext (sLit "fixities") <+> pprWithCommas pprFix fixes
 727                   where
 728                     pprFix (occ,fix) = ppr fix <+> ppr occ
 729
 730 pprVectInfo :: IfaceVectInfo -> SDoc
 731 pprVectInfo (IfaceVectInfo { ifaceVectInfoVar        = vars
 732                            , ifaceVectInfoTyCon      = tycons
 733                            , ifaceVectInfoTyConReuse = tyconsReuse
 734                            }) =
 735   vcat
 736   [ ptext (sLit "vectorised variables:") <+> hsep (map ppr vars)
 737   , ptext (sLit "vectorised tycons:") <+> hsep (map ppr tycons)
 738   , ptext (sLit "vectorised reused tycons:") <+> hsep (map ppr tyconsReuse)
 739   ]
 740
 741 instance Outputable Warnings where
 742     ppr = pprWarns
 743
 744 pprWarns :: Warnings -> SDoc
 745 pprWarns NoWarnings         = empty
 746 pprWarns (WarnAll txt)  = ptext (sLit "Warn all") <+> ppr txt
 747 pprWarns (WarnSome prs) = ptext (sLit "Warnings")
 748                         <+> vcat (map pprWarning prs)
 749     where pprWarning (name, txt) = ppr name <+> ppr txt
 750
 751 pprIfaceAnnotation :: IfaceAnnotation -> SDoc
 752 pprIfaceAnnotation (IfaceAnnotation { ifAnnotatedTarget = target, ifAnnotatedValue = serialized })
 753   = ppr target <+> ptext (sLit "annotated by") <+> ppr serialized
 754 \end{code}
 755
 756
 757 %*********************************************************
 758 %*                                                       *
 759 \subsection{Errors}
 760 %*                                                       *
 761 %*********************************************************
 762
 763 \begin{code}
 764 badIfaceFile :: String -> SDoc -> SDoc
 765 badIfaceFile file err
 766   = vcat [ptext (sLit "Bad interface file:") <+> text file,
 767           nest 4 err]
 768
 769 hiModuleNameMismatchWarn :: Module -> Module -> Message
 770 hiModuleNameMismatchWarn requested_mod read_mod =
 771   withPprStyle defaultUserStyle $
 772     -- we want the Modules below to be qualified with package names,
 773     -- so reset the PrintUnqualified setting.
 774     hsep [ ptext (sLit "Something is amiss; requested module ")
 775          , ppr requested_mod
 776          , ptext (sLit "differs from name found in the interface file")
 777          , ppr read_mod
 778          ]
 779
 780 wrongIfaceModErr :: ModIface -> Module -> String -> SDoc
 781 wrongIfaceModErr iface mod_name file_path
 782   = sep [ptext (sLit "Interface file") <+> iface_file,
 783          ptext (sLit "contains module") <+> quotes (ppr (mi_module iface)) <> comma,
 784          ptext (sLit "but we were expecting module") <+> quotes (ppr mod_name),
 785          sep [ptext (sLit "Probable cause: the source code which generated"),
 786              nest 2 iface_file,
 787              ptext (sLit "has an incompatible module name")
 788             ]
 789         ]
 790   where iface_file = doubleQuotes (text file_path)
 791
 792 homeModError :: Module -> ModLocation -> SDoc
 793 homeModError mod location
 794   = ptext (sLit "attempting to use module ") <> quotes (ppr mod)
 795     <> (case ml_hs_file location of
 796            Just file -> space <> parens (text file)
 797            Nothing   -> empty)
 798     <+> ptext (sLit "which is not loaded")
 799 \end{code}
 800