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