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 {-# OPTIONS -w #-}
  10 -- The above warning supression flag is a temporary kludge.
  11 -- While working on this module you are encouraged to remove it and fix
  12 -- any warnings in the module. See
  13 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
  14 -- for details
  15
  16 module LoadIface (
  17         loadInterface, loadInterfaceForName, loadWiredInHomeIface,
  18         loadSrcInterface, loadSysInterface, loadOrphanModules,
  19         findAndReadIface, readIface,    -- Used when reading the module's old interface
  20         loadDecls,      -- Should move to TcIface and be renamed
  21         initExternalPackageState,
  22
  23         ifaceStats, pprModIface, showIface
  24    ) where
  25
  26 #include "HsVersions.h"
  27
  28 import {-# SOURCE #-}   TcIface( tcIfaceDecl, tcIfaceRules, tcIfaceInst,
  29                                  tcIfaceFamInst, tcIfaceVectInfo )
  30
  31 import DynFlags
  32 import IfaceSyn
  33 import IfaceEnv
  34 import HscTypes
  35
  36 import BasicTypes hiding (SuccessFlag(..))
  37 import TcRnMonad
  38 import Type
  39
  40 import PrelNames
  41 import PrelInfo
  42 import PrelRules
  43 import Rules
  44 import InstEnv
  45 import FamInstEnv
  46 import Name
  47 import NameEnv
  48 import MkId
  49 import Module
  50 import OccName
  51 import SrcLoc
  52 import Maybes
  53 import ErrUtils
  54 import Finder
  55 import LazyUniqFM
  56 import StaticFlags
  57 import Outputable
  58 import BinIface
  59 import Panic
  60 import Util
  61
  62 import Control.Monad
  63 import Data.List
  64 import Data.Maybe
  65 import Data.IORef
  66 \end{code}
  67
  68
  69 %************************************************************************
  70 %*                                                                      *
  71         loadSrcInterface, loadOrphanModules, loadHomeInterface
  72
  73                 These three are called from TcM-land
  74 %*                                                                      *
  75 %************************************************************************
  76
  77 \begin{code}
  78 -- | Load the interface corresponding to an @import@ directive in
  79 -- source code.  On a failure, fail in the monad with an error message.
  80 loadSrcInterface :: SDoc -> ModuleName -> IsBootInterface -> RnM ModIface
  81 loadSrcInterface doc mod want_boot  = do
  82   -- We must first find which Module this import refers to.  This involves
  83   -- calling the Finder, which as a side effect will search the filesystem
  84   -- and create a ModLocation.  If successful, loadIface will read the
  85   -- interface; it will call the Finder again, but the ModLocation will be
  86   -- cached from the first search.
  87   hsc_env <- getTopEnv
  88   res <- liftIO $ findImportedModule hsc_env mod Nothing
  89   case res of
  90     Found _ mod -> do
  91       mb_iface <- initIfaceTcRn $ loadInterface doc mod (ImportByUser want_boot)
  92       case mb_iface of
  93         Failed err      -> failWithTc err
  94         Succeeded iface -> return iface
  95     err ->
  96         let dflags = hsc_dflags hsc_env in
  97         failWithTc (cannotFindInterface dflags mod err)
  98
  99 -- | Load interfaces for a collection of orphan modules.
 100 loadOrphanModules :: [Module]         -- the modules
 101                   -> Bool             -- these are family instance-modules
 102                   -> TcM ()
 103 loadOrphanModules mods isFamInstMod
 104   | null mods = return ()
 105   | otherwise = initIfaceTcRn $
 106                 do { traceIf (text "Loading orphan modules:" <+>
 107                                  fsep (map ppr mods))
 108                    ; mapM_ load mods
 109                    ; return () }
 110   where
 111     load mod   = loadSysInterface (mk_doc mod) mod
 112     mk_doc mod
 113       | isFamInstMod = ppr mod <+> ptext SLIT("is a family-instance module")
 114       | otherwise    = ppr mod <+> ptext SLIT("is a orphan-instance module")
 115
 116 -- | Loads the interface for a given Name.
 117 loadInterfaceForName :: SDoc -> Name -> TcRn ModIface
 118 loadInterfaceForName doc name
 119   = do {
 120     when debugIsOn $ do
 121         -- Should not be called with a name from the module being compiled
 122         { this_mod <- getModule
 123         ; MASSERT2( not (nameIsLocalOrFrom this_mod name), ppr name <+> parens doc )
 124         }
 125   ; initIfaceTcRn $ loadSysInterface doc (nameModule name)
 126   }
 127
 128 -- | An 'IfM' function to load the home interface for a wired-in thing,
 129 -- so that we're sure that we see its instance declarations and rules
 130 -- See Note [Loading instances]
 131 loadWiredInHomeIface :: Name -> IfM lcl ()
 132 loadWiredInHomeIface name
 133   = ASSERT( isWiredInName name )
 134     do loadSysInterface doc (nameModule name); return ()
 135   where
 136     doc = ptext SLIT("Need home interface for wired-in thing") <+> ppr name
 137
 138 -- | A wrapper for 'loadInterface' that throws an exception if it fails
 139 loadSysInterface :: SDoc -> Module -> IfM lcl ModIface
 140 loadSysInterface doc mod_name
 141   = do  { mb_iface <- loadInterface doc mod_name ImportBySystem
 142         ; case mb_iface of
 143             Failed err      -> ghcError (ProgramError (showSDoc err))
 144             Succeeded iface -> return iface }
 145 \end{code}
 146
 147 Note [Loading instances]
 148 ~~~~~~~~~~~~~~~~~~~~~~~~
 149 We need to make sure that we have at least *read* the interface files
 150 for any module with an instance decl or RULE that we might want.
 151
 152 * If the instance decl is an orphan, we have a whole separate mechanism
 153   (loadOprhanModules)
 154
 155 * If the instance decl not an orphan, then the act of looking at the
 156   TyCon or Class will force in the defining module for the
 157   TyCon/Class, and hence the instance decl
 158
 159 * BUT, if the TyCon is a wired-in TyCon, we don't really need its interface;
 160   but we must make sure we read its interface in case it has instances or
 161   rules.  That is what LoadIface.loadWiredInHomeInterface does.  It's called
 162   from TcIface.{tcImportDecl, checkWiredInTyCon, ifCHeckWiredInThing}
 163
 164 All of this is done by the type checker. The renamer plays no role.
 165 (It used to, but no longer.)
 166
 167
 168
 169 %*********************************************************
 170 %*                                                      *
 171                 loadInterface
 172
 173         The main function to load an interface
 174         for an imported module, and put it in
 175         the External Package State
 176 %*                                                      *
 177 %*********************************************************
 178
 179 \begin{code}
 180 loadInterface :: SDoc -> Module -> WhereFrom
 181               -> IfM lcl (MaybeErr Message ModIface)
 182
 183 -- loadInterface looks in both the HPT and PIT for the required interface
 184 -- If not found, it loads it, and puts it in the PIT (always).
 185
 186 -- If it can't find a suitable interface file, we
 187 --      a) modify the PackageIfaceTable to have an empty entry
 188 --              (to avoid repeated complaints)
 189 --      b) return (Left message)
 190 --
 191 -- It's not necessarily an error for there not to be an interface
 192 -- file -- perhaps the module has changed, and that interface
 193 -- is no longer used
 194
 195 loadInterface doc_str mod from
 196   = do  {       -- Read the state
 197           (eps,hpt) <- getEpsAndHpt
 198
 199         ; traceIf (text "Considering whether to load" <+> ppr mod <+> ppr from)
 200
 201                 -- Check whether we have the interface already
 202         ; dflags <- getDOpts
 203         ; case lookupIfaceByModule dflags hpt (eps_PIT eps) mod of {
 204             Just iface
 205                 -> return (Succeeded iface) ;   -- Already loaded
 206                         -- The (src_imp == mi_boot iface) test checks that the already-loaded
 207                         -- interface isn't a boot iface.  This can conceivably happen,
 208                         -- if an earlier import had a before we got to real imports.   I think.
 209             other -> do {
 210
 211           let { hi_boot_file = case from of
 212                                 ImportByUser usr_boot -> usr_boot
 213                                 ImportBySystem        -> sys_boot
 214
 215               ; mb_dep   = lookupUFM (eps_is_boot eps) (moduleName mod)
 216               ; sys_boot = case mb_dep of
 217                                 Just (_, is_boot) -> is_boot
 218                                 Nothing           -> False
 219                         -- The boot-ness of the requested interface,
 220               }         -- based on the dependencies in directly-imported modules
 221
 222         -- READ THE MODULE IN
 223         ; read_result <- findAndReadIface doc_str mod hi_boot_file
 224         ; case read_result of {
 225             Failed err -> do
 226                 { let fake_iface = emptyModIface mod
 227
 228                 ; updateEps_ $ \eps ->
 229                         eps { eps_PIT = extendModuleEnv (eps_PIT eps) (mi_module fake_iface) fake_iface }
 230                         -- Not found, so add an empty iface to
 231                         -- the EPS map so that we don't look again
 232
 233                 ; return (Failed err) } ;
 234
 235         -- Found and parsed!
 236             Succeeded (iface, file_path)        -- Sanity check:
 237                 | ImportBySystem <- from,       --   system-importing...
 238                   modulePackageId (mi_module iface) == thisPackage dflags,
 239                                                 --   a home-package module...
 240                   Nothing <- mb_dep             --   that we know nothing about
 241                 -> return (Failed (badDepMsg mod))
 242
 243                 | otherwise ->
 244
 245         let
 246             loc_doc = text file_path
 247         in
 248         initIfaceLcl mod loc_doc $ do
 249
 250         --      Load the new ModIface into the External Package State
 251         -- Even home-package interfaces loaded by loadInterface
 252         --      (which only happens in OneShot mode; in Batch/Interactive
 253         --      mode, home-package modules are loaded one by one into the HPT)
 254         -- are put in the EPS.
 255         --
 256         -- The main thing is to add the ModIface to the PIT, but
 257         -- we also take the
 258         --      IfaceDecls, IfaceInst, IfaceFamInst, IfaceRules, IfaceVectInfo
 259         -- out of the ModIface and put them into the big EPS pools
 260
 261         -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
 262         ---    names is done correctly (notably, whether this is an .hi file or .hi-boot file).
 263         --     If we do loadExport first the wrong info gets into the cache (unless we
 264         --      explicitly tag each export which seems a bit of a bore)
 265
 266         ; ignore_prags      <- doptM Opt_IgnoreInterfacePragmas
 267         ; new_eps_decls     <- loadDecls ignore_prags (mi_decls iface)
 268         ; new_eps_insts     <- mapM tcIfaceInst (mi_insts iface)
 269         ; new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
 270         ; new_eps_rules     <- tcIfaceRules ignore_prags (mi_rules iface)
 271         ; new_eps_vect_info <- tcIfaceVectInfo mod (mkNameEnv new_eps_decls)
 272                                                (mi_vect_info iface)
 273
 274         ; let { final_iface = iface {
 275                                 mi_decls     = panic "No mi_decls in PIT",
 276                                 mi_insts     = panic "No mi_insts in PIT",
 277                                 mi_fam_insts = panic "No mi_fam_insts in PIT",
 278                                 mi_rules     = panic "No mi_rules in PIT"
 279                               }
 280                }
 281
 282         ; updateEps_  $ \ eps ->
 283             eps {
 284               eps_PIT          = extendModuleEnv (eps_PIT eps) mod final_iface,
 285               eps_PTE          = addDeclsToPTE   (eps_PTE eps) new_eps_decls,
 286               eps_rule_base    = extendRuleBaseList (eps_rule_base eps)
 287                                                     new_eps_rules,
 288               eps_inst_env     = extendInstEnvList (eps_inst_env eps)
 289                                                    new_eps_insts,
 290               eps_fam_inst_env = extendFamInstEnvList (eps_fam_inst_env eps)
 291                                                       new_eps_fam_insts,
 292               eps_vect_info    = plusVectInfo (eps_vect_info eps)
 293                                               new_eps_vect_info,
 294               eps_mod_fam_inst_env
 295                                = let
 296                                    fam_inst_env =
 297                                      extendFamInstEnvList emptyFamInstEnv
 298                                                           new_eps_fam_insts
 299                                  in
 300                                  extendModuleEnv (eps_mod_fam_inst_env eps)
 301                                                  mod
 302                                                  fam_inst_env,
 303               eps_stats        = addEpsInStats (eps_stats eps)
 304                                                (length new_eps_decls)
 305                                                (length new_eps_insts)
 306                                                (length new_eps_rules) }
 307
 308         ; return (Succeeded final_iface)
 309     }}}}
 310
 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           -> [(Version, 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           -> (Version, 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               err | notFound err -> do
 480                 { traceIf (ptext SLIT("...not found"))
 481                 ; dflags <- getDOpts
 482                 ; return (Failed (cannotFindInterface dflags
 483                                         (moduleName mod) err)) } ;
 484               Found loc mod -> do
 485
 486         -- Found file, so read it
 487         { let { file_path = addBootSuffix_maybe hi_boot_file (ml_hi_file loc) }
 488
 489         ; if thisPackage dflags == modulePackageId mod
 490                 && not (isOneShot (ghcMode dflags))
 491             then return (Failed (homeModError mod loc))
 492             else do {
 493
 494         ; traceIf (ptext SLIT("readIFace") <+> text file_path)
 495         ; read_result <- readIface mod file_path hi_boot_file
 496         ; case read_result of
 497             Failed err -> return (Failed (badIfaceFile file_path err))
 498             Succeeded iface
 499                 | mi_module iface /= mod ->
 500                   return (Failed (wrongIfaceModErr iface mod file_path))
 501                 | otherwise ->
 502                   return (Succeeded (iface, file_path))
 503                         -- Don't forget to fill in the package name...
 504         }}}}
 505
 506 notFound (Found _ _) = False
 507 notFound _ = True
 508 \end{code}
 509
 510 @readIface@ tries just the one file.
 511
 512 \begin{code}
 513 readIface :: Module -> FilePath -> IsBootInterface
 514           -> TcRnIf gbl lcl (MaybeErr Message ModIface)
 515         -- Failed err    <=> file not found, or unreadable, or illegible
 516         -- Succeeded iface <=> successfully found and parsed
 517
 518 readIface wanted_mod file_path is_hi_boot_file
 519   = do  { dflags <- getDOpts
 520         ; res <- tryMostM $
 521                  readBinIface CheckHiWay QuietBinIFaceReading file_path
 522         ; case res of
 523             Right iface
 524                 | wanted_mod == actual_mod -> return (Succeeded iface)
 525                 | otherwise                -> return (Failed err)
 526                 where
 527                   actual_mod = mi_module iface
 528                   err = hiModuleNameMismatchWarn wanted_mod actual_mod
 529
 530             Left exn    -> return (Failed (text (showException exn)))
 531     }
 532 \end{code}
 533
 534
 535 %*********************************************************
 536 %*                                                       *
 537         Wired-in interface for GHC.Prim
 538 %*                                                       *
 539 %*********************************************************
 540
 541 \begin{code}
 542 initExternalPackageState :: ExternalPackageState
 543 initExternalPackageState
 544   = EPS {
 545       eps_is_boot      = emptyUFM,
 546       eps_PIT          = emptyPackageIfaceTable,
 547       eps_PTE          = emptyTypeEnv,
 548       eps_inst_env     = emptyInstEnv,
 549       eps_fam_inst_env = emptyFamInstEnv,
 550       eps_rule_base    = mkRuleBase builtinRules,
 551         -- Initialise the EPS rule pool with the built-in rules
 552       eps_mod_fam_inst_env
 553                        = emptyModuleEnv,
 554       eps_vect_info    = noVectInfo,
 555       eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0
 556                            , n_insts_in = 0, n_insts_out = 0
 557                            , n_rules_in = length builtinRules, n_rules_out = 0 }
 558     }
 559 \end{code}
 560
 561
 562 %*********************************************************
 563 %*                                                       *
 564         Wired-in interface for GHC.Prim
 565 %*                                                       *
 566 %*********************************************************
 567
 568 \begin{code}
 569 ghcPrimIface :: ModIface
 570 ghcPrimIface
 571   = (emptyModIface gHC_PRIM) {
 572         mi_exports  = [(gHC_PRIM, ghcPrimExports)],
 573         mi_decls    = [],
 574         mi_fixities = fixities,
 575         mi_fix_fn  = mkIfaceFixCache fixities
 576     }
 577   where
 578     fixities = [(getOccName seqId, Fixity 0 InfixR)]
 579                         -- seq is infixr 0
 580 \end{code}
 581
 582 %*********************************************************
 583 %*                                                      *
 584 \subsection{Statistics}
 585 %*                                                      *
 586 %*********************************************************
 587
 588 \begin{code}
 589 ifaceStats :: ExternalPackageState -> SDoc
 590 ifaceStats eps
 591   = hcat [text "Renamer stats: ", msg]
 592   where
 593     stats = eps_stats eps
 594     msg = vcat
 595         [int (n_ifaces_in stats) <+> text "interfaces read",
 596          hsep [ int (n_decls_out stats), text "type/class/variable imported, out of",
 597                 int (n_decls_in stats), text "read"],
 598          hsep [ int (n_insts_out stats), text "instance decls imported, out of",
 599                 int (n_insts_in stats), text "read"],
 600          hsep [ int (n_rules_out stats), text "rule decls imported, out of",
 601                 int (n_rules_in stats), text "read"]
 602         ]
 603 \end{code}
 604
 605
 606 %************************************************************************
 607 %*                                                                      *
 608                 Printing interfaces
 609 %*                                                                      *
 610 %************************************************************************
 611
 612 \begin{code}
 613 -- | Read binary interface, and print it out
 614 showIface :: HscEnv -> FilePath -> IO ()
 615 showIface hsc_env filename = do
 616    -- skip the hi way check; we don't want to worry about profiled vs.
 617    -- non-profiled interfaces, for example.
 618    iface <- initTcRnIf 's' hsc_env () () $
 619        readBinIface IgnoreHiWay TraceBinIFaceReading filename
 620    printDump (pprModIface iface)
 621 \end{code}
 622
 623 \begin{code}
 624 pprModIface :: ModIface -> SDoc
 625 -- Show a ModIface
 626 pprModIface iface
 627  = vcat [ ptext SLIT("interface")
 628                 <+> ppr (mi_module iface) <+> pp_boot
 629                 <+> ppr (mi_mod_vers iface) <+> pp_sub_vers
 630                 <+> (if mi_orphan iface then ptext SLIT("[orphan module]") else empty)
 631                 <+> (if mi_finsts iface then ptext SLIT("[family instance module]") else empty)
 632                 <+> (if mi_hpc    iface then ptext SLIT("[hpc]") else empty)
 633                 <+> integer opt_HiVersion
 634                 <+> ptext SLIT("where")
 635         , vcat (map pprExport (mi_exports iface))
 636         , pprDeps (mi_deps iface)
 637         , vcat (map pprUsage (mi_usages iface))
 638         , pprFixities (mi_fixities iface)
 639         , vcat (map pprIfaceDecl (mi_decls iface))
 640         , vcat (map ppr (mi_insts iface))
 641         , vcat (map ppr (mi_fam_insts iface))
 642         , vcat (map ppr (mi_rules iface))
 643         , pprVectInfo (mi_vect_info iface)
 644         , pprDeprecs (mi_deprecs iface)
 645         ]
 646   where
 647     pp_boot | mi_boot iface = ptext SLIT("[boot]")
 648             | otherwise     = empty
 649
 650     exp_vers  = mi_exp_vers iface
 651     rule_vers = mi_rule_vers iface
 652
 653     pp_sub_vers | exp_vers == initialVersion && rule_vers == initialVersion = empty
 654                 | otherwise = brackets (ppr exp_vers <+> ppr rule_vers)
 655 \end{code}
 656
 657 When printing export lists, we print like this:
 658         Avail   f               f
 659         AvailTC C [C, x, y]     C(x,y)
 660         AvailTC C [x, y]        C!(x,y)         -- Exporting x, y but not C
 661
 662 \begin{code}
 663 pprExport :: IfaceExport -> SDoc
 664 pprExport (mod, items)
 665  = hsep [ ptext SLIT("export"), ppr mod, hsep (map pp_avail items) ]
 666   where
 667     pp_avail :: GenAvailInfo OccName -> SDoc
 668     pp_avail (Avail occ)    = ppr occ
 669     pp_avail (AvailTC _ []) = empty
 670     pp_avail (AvailTC n (n':ns))
 671         | n==n'     = ppr n <> pp_export ns
 672         | otherwise = ppr n <> char '|' <> pp_export (n':ns)
 673
 674     pp_export []    = empty
 675     pp_export names = braces (hsep (map ppr names))
 676
 677 pprUsage :: Usage -> SDoc
 678 pprUsage usage
 679   = hsep [ptext SLIT("import"), ppr (usg_name usage),
 680           int (usg_mod usage),
 681           pp_export_version (usg_exports usage),
 682           int (usg_rules usage),
 683           pp_versions (usg_entities usage) ]
 684   where
 685     pp_versions nvs = hsep [ ppr n <+> int v | (n,v) <- nvs ]
 686     pp_export_version Nothing  = empty
 687     pp_export_version (Just v) = int v
 688
 689 pprDeps :: Dependencies -> SDoc
 690 pprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs,
 691                 dep_finsts = finsts })
 692   = vcat [ptext SLIT("module dependencies:") <+> fsep (map ppr_mod mods),
 693           ptext SLIT("package dependencies:") <+> fsep (map ppr pkgs),
 694           ptext SLIT("orphans:") <+> fsep (map ppr orphs),
 695           ptext SLIT("family instance modules:") <+> fsep (map ppr finsts)
 696         ]
 697   where
 698     ppr_mod (mod_name, boot) = ppr mod_name <+> ppr_boot boot
 699     ppr_boot True  = text "[boot]"
 700     ppr_boot False = empty
 701
 702 pprIfaceDecl :: (Version, IfaceDecl) -> SDoc
 703 pprIfaceDecl (ver, decl)
 704   = ppr_vers ver <+> ppr decl
 705   where
 706         -- Print the version for the decl
 707     ppr_vers v | v == initialVersion = empty
 708                | otherwise           = int v
 709
 710 pprFixities :: [(OccName, Fixity)] -> SDoc
 711 pprFixities []    = empty
 712 pprFixities fixes = ptext SLIT("fixities") <+> pprWithCommas pprFix fixes
 713                   where
 714                     pprFix (occ,fix) = ppr fix <+> ppr occ
 715
 716 pprVectInfo :: IfaceVectInfo -> SDoc
 717 pprVectInfo (IfaceVectInfo { ifaceVectInfoVar        = vars
 718                            , ifaceVectInfoTyCon      = tycons
 719                            , ifaceVectInfoTyConReuse = tyconsReuse
 720                            }) =
 721   vcat
 722   [ ptext SLIT("vectorised variables:") <+> hsep (map ppr vars)
 723   , ptext SLIT("vectorised tycons:") <+> hsep (map ppr tycons)
 724   , ptext SLIT("vectorised reused tycons:") <+> hsep (map ppr tyconsReuse)
 725   ]
 726
 727 pprDeprecs NoDeprecs        = empty
 728 pprDeprecs (DeprecAll txt)  = ptext SLIT("Deprecate all") <+> doubleQuotes (ftext txt)
 729 pprDeprecs (DeprecSome prs) = ptext SLIT("Deprecate") <+> vcat (map pprDeprec prs)
 730                             where
 731                               pprDeprec (name, txt) = ppr name <+> doubleQuotes (ftext txt)
 732 \end{code}
 733
 734
 735 %*********************************************************
 736 %*                                                       *
 737 \subsection{Errors}
 738 %*                                                       *
 739 %*********************************************************
 740
 741 \begin{code}
 742 badIfaceFile file err
 743   = vcat [ptext SLIT("Bad interface file:") <+> text file,
 744           nest 4 err]
 745
 746 hiModuleNameMismatchWarn :: Module -> Module -> Message
 747 hiModuleNameMismatchWarn requested_mod read_mod =
 748   withPprStyle defaultUserStyle $
 749     -- we want the Modules below to be qualified with package names,
 750     -- so reset the PrintUnqualified setting.
 751     hsep [ ptext SLIT("Something is amiss; requested module ")
 752          , ppr requested_mod
 753          , ptext SLIT("differs from name found in the interface file")
 754          , ppr read_mod
 755          ]
 756
 757 wrongIfaceModErr iface mod_name file_path
 758   = sep [ptext SLIT("Interface file") <+> iface_file,
 759          ptext SLIT("contains module") <+> quotes (ppr (mi_module iface)) <> comma,
 760          ptext SLIT("but we were expecting module") <+> quotes (ppr mod_name),
 761          sep [ptext SLIT("Probable cause: the source code which generated"),
 762              nest 2 iface_file,
 763              ptext SLIT("has an incompatible module name")
 764             ]
 765         ]
 766   where iface_file = doubleQuotes (text file_path)
 767
 768 homeModError mod location
 769   = ptext SLIT("attempting to use module ") <> quotes (ppr mod)
 770     <> (case ml_hs_file location of
 771            Just file -> space <> parens (text file)
 772            Nothing   -> empty)
 773     <+> ptext SLIT("which is not loaded")
 774 \end{code}
 775