compiler/iface/LoadIface.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   4 %
   5
   6 Loading interface files
   7
   8 \begin{code}
   9 module LoadIface (
  10         loadInterface, loadInterfaceForName, loadWiredInHomeIface,
  11         loadSrcInterface, loadSysInterface, loadUserInterface, loadOrphanModules,
  12         findAndReadIface, readIface,    -- Used when reading the module's old interface
  13         loadDecls,      -- Should move to TcIface and be renamed
  14         initExternalPackageState,
  15
  16         ifaceStats, pprModIface, showIface
  17    ) where
  18
  19 #include "HsVersions.h"
  20
  21 import {-# SOURCE #-}   TcIface( tcIfaceDecl, tcIfaceRules, tcIfaceInst,
  22                                  tcIfaceFamInst, tcIfaceVectInfo, tcIfaceAnnotations )
  23
  24 import DynFlags
  25 import IfaceSyn
  26 import IfaceEnv
  27 import HscTypes
  28
  29 import BasicTypes hiding (SuccessFlag(..))
  30 import TcRnMonad
  31
  32 import PrelNames
  33 import PrelInfo
  34 import PrelRules
  35 import Rules
  36 import Annotations
  37 import InstEnv
  38 import FamInstEnv
  39 import Name
  40 import NameEnv
  41 import Module
  42 import Maybes
  43 import ErrUtils
  44 import Finder
  45 import LazyUniqFM
  46 import StaticFlags
  47 import Outputable
  48 import BinIface
  49 import Panic
  50 import Util
  51 import FastString
  52 import Fingerprint
  53
  54 import Control.Monad
  55 \end{code}
  56
  57
  58 %************************************************************************
  59 %*                                                                      *
  60         loadSrcInterface, loadOrphanModules, loadHomeInterface
  61
  62                 These three are called from TcM-land
  63 %*                                                                      *
  64 %************************************************************************
  65
  66 \begin{code}
  67 -- | Load the interface corresponding to an @import@ directive in
  68 -- source code.  On a failure, fail in the monad with an error message.
  69 loadSrcInterface :: SDoc
  70                  -> ModuleName
  71                  -> IsBootInterface     -- {-# SOURCE #-} ?
  72                  -> Maybe FastString    -- "package", if any
  73                  -> RnM ModIface
  74
  75 loadSrcInterface doc mod want_boot maybe_pkg  = do
  76   -- We must first find which Module this import refers to.  This involves
  77   -- calling the Finder, which as a side effect will search the filesystem
  78   -- and create a ModLocation.  If successful, loadIface will read the
  79   -- interface; it will call the Finder again, but the ModLocation will be
  80   -- cached from the first search.
  81   hsc_env <- getTopEnv
  82   res <- liftIO $ findImportedModule hsc_env mod maybe_pkg
  83   case res of
  84     Found _ mod -> do
  85       mb_iface <- initIfaceTcRn $ loadInterface doc mod (ImportByUser want_boot)
  86       case mb_iface of
  87         Failed err      -> failWithTc err
  88         Succeeded iface -> return iface
  89     err ->
  90         let dflags = hsc_dflags hsc_env in
  91         failWithTc (cannotFindInterface dflags mod err)
  92
  93 -- | Load interfaces for a collection of orphan modules.
  94 loadOrphanModules :: [Module]         -- the modules
  95                   -> Bool             -- these are family instance-modules
  96                   -> TcM ()
  97 loadOrphanModules mods isFamInstMod
  98   | null mods = return ()
  99   | otherwise = initIfaceTcRn $
 100                 do { traceIf (text "Loading orphan modules:" <+>
 101                                  fsep (map ppr mods))
 102                    ; mapM_ load mods
 103                    ; return () }
 104   where
 105     load mod   = loadSysInterface (mk_doc mod) mod
 106     mk_doc mod
 107       | isFamInstMod = ppr mod <+> ptext (sLit "is a family-instance module")
 108       | otherwise    = ppr mod <+> ptext (sLit "is a orphan-instance module")
 109
 110 -- | Loads the interface for a given Name.
 111 loadInterfaceForName :: SDoc -> Name -> TcRn ModIface
 112 loadInterfaceForName doc name
 113   = do {
 114     when debugIsOn $ do
 115         -- Should not be called with a name from the module being compiled
 116         { this_mod <- getModule
 117         ; MASSERT2( not (nameIsLocalOrFrom this_mod name), ppr name <+> parens doc )
 118         }
 119   ; ASSERT2( isExternalName name, ppr name )
 120     initIfaceTcRn $ loadSysInterface doc (nameModule name)
 121   }
 122
 123 -- | An 'IfM' function to load the home interface for a wired-in thing,
 124 -- so that we're sure that we see its instance declarations and rules
 125 -- See Note [Loading instances for wired-in things] in TcIface
 126 loadWiredInHomeIface :: Name -> IfM lcl ()
 127 loadWiredInHomeIface name
 128   = ASSERT( isWiredInName name )
 129     do _ <- loadSysInterface doc (nameModule name); return ()
 130   where
 131     doc = ptext (sLit "Need home interface for wired-in thing") <+> ppr name
 132
 133 -- | Loads a system interface and throws an exception if it fails
 134 loadSysInterface :: SDoc -> Module -> IfM lcl ModIface
 135 loadSysInterface doc mod_name = loadInterfaceWithException doc mod_name ImportBySystem
 136
 137 -- | Loads a user interface and throws an exception if it fails. The first parameter indicates
 138 -- whether we should import the boot variant of the module
 139 loadUserInterface :: Bool -> SDoc -> Module -> IfM lcl ModIface
 140 loadUserInterface is_boot doc mod_name = loadInterfaceWithException doc mod_name (ImportByUser is_boot)
 141
 142 -- | A wrapper for 'loadInterface' that throws an exception if it fails
 143 loadInterfaceWithException :: SDoc -> Module -> WhereFrom -> IfM lcl ModIface
 144 loadInterfaceWithException doc mod_name where_from
 145   = do  { mb_iface <- loadInterface doc mod_name where_from
 146         ; case mb_iface of
 147             Failed err      -> ghcError (ProgramError (showSDoc err))
 148             Succeeded iface -> return iface }
 149 \end{code}
 150
 151
 152 %*********************************************************
 153 %*                                                      *
 154                 loadInterface
 155
 156         The main function to load an interface
 157         for an imported module, and put it in
 158         the External Package State
 159 %*                                                      *
 160 %*********************************************************
 161
 162 \begin{code}
 163 loadInterface :: SDoc -> Module -> WhereFrom
 164               -> IfM lcl (MaybeErr Message ModIface)
 165
 166 -- loadInterface looks in both the HPT and PIT for the required interface
 167 -- If not found, it loads it, and puts it in the PIT (always).
 168
 169 -- If it can't find a suitable interface file, we
 170 --      a) modify the PackageIfaceTable to have an empty entry
 171 --              (to avoid repeated complaints)
 172 --      b) return (Left message)
 173 --
 174 -- It's not necessarily an error for there not to be an interface
 175 -- file -- perhaps the module has changed, and that interface
 176 -- is no longer used
 177
 178 loadInterface doc_str mod from
 179   = do  {       -- Read the state
 180           (eps,hpt) <- getEpsAndHpt
 181
 182         ; traceIf (text "Considering whether to load" <+> ppr mod <+> ppr from)
 183
 184                 -- Check whether we have the interface already
 185         ; dflags <- getDOpts
 186         ; case lookupIfaceByModule dflags hpt (eps_PIT eps) mod of {
 187             Just iface
 188                 -> return (Succeeded iface) ;   -- Already loaded
 189                         -- The (src_imp == mi_boot iface) test checks that the already-loaded
 190                         -- interface isn't a boot iface.  This can conceivably happen,
 191                         -- if an earlier import had a before we got to real imports.   I think.
 192             _ -> do {
 193
 194           let { hi_boot_file = if thisPackage dflags == modulePackageId mod
 195                                then case from of
 196                                     ImportByUser usr_boot -> usr_boot
 197                                     ImportBySystem        -> sys_boot
 198                                else False
 199
 200               ; mb_dep   = lookupUFM (eps_is_boot eps) (moduleName mod)
 201               ; sys_boot = case mb_dep of
 202                                 Just (_, is_boot) -> is_boot
 203                                 Nothing           -> False
 204                         -- The boot-ness of the requested interface,
 205               }         -- based on the dependencies in directly-imported modules
 206
 207         -- READ THE MODULE IN
 208         ; read_result <- findAndReadIface doc_str mod hi_boot_file
 209         ; case read_result of {
 210             Failed err -> do
 211                 { let fake_iface = emptyModIface mod
 212
 213                 ; updateEps_ $ \eps ->
 214                         eps { eps_PIT = extendModuleEnv (eps_PIT eps) (mi_module fake_iface) fake_iface }
 215                         -- Not found, so add an empty iface to
 216                         -- the EPS map so that we don't look again
 217
 218                 ; return (Failed err) } ;
 219
 220         -- Found and parsed!
 221         -- We used to have a sanity check here that looked for:
 222         --  * System importing ..
 223         --  * a home package module ..
 224         --  * that we know nothing about (mb_dep == Nothing)!
 225         --
 226         -- But this is no longer valid because thNameToGhcName allows users to
 227         -- cause the system to load arbitrary interfaces (by supplying an appropriate
 228         -- Template Haskell original-name).
 229             Succeeded (iface, file_path) ->
 230
 231         let
 232             loc_doc = text file_path
 233         in
 234         initIfaceLcl mod loc_doc $ do
 235
 236         --      Load the new ModIface into the External Package State
 237         -- Even home-package interfaces loaded by loadInterface
 238         --      (which only happens in OneShot mode; in Batch/Interactive
 239         --      mode, home-package modules are loaded one by one into the HPT)
 240         -- are put in the EPS.
 241         --
 242         -- The main thing is to add the ModIface to the PIT, but
 243         -- we also take the
 244         --      IfaceDecls, IfaceInst, IfaceFamInst, IfaceRules, IfaceVectInfo
 245         -- out of the ModIface and put them into the big EPS pools
 246
 247         -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
 248         ---    names is done correctly (notably, whether this is an .hi file or .hi-boot file).
 249         --     If we do loadExport first the wrong info gets into the cache (unless we
 250         --      explicitly tag each export which seems a bit of a bore)
 251
 252         ; ignore_prags      <- doptM Opt_IgnoreInterfacePragmas
 253         ; new_eps_decls     <- loadDecls ignore_prags (mi_decls iface)
 254         ; new_eps_insts     <- mapM tcIfaceInst (mi_insts iface)
 255         ; new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
 256         ; new_eps_rules     <- tcIfaceRules ignore_prags (mi_rules iface)
 257         ; new_eps_anns      <- tcIfaceAnnotations (mi_anns iface)
 258         ; new_eps_vect_info <- tcIfaceVectInfo mod (mkNameEnv new_eps_decls)
 259                                                (mi_vect_info iface)
 260
 261         ; let { final_iface = iface {
 262                                 mi_decls     = panic "No mi_decls in PIT",
 263                                 mi_insts     = panic "No mi_insts in PIT",
 264                                 mi_fam_insts = panic "No mi_fam_insts in PIT",
 265                                 mi_rules     = panic "No mi_rules in PIT",
 266                                 mi_anns      = panic "No mi_anns in PIT"
 267                               }
 268                }
 269
 270         ; updateEps_  $ \ eps ->
 271             eps {
 272               eps_PIT          = extendModuleEnv (eps_PIT eps) mod final_iface,
 273               eps_PTE          = addDeclsToPTE   (eps_PTE eps) new_eps_decls,
 274               eps_rule_base    = extendRuleBaseList (eps_rule_base eps)
 275                                                     new_eps_rules,
 276               eps_inst_env     = extendInstEnvList (eps_inst_env eps)
 277                                                    new_eps_insts,
 278               eps_fam_inst_env = extendFamInstEnvList (eps_fam_inst_env eps)
 279                                                       new_eps_fam_insts,
 280               eps_vect_info    = plusVectInfo (eps_vect_info eps)
 281                                               new_eps_vect_info,
 282               eps_ann_env      = extendAnnEnvList (eps_ann_env eps)
 283                                                   new_eps_anns,
 284               eps_mod_fam_inst_env
 285                                = let
 286                                    fam_inst_env =
 287                                      extendFamInstEnvList emptyFamInstEnv
 288                                                           new_eps_fam_insts
 289                                  in
 290                                  extendModuleEnv (eps_mod_fam_inst_env eps)
 291                                                  mod
 292                                                  fam_inst_env,
 293               eps_stats        = addEpsInStats (eps_stats eps)
 294                                                (length new_eps_decls)
 295                                                (length new_eps_insts)
 296                                                (length new_eps_rules) }
 297
 298         ; return (Succeeded final_iface)
 299     }}}}
 300
 301 {-
 302 Used to be used for the loadInterface sanity check on system imports. That has been removed, but I'm leaving this in pending
 303 review of this decision by SPJ - MCB 10/2008
 304
 305 badDepMsg :: Module -> SDoc
 306 badDepMsg mod
 307   = hang (ptext (sLit "Interface file inconsistency:"))
 308        2 (sep [ptext (sLit "home-package module") <+> quotes (ppr mod) <+> ptext (sLit "is needed,"),
 309                ptext (sLit "but is not listed in the dependencies of the interfaces directly imported by the module being compiled")])
 310 -}
 311
 312 -----------------------------------------------------
 313 --      Loading type/class/value decls
 314 -- We pass the full Module name here, replete with
 315 -- its package info, so that we can build a Name for
 316 -- each binder with the right package info in it
 317 -- All subsequent lookups, including crucially lookups during typechecking
 318 -- the declaration itself, will find the fully-glorious Name
 319 --
 320 -- We handle ATs specially.  They are not main declarations, but also not
 321 -- implict things (in particular, adding them to `implicitTyThings' would mess
 322 -- things up in the renaming/type checking of source programs).
 323 -----------------------------------------------------
 324
 325 addDeclsToPTE :: PackageTypeEnv -> [(Name,TyThing)] -> PackageTypeEnv
 326 addDeclsToPTE pte things = extendNameEnvList pte things
 327
 328 loadDecls :: Bool
 329           -> [(Fingerprint, IfaceDecl)]
 330           -> IfL [(Name,TyThing)]
 331 loadDecls ignore_prags ver_decls
 332    = do { mod <- getIfModule
 333         ; thingss <- mapM (loadDecl ignore_prags mod) ver_decls
 334         ; return (concat thingss)
 335         }
 336
 337 loadDecl :: Bool                    -- Don't load pragmas into the decl pool
 338          -> Module
 339           -> (Fingerprint, IfaceDecl)
 340           -> IfL [(Name,TyThing)]   -- The list can be poked eagerly, but the
 341                                     -- TyThings are forkM'd thunks
 342 loadDecl ignore_prags mod (_version, decl)
 343   = do  {       -- Populate the name cache with final versions of all
 344                 -- the names associated with the decl
 345           main_name      <- lookupOrig mod (ifName decl)
 346 --        ; traceIf (text "Loading decl for " <> ppr main_name)
 347         ; implicit_names <- mapM (lookupOrig mod) (ifaceDeclSubBndrs decl)
 348
 349         -- Typecheck the thing, lazily
 350         -- NB. Firstly, the laziness is there in case we never need the
 351         -- declaration (in one-shot mode), and secondly it is there so that
 352         -- we don't look up the occurrence of a name before calling mk_new_bndr
 353         -- on the binder.  This is important because we must get the right name
 354         -- which includes its nameParent.
 355
 356         ; thing <- forkM doc $ do { bumpDeclStats main_name
 357                                   ; tcIfaceDecl ignore_prags decl }
 358
 359         -- Populate the type environment with the implicitTyThings too.
 360         --
 361         -- Note [Tricky iface loop]
 362         -- ~~~~~~~~~~~~~~~~~~~~~~~~
 363         -- Summary: The delicate point here is that 'mini-env' must be
 364         -- buildable from 'thing' without demanding any of the things
 365         -- 'forkM'd by tcIfaceDecl.
 366         --
 367         -- In more detail: Consider the example
 368         --      data T a = MkT { x :: T a }
 369         -- The implicitTyThings of T are:  [ <datacon MkT>, <selector x>]
 370         -- (plus their workers, wrappers, coercions etc etc)
 371         --
 372         -- We want to return an environment
 373         --      [ "MkT" -> <datacon MkT>, "x" -> <selector x>, ... ]
 374         -- (where the "MkT" is the *Name* associated with MkT, etc.)
 375         --
 376         -- We do this by mapping the implict_names to the associated
 377         -- TyThings.  By the invariant on ifaceDeclSubBndrs and
 378         -- implicitTyThings, we can use getOccName on the implicit
 379         -- TyThings to make this association: each Name's OccName should
 380         -- be the OccName of exactly one implictTyThing.  So the key is
 381         -- to define a "mini-env"
 382         --
 383         -- [ 'MkT' -> <datacon MkT>, 'x' -> <selector x>, ... ]
 384         -- where the 'MkT' here is the *OccName* associated with MkT.
 385         --
 386         -- However, there is a subtlety: due to how type checking needs
 387         -- to be staged, we can't poke on the forkM'd thunks inside the
 388         -- implictTyThings while building this mini-env.
 389         -- If we poke these thunks too early, two problems could happen:
 390         --    (1) When processing mutually recursive modules across
 391         --        hs-boot boundaries, poking too early will do the
 392         --        type-checking before the recursive knot has been tied,
 393         --        so things will be type-checked in the wrong
 394         --        environment, and necessary variables won't be in
 395         --        scope.
 396         --
 397         --    (2) Looking up one OccName in the mini_env will cause
 398         --        others to be looked up, which might cause that
 399         --        original one to be looked up again, and hence loop.
 400         --
 401         -- The code below works because of the following invariant:
 402         -- getOccName on a TyThing does not force the suspended type
 403         -- checks in order to extract the name. For example, we don't
 404         -- poke on the "T a" type of <selector x> on the way to
 405         -- extracting <selector x>'s OccName. Of course, there is no
 406         -- reason in principle why getting the OccName should force the
 407         -- thunks, but this means we need to be careful in
 408         -- implicitTyThings and its helper functions.
 409         --
 410         -- All a bit too finely-balanced for my liking.
 411
 412         -- This mini-env and lookup function mediates between the
 413         --'Name's n and the map from 'OccName's to the implicit TyThings
 414         ; let mini_env = mkOccEnv [(getOccName t, t) | t <- implicitTyThings thing]
 415               lookup n = case lookupOccEnv mini_env (getOccName n) of
 416                            Just thing -> thing
 417                            Nothing    ->
 418                              pprPanic "loadDecl" (ppr main_name <+> ppr n $$ ppr (decl))
 419
 420         ; return $ (main_name, thing) :
 421                       -- uses the invariant that implicit_names and
 422                       -- implictTyThings are bijective
 423                       [(n, lookup n) | n <- implicit_names]
 424         }
 425   where
 426     doc = ptext (sLit "Declaration for") <+> ppr (ifName decl)
 427
 428 bumpDeclStats :: Name -> IfL ()         -- Record that one more declaration has actually been used
 429 bumpDeclStats name
 430   = do  { traceIf (text "Loading decl for" <+> ppr name)
 431         ; updateEps_ (\eps -> let stats = eps_stats eps
 432                               in eps { eps_stats = stats { n_decls_out = n_decls_out stats + 1 } })
 433         }
 434 \end{code}
 435
 436
 437 %*********************************************************
 438 %*                                                      *
 439 \subsection{Reading an interface file}
 440 %*                                                      *
 441 %*********************************************************
 442
 443 \begin{code}
 444 findAndReadIface :: SDoc -> Module
 445                  -> IsBootInterface     -- True  <=> Look for a .hi-boot file
 446                                         -- False <=> Look for .hi file
 447                  -> TcRnIf gbl lcl (MaybeErr Message (ModIface, FilePath))
 448         -- Nothing <=> file not found, or unreadable, or illegible
 449         -- Just x  <=> successfully found and parsed
 450
 451         -- It *doesn't* add an error to the monad, because
 452         -- sometimes it's ok to fail... see notes with loadInterface
 453
 454 findAndReadIface doc_str mod hi_boot_file
 455   = do  { traceIf (sep [hsep [ptext (sLit "Reading"),
 456                               if hi_boot_file
 457                                 then ptext (sLit "[boot]")
 458                                 else empty,
 459                               ptext (sLit "interface for"),
 460                               ppr mod <> semi],
 461                         nest 4 (ptext (sLit "reason:") <+> doc_str)])
 462
 463         -- Check for GHC.Prim, and return its static interface
 464         ; dflags <- getDOpts
 465         ; if mod == gHC_PRIM
 466           then return (Succeeded (ghcPrimIface,
 467                                    "<built in interface for GHC.Prim>"))
 468           else do
 469
 470         -- Look for the file
 471         ; hsc_env <- getTopEnv
 472         ; mb_found <- liftIO (findExactModule hsc_env mod)
 473         ; case mb_found of {
 474
 475               Found loc mod -> do
 476
 477         -- Found file, so read it
 478         { let { file_path = addBootSuffix_maybe hi_boot_file (ml_hi_file loc) }
 479
 480         -- If the interface is in the current package then if we could
 481         -- load it would already be in the HPT and we assume that our
 482         -- callers checked that.
 483         ; if thisPackage dflags == modulePackageId mod
 484                 && not (isOneShot (ghcMode dflags))
 485             then return (Failed (homeModError mod loc))
 486             else do {
 487
 488         ; traceIf (ptext (sLit "readIFace") <+> text file_path)
 489         ; read_result <- readIface mod file_path hi_boot_file
 490         ; case read_result of
 491             Failed err -> return (Failed (badIfaceFile file_path err))
 492             Succeeded iface
 493                 | mi_module iface /= mod ->
 494                   return (Failed (wrongIfaceModErr iface mod file_path))
 495                 | otherwise ->
 496                   return (Succeeded (iface, file_path))
 497                         -- Don't forget to fill in the package name...
 498         }}
 499             ; err -> do
 500                 { traceIf (ptext (sLit "...not found"))
 501                 ; dflags <- getDOpts
 502                 ; return (Failed (cannotFindInterface dflags
 503                                         (moduleName mod) err)) }
 504         }
 505         }
 506 \end{code}
 507
 508 @readIface@ tries just the one file.
 509
 510 \begin{code}
 511 readIface :: Module -> FilePath -> IsBootInterface
 512           -> TcRnIf gbl lcl (MaybeErr Message ModIface)
 513         -- Failed err    <=> file not found, or unreadable, or illegible
 514         -- Succeeded iface <=> successfully found and parsed
 515
 516 readIface wanted_mod file_path _
 517   = do  { res <- tryMostM $
 518                  readBinIface CheckHiWay QuietBinIFaceReading file_path
 519         ; case res of
 520             Right iface
 521                 | wanted_mod == actual_mod -> return (Succeeded iface)
 522                 | otherwise                -> return (Failed err)
 523                 where
 524                   actual_mod = mi_module iface
 525                   err = hiModuleNameMismatchWarn wanted_mod actual_mod
 526
 527             Left exn    -> return (Failed (text (showException exn)))
 528     }
 529 \end{code}
 530
 531
 532 %*********************************************************
 533 %*                                                       *
 534         Wired-in interface for GHC.Prim
 535 %*                                                       *
 536 %*********************************************************
 537
 538 \begin{code}
 539 initExternalPackageState :: ExternalPackageState
 540 initExternalPackageState
 541   = EPS {
 542       eps_is_boot      = emptyUFM,
 543       eps_PIT          = emptyPackageIfaceTable,
 544       eps_PTE          = emptyTypeEnv,
 545       eps_inst_env     = emptyInstEnv,
 546       eps_fam_inst_env = emptyFamInstEnv,
 547       eps_rule_base    = mkRuleBase builtinRules,
 548         -- Initialise the EPS rule pool with the built-in rules
 549       eps_mod_fam_inst_env
 550                        = emptyModuleEnv,
 551       eps_vect_info    = noVectInfo,
 552       eps_ann_env      = emptyAnnEnv,
 553       eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0
 554                            , n_insts_in = 0, n_insts_out = 0
 555                            , n_rules_in = length builtinRules, n_rules_out = 0 }
 556     }
 557 \end{code}
 558
 559
 560 %*********************************************************
 561 %*                                                       *
 562         Wired-in interface for GHC.Prim
 563 %*                                                       *
 564 %*********************************************************
 565
 566 \begin{code}
 567 ghcPrimIface :: ModIface
 568 ghcPrimIface
 569   = (emptyModIface gHC_PRIM) {
 570         mi_exports  = [(gHC_PRIM, ghcPrimExports)],
 571         mi_decls    = [],
 572         mi_fixities = fixities,
 573         mi_fix_fn  = mkIfaceFixCache fixities
 574     }
 575   where
 576     fixities = [(getOccName seqId, Fixity 0 InfixR)]
 577                         -- seq is infixr 0
 578 \end{code}
 579
 580 %*********************************************************
 581 %*                                                      *
 582 \subsection{Statistics}
 583 %*                                                      *
 584 %*********************************************************
 585
 586 \begin{code}
 587 ifaceStats :: ExternalPackageState -> SDoc
 588 ifaceStats eps
 589   = hcat [text "Renamer stats: ", msg]
 590   where
 591     stats = eps_stats eps
 592     msg = vcat
 593         [int (n_ifaces_in stats) <+> text "interfaces read",
 594          hsep [ int (n_decls_out stats), text "type/class/variable imported, out of",
 595                 int (n_decls_in stats), text "read"],
 596          hsep [ int (n_insts_out stats), text "instance decls imported, out of",
 597                 int (n_insts_in stats), text "read"],
 598          hsep [ int (n_rules_out stats), text "rule decls imported, out of",
 599                 int (n_rules_in stats), text "read"]
 600         ]
 601 \end{code}
 602
 603
 604 %************************************************************************
 605 %*                                                                      *
 606                 Printing interfaces
 607 %*                                                                      *
 608 %************************************************************************
 609
 610 \begin{code}
 611 -- | Read binary interface, and print it out
 612 showIface :: HscEnv -> FilePath -> IO ()
 613 showIface hsc_env filename = do
 614    -- skip the hi way check; we don't want to worry about profiled vs.
 615    -- non-profiled interfaces, for example.
 616    iface <- initTcRnIf 's' hsc_env () () $
 617        readBinIface IgnoreHiWay TraceBinIFaceReading filename
 618    printDump (pprModIface iface)
 619 \end{code}
 620
 621 \begin{code}
 622 pprModIface :: ModIface -> SDoc
 623 -- Show a ModIface
 624 pprModIface iface
 625  = vcat [ ptext (sLit "interface")
 626                 <+> ppr (mi_module iface) <+> pp_boot
 627                 <+> (if mi_orphan iface then ptext (sLit "[orphan module]") else empty)
 628                 <+> (if mi_finsts iface then ptext (sLit "[family instance module]") else empty)
 629                 <+> (if mi_hpc    iface then ptext (sLit "[hpc]") else empty)
 630                 <+> integer opt_HiVersion
 631         , nest 2 (text "interface hash:" <+> ppr (mi_iface_hash iface))
 632         , nest 2 (text "ABI hash:" <+> ppr (mi_mod_hash iface))
 633         , nest 2 (text "export-list hash:" <+> ppr (mi_exp_hash iface))
 634         , nest 2 (text "orphan hash:" <+> ppr (mi_orphan_hash iface))
 635         , nest 2 (ptext (sLit "where"))
 636         , vcat (map pprExport (mi_exports iface))
 637         , pprDeps (mi_deps iface)
 638         , vcat (map pprUsage (mi_usages iface))
 639         , vcat (map pprIfaceAnnotation (mi_anns iface))
 640         , pprFixities (mi_fixities iface)
 641         , vcat (map pprIfaceDecl (mi_decls iface))
 642         , vcat (map ppr (mi_insts iface))
 643         , vcat (map ppr (mi_fam_insts iface))
 644         , vcat (map ppr (mi_rules iface))
 645         , pprVectInfo (mi_vect_info iface)
 646         , ppr (mi_warns iface)
 647         ]
 648   where
 649     pp_boot | mi_boot iface = ptext (sLit "[boot]")
 650             | otherwise     = empty
 651 \end{code}
 652
 653 When printing export lists, we print like this:
 654         Avail   f               f
 655         AvailTC C [C, x, y]     C(x,y)
 656         AvailTC C [x, y]        C!(x,y)         -- Exporting x, y but not C
 657
 658 \begin{code}
 659 pprExport :: IfaceExport -> SDoc
 660 pprExport (mod, items)
 661  = hsep [ ptext (sLit "export"), ppr mod, hsep (map pp_avail items) ]
 662   where
 663     pp_avail :: GenAvailInfo OccName -> SDoc
 664     pp_avail (Avail occ)    = ppr occ
 665     pp_avail (AvailTC _ []) = empty
 666     pp_avail (AvailTC n (n':ns))
 667         | n==n'     = ppr n <> pp_export ns
 668         | otherwise = ppr n <> char '|' <> pp_export (n':ns)
 669
 670     pp_export []    = empty
 671     pp_export names = braces (hsep (map ppr names))
 672
 673 pprUsage :: Usage -> SDoc
 674 pprUsage usage@UsagePackageModule{}
 675   = hsep [ptext (sLit "import"), ppr (usg_mod usage),
 676           ppr (usg_mod_hash usage)]
 677 pprUsage usage@UsageHomeModule{}
 678   = hsep [ptext (sLit "import"), ppr (usg_mod_name usage),
 679           ppr (usg_mod_hash usage)] $$
 680     nest 2 (
 681         maybe empty (\v -> text "exports: " <> ppr v) (usg_exports usage) $$
 682         vcat [ ppr n <+> ppr v | (n,v) <- usg_entities usage ]
 683         )
 684
 685 pprDeps :: Dependencies -> SDoc
 686 pprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs,
 687                 dep_finsts = finsts })
 688   = vcat [ptext (sLit "module dependencies:") <+> fsep (map ppr_mod mods),
 689           ptext (sLit "package dependencies:") <+> fsep (map ppr pkgs),
 690           ptext (sLit "orphans:") <+> fsep (map ppr orphs),
 691           ptext (sLit "family instance modules:") <+> fsep (map ppr finsts)
 692         ]
 693   where
 694     ppr_mod (mod_name, boot) = ppr mod_name <+> ppr_boot boot
 695     ppr_boot True  = text "[boot]"
 696     ppr_boot False = empty
 697
 698 pprIfaceDecl :: (Fingerprint, IfaceDecl) -> SDoc
 699 pprIfaceDecl (ver, decl)
 700   = ppr ver $$ nest 2 (ppr decl)
 701
 702 pprFixities :: [(OccName, Fixity)] -> SDoc
 703 pprFixities []    = empty
 704 pprFixities fixes = ptext (sLit "fixities") <+> pprWithCommas pprFix fixes
 705                   where
 706                     pprFix (occ,fix) = ppr fix <+> ppr occ
 707
 708 pprVectInfo :: IfaceVectInfo -> SDoc
 709 pprVectInfo (IfaceVectInfo { ifaceVectInfoVar        = vars
 710                            , ifaceVectInfoTyCon      = tycons
 711                            , ifaceVectInfoTyConReuse = tyconsReuse
 712                            }) =
 713   vcat
 714   [ ptext (sLit "vectorised variables:") <+> hsep (map ppr vars)
 715   , ptext (sLit "vectorised tycons:") <+> hsep (map ppr tycons)
 716   , ptext (sLit "vectorised reused tycons:") <+> hsep (map ppr tyconsReuse)
 717   ]
 718
 719 instance Outputable Warnings where
 720     ppr = pprWarns
 721
 722 pprWarns :: Warnings -> SDoc
 723 pprWarns NoWarnings         = empty
 724 pprWarns (WarnAll txt)  = ptext (sLit "Warn all") <+> ppr txt
 725 pprWarns (WarnSome prs) = ptext (sLit "Warnings")
 726                         <+> vcat (map pprWarning prs)
 727     where pprWarning (name, txt) = ppr name <+> ppr txt
 728
 729 pprIfaceAnnotation :: IfaceAnnotation -> SDoc
 730 pprIfaceAnnotation (IfaceAnnotation { ifAnnotatedTarget = target, ifAnnotatedValue = serialized })
 731   = ppr target <+> ptext (sLit "annotated by") <+> ppr serialized
 732 \end{code}
 733
 734
 735 %*********************************************************
 736 %*                                                       *
 737 \subsection{Errors}
 738 %*                                                       *
 739 %*********************************************************
 740
 741 \begin{code}
 742 badIfaceFile :: String -> SDoc -> SDoc
 743 badIfaceFile file err
 744   = vcat [ptext (sLit "Bad interface file:") <+> text file,
 745           nest 4 err]
 746
 747 hiModuleNameMismatchWarn :: Module -> Module -> Message
 748 hiModuleNameMismatchWarn requested_mod read_mod =
 749   withPprStyle defaultUserStyle $
 750     -- we want the Modules below to be qualified with package names,
 751     -- so reset the PrintUnqualified setting.
 752     hsep [ ptext (sLit "Something is amiss; requested module ")
 753          , ppr requested_mod
 754          , ptext (sLit "differs from name found in the interface file")
 755          , ppr read_mod
 756          ]
 757
 758 wrongIfaceModErr :: ModIface -> Module -> String -> SDoc
 759 wrongIfaceModErr iface mod_name file_path
 760   = sep [ptext (sLit "Interface file") <+> iface_file,
 761          ptext (sLit "contains module") <+> quotes (ppr (mi_module iface)) <> comma,
 762          ptext (sLit "but we were expecting module") <+> quotes (ppr mod_name),
 763          sep [ptext (sLit "Probable cause: the source code which generated"),
 764              nest 2 iface_file,
 765              ptext (sLit "has an incompatible module name")
 766             ]
 767         ]
 768   where iface_file = doubleQuotes (text file_path)
 769
 770 homeModError :: Module -> ModLocation -> SDoc
 771 homeModError mod location
 772   = ptext (sLit "attempting to use module ") <> quotes (ppr mod)
 773     <> (case ml_hs_file location of
 774            Just file -> space <> parens (text file)
 775            Nothing   -> empty)
 776     <+> ptext (sLit "which is not loaded")
 777 \end{code}
 778