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