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