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