compiler/iface/LoadIface.lhs

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