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