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