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