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