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