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