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