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 = case from of
 195                                 ImportByUser usr_boot -> usr_boot
 196                                 ImportBySystem        -> sys_boot
 197
 198               ; mb_dep   = lookupUFM (eps_is_boot eps) (moduleName mod)
 199               ; sys_boot = case mb_dep of
 200                                 Just (_, is_boot) -> is_boot
 201                                 Nothing           -> False
 202                         -- The boot-ness of the requested interface,
 203               }         -- based on the dependencies in directly-imported modules
 204
 205         -- READ THE MODULE IN
 206         ; read_result <- findAndReadIface doc_str mod hi_boot_file
 207         ; case read_result of {
 208             Failed err -> do
 209                 { let fake_iface = emptyModIface mod
 210
 211                 ; updateEps_ $ \eps ->
 212                         eps { eps_PIT = extendModuleEnv (eps_PIT eps) (mi_module fake_iface) fake_iface }
 213                         -- Not found, so add an empty iface to
 214                         -- the EPS map so that we don't look again
 215
 216                 ; return (Failed err) } ;
 217
 218         -- Found and parsed!
 219         -- We used to have a sanity check here that looked for:
 220         --  * System importing ..
 221         --  * a home package module ..
 222         --  * that we know nothing about (mb_dep == Nothing)!
 223         --
 224         -- But this is no longer valid because thNameToGhcName allows users to
 225         -- cause the system to load arbitrary interfaces (by supplying an appropriate
 226         -- Template Haskell original-name).
 227             Succeeded (iface, file_path) ->
 228
 229         let
 230             loc_doc = text file_path
 231         in
 232         initIfaceLcl mod loc_doc $ do
 233
 234         --      Load the new ModIface into the External Package State
 235         -- Even home-package interfaces loaded by loadInterface
 236         --      (which only happens in OneShot mode; in Batch/Interactive
 237         --      mode, home-package modules are loaded one by one into the HPT)
 238         -- are put in the EPS.
 239         --
 240         -- The main thing is to add the ModIface to the PIT, but
 241         -- we also take the
 242         --      IfaceDecls, IfaceInst, IfaceFamInst, IfaceRules, IfaceVectInfo
 243         -- out of the ModIface and put them into the big EPS pools
 244
 245         -- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
 246         ---    names is done correctly (notably, whether this is an .hi file or .hi-boot file).
 247         --     If we do loadExport first the wrong info gets into the cache (unless we
 248         --      explicitly tag each export which seems a bit of a bore)
 249
 250         ; ignore_prags      <- doptM Opt_IgnoreInterfacePragmas
 251         ; new_eps_decls     <- loadDecls ignore_prags (mi_decls iface)
 252         ; new_eps_insts     <- mapM tcIfaceInst (mi_insts iface)
 253         ; new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
 254         ; new_eps_rules     <- tcIfaceRules ignore_prags (mi_rules iface)
 255         ; new_eps_anns      <- tcIfaceAnnotations (mi_anns iface)
 256         ; new_eps_vect_info <- tcIfaceVectInfo mod (mkNameEnv new_eps_decls)
 257                                                (mi_vect_info iface)
 258
 259         ; let { final_iface = iface {
 260                                 mi_decls     = panic "No mi_decls in PIT",
 261                                 mi_insts     = panic "No mi_insts in PIT",
 262                                 mi_fam_insts = panic "No mi_fam_insts in PIT",
 263                                 mi_rules     = panic "No mi_rules in PIT",
 264                                 mi_anns      = panic "No mi_anns in PIT"
 265                               }
 266                }
 267
 268         ; updateEps_  $ \ eps ->
 269             eps {
 270               eps_PIT          = extendModuleEnv (eps_PIT eps) mod final_iface,
 271               eps_PTE          = addDeclsToPTE   (eps_PTE eps) new_eps_decls,
 272               eps_rule_base    = extendRuleBaseList (eps_rule_base eps)
 273                                                     new_eps_rules,
 274               eps_inst_env     = extendInstEnvList (eps_inst_env eps)
 275                                                    new_eps_insts,
 276               eps_fam_inst_env = extendFamInstEnvList (eps_fam_inst_env eps)
 277                                                       new_eps_fam_insts,
 278               eps_vect_info    = plusVectInfo (eps_vect_info eps)
 279                                               new_eps_vect_info,
 280               eps_ann_env      = extendAnnEnvList (eps_ann_env eps)
 281                                                   new_eps_anns,
 282               eps_mod_fam_inst_env
 283                                = let
 284                                    fam_inst_env =
 285                                      extendFamInstEnvList emptyFamInstEnv
 286                                                           new_eps_fam_insts
 287                                  in
 288                                  extendModuleEnv (eps_mod_fam_inst_env eps)
 289                                                  mod
 290                                                  fam_inst_env,
 291               eps_stats        = addEpsInStats (eps_stats eps)
 292                                                (length new_eps_decls)
 293                                                (length new_eps_insts)
 294                                                (length new_eps_rules) }
 295
 296         ; return (Succeeded final_iface)
 297     }}}}
 298
 299 {-
 300 Used to be used for the loadInterface sanity check on system imports. That has been removed, but I'm leaving this in pending
 301 review of this decision by SPJ - MCB 10/2008
 302
 303 badDepMsg :: Module -> SDoc
 304 badDepMsg mod
 305   = hang (ptext (sLit "Interface file inconsistency:"))
 306        2 (sep [ptext (sLit "home-package module") <+> quotes (ppr mod) <+> ptext (sLit "is needed,"),
 307                ptext (sLit "but is not listed in the dependencies of the interfaces directly imported by the module being compiled")])
 308 -}
 309
 310 -----------------------------------------------------
 311 --      Loading type/class/value decls
 312 -- We pass the full Module name here, replete with
 313 -- its package info, so that we can build a Name for
 314 -- each binder with the right package info in it
 315 -- All subsequent lookups, including crucially lookups during typechecking
 316 -- the declaration itself, will find the fully-glorious Name
 317 --
 318 -- We handle ATs specially.  They are not main declarations, but also not
 319 -- implict things (in particular, adding them to `implicitTyThings' would mess
 320 -- things up in the renaming/type checking of source programs).
 321 -----------------------------------------------------
 322
 323 addDeclsToPTE :: PackageTypeEnv -> [(Name,TyThing)] -> PackageTypeEnv
 324 addDeclsToPTE pte things = extendNameEnvList pte things
 325
 326 loadDecls :: Bool
 327           -> [(Fingerprint, IfaceDecl)]
 328           -> IfL [(Name,TyThing)]
 329 loadDecls ignore_prags ver_decls
 330    = do { mod <- getIfModule
 331         ; thingss <- mapM (loadDecl ignore_prags mod) ver_decls
 332         ; return (concat thingss)
 333         }
 334
 335 loadDecl :: Bool                    -- Don't load pragmas into the decl pool
 336          -> Module
 337           -> (Fingerprint, IfaceDecl)
 338           -> IfL [(Name,TyThing)]   -- The list can be poked eagerly, but the
 339                                     -- TyThings are forkM'd thunks
 340 loadDecl ignore_prags mod (_version, decl)
 341   = do  {       -- Populate the name cache with final versions of all
 342                 -- the names associated with the decl
 343           main_name      <- lookupOrig mod (ifName decl)
 344 --        ; traceIf (text "Loading decl for " <> ppr main_name)
 345         ; implicit_names <- mapM (lookupOrig mod) (ifaceDeclSubBndrs decl)
 346
 347         -- Typecheck the thing, lazily
 348         -- NB. Firstly, the laziness is there in case we never need the
 349         -- declaration (in one-shot mode), and secondly it is there so that
 350         -- we don't look up the occurrence of a name before calling mk_new_bndr
 351         -- on the binder.  This is important because we must get the right name
 352         -- which includes its nameParent.
 353
 354         ; thing <- forkM doc $ do { bumpDeclStats main_name
 355                                   ; tcIfaceDecl ignore_prags decl }
 356
 357         -- Populate the type environment with the implicitTyThings too.
 358         --
 359         -- Note [Tricky iface loop]
 360         -- ~~~~~~~~~~~~~~~~~~~~~~~~
 361         -- Summary: The delicate point here is that 'mini-env' must be
 362         -- buildable from 'thing' without demanding any of the things
 363         -- 'forkM'd by tcIfaceDecl.
 364         --
 365         -- In more detail: Consider the example
 366         --      data T a = MkT { x :: T a }
 367         -- The implicitTyThings of T are:  [ <datacon MkT>, <selector x>]
 368         -- (plus their workers, wrappers, coercions etc etc)
 369         --
 370         -- We want to return an environment
 371         --      [ "MkT" -> <datacon MkT>, "x" -> <selector x>, ... ]
 372         -- (where the "MkT" is the *Name* associated with MkT, etc.)
 373         --
 374         -- We do this by mapping the implict_names to the associated
 375         -- TyThings.  By the invariant on ifaceDeclSubBndrs and
 376         -- implicitTyThings, we can use getOccName on the implicit
 377         -- TyThings to make this association: each Name's OccName should
 378         -- be the OccName of exactly one implictTyThing.  So the key is
 379         -- to define a "mini-env"
 380         --
 381         -- [ 'MkT' -> <datacon MkT>, 'x' -> <selector x>, ... ]
 382         -- where the 'MkT' here is the *OccName* associated with MkT.
 383         --
 384         -- However, there is a subtlety: due to how type checking needs
 385         -- to be staged, we can't poke on the forkM'd thunks inside the
 386         -- implictTyThings while building this mini-env.
 387         -- If we poke these thunks too early, two problems could happen:
 388         --    (1) When processing mutually recursive modules across
 389         --        hs-boot boundaries, poking too early will do the
 390         --        type-checking before the recursive knot has been tied,
 391         --        so things will be type-checked in the wrong
 392         --        environment, and necessary variables won't be in
 393         --        scope.
 394         --
 395         --    (2) Looking up one OccName in the mini_env will cause
 396         --        others to be looked up, which might cause that
 397         --        original one to be looked up again, and hence loop.
 398         --
 399         -- The code below works because of the following invariant:
 400         -- getOccName on a TyThing does not force the suspended type
 401         -- checks in order to extract the name. For example, we don't
 402         -- poke on the "T a" type of <selector x> on the way to
 403         -- extracting <selector x>'s OccName. Of course, there is no
 404         -- reason in principle why getting the OccName should force the
 405         -- thunks, but this means we need to be careful in
 406         -- implicitTyThings and its helper functions.
 407         --
 408         -- All a bit too finely-balanced for my liking.
 409
 410         -- This mini-env and lookup function mediates between the
 411         --'Name's n and the map from 'OccName's to the implicit TyThings
 412         ; let mini_env = mkOccEnv [(getOccName t, t) | t <- implicitTyThings thing]
 413               lookup n = case lookupOccEnv mini_env (getOccName n) of
 414                            Just thing -> thing
 415                            Nothing    ->
 416                              pprPanic "loadDecl" (ppr main_name <+> ppr n $$ ppr (decl))
 417
 418         ; return $ (main_name, thing) :
 419                       -- uses the invariant that implicit_names and
 420                       -- implictTyThings are bijective
 421                       [(n, lookup n) | n <- implicit_names]
 422         }
 423   where
 424     doc = ptext (sLit "Declaration for") <+> ppr (ifName decl)
 425
 426 bumpDeclStats :: Name -> IfL ()         -- Record that one more declaration has actually been used
 427 bumpDeclStats name
 428   = do  { traceIf (text "Loading decl for" <+> ppr name)
 429         ; updateEps_ (\eps -> let stats = eps_stats eps
 430                               in eps { eps_stats = stats { n_decls_out = n_decls_out stats + 1 } })
 431         }
 432 \end{code}
 433
 434
 435 %*********************************************************
 436 %*                                                      *
 437 \subsection{Reading an interface file}
 438 %*                                                      *
 439 %*********************************************************
 440
 441 \begin{code}
 442 findAndReadIface :: SDoc -> Module
 443                  -> IsBootInterface     -- True  <=> Look for a .hi-boot file
 444                                         -- False <=> Look for .hi file
 445                  -> TcRnIf gbl lcl (MaybeErr Message (ModIface, FilePath))
 446         -- Nothing <=> file not found, or unreadable, or illegible
 447         -- Just x  <=> successfully found and parsed
 448
 449         -- It *doesn't* add an error to the monad, because
 450         -- sometimes it's ok to fail... see notes with loadInterface
 451
 452 findAndReadIface doc_str mod hi_boot_file
 453   = do  { traceIf (sep [hsep [ptext (sLit "Reading"),
 454                               if hi_boot_file
 455                                 then ptext (sLit "[boot]")
 456                                 else empty,
 457                               ptext (sLit "interface for"),
 458                               ppr mod <> semi],
 459                         nest 4 (ptext (sLit "reason:") <+> doc_str)])
 460
 461         -- Check for GHC.Prim, and return its static interface
 462         ; dflags <- getDOpts
 463         ; if mod == gHC_PRIM
 464           then return (Succeeded (ghcPrimIface,
 465                                    "<built in interface for GHC.Prim>"))
 466           else do
 467
 468         -- Look for the file
 469         ; hsc_env <- getTopEnv
 470         ; mb_found <- liftIO (findExactModule hsc_env mod)
 471         ; case mb_found of {
 472
 473               Found loc mod -> do
 474
 475         -- Found file, so read it
 476         { let { file_path = addBootSuffix_maybe hi_boot_file (ml_hi_file loc) }
 477
 478         -- If the interface is in the current package then if we could
 479         -- load it would already be in the HPT and we assume that our
 480         -- callers checked that.
 481         ; if thisPackage dflags == modulePackageId mod
 482                 && not (isOneShot (ghcMode dflags))
 483             then return (Failed (homeModError mod loc))
 484             else do {
 485
 486         ; traceIf (ptext (sLit "readIFace") <+> text file_path)
 487         ; read_result <- readIface mod file_path hi_boot_file
 488         ; case read_result of
 489             Failed err -> return (Failed (badIfaceFile file_path err))
 490             Succeeded iface
 491                 | mi_module iface /= mod ->
 492                   return (Failed (wrongIfaceModErr iface mod file_path))
 493                 | otherwise ->
 494                   return (Succeeded (iface, file_path))
 495                         -- Don't forget to fill in the package name...
 496         }}
 497             ; err -> do
 498                 { traceIf (ptext (sLit "...not found"))
 499                 ; dflags <- getDOpts
 500                 ; return (Failed (cannotFindInterface dflags
 501                                         (moduleName mod) err)) }
 502         }
 503         }
 504 \end{code}
 505
 506 @readIface@ tries just the one file.
 507
 508 \begin{code}
 509 readIface :: Module -> FilePath -> IsBootInterface
 510           -> TcRnIf gbl lcl (MaybeErr Message ModIface)
 511         -- Failed err    <=> file not found, or unreadable, or illegible
 512         -- Succeeded iface <=> successfully found and parsed
 513
 514 readIface wanted_mod file_path _
 515   = do  { res <- tryMostM $
 516                  readBinIface CheckHiWay QuietBinIFaceReading file_path
 517         ; case res of
 518             Right iface
 519                 | wanted_mod == actual_mod -> return (Succeeded iface)
 520                 | otherwise                -> return (Failed err)
 521                 where
 522                   actual_mod = mi_module iface
 523                   err = hiModuleNameMismatchWarn wanted_mod actual_mod
 524
 525             Left exn    -> return (Failed (text (showException exn)))
 526     }
 527 \end{code}
 528
 529
 530 %*********************************************************
 531 %*                                                       *
 532         Wired-in interface for GHC.Prim
 533 %*                                                       *
 534 %*********************************************************
 535
 536 \begin{code}
 537 initExternalPackageState :: ExternalPackageState
 538 initExternalPackageState
 539   = EPS {
 540       eps_is_boot      = emptyUFM,
 541       eps_PIT          = emptyPackageIfaceTable,
 542       eps_PTE          = emptyTypeEnv,
 543       eps_inst_env     = emptyInstEnv,
 544       eps_fam_inst_env = emptyFamInstEnv,
 545       eps_rule_base    = mkRuleBase builtinRules,
 546         -- Initialise the EPS rule pool with the built-in rules
 547       eps_mod_fam_inst_env
 548                        = emptyModuleEnv,
 549       eps_vect_info    = noVectInfo,
 550       eps_ann_env      = emptyAnnEnv,
 551       eps_stats = EpsStats { n_ifaces_in = 0, n_decls_in = 0, n_decls_out = 0
 552                            , n_insts_in = 0, n_insts_out = 0
 553                            , n_rules_in = length builtinRules, n_rules_out = 0 }
 554     }
 555 \end{code}
 556
 557
 558 %*********************************************************
 559 %*                                                       *
 560         Wired-in interface for GHC.Prim
 561 %*                                                       *
 562 %*********************************************************
 563
 564 \begin{code}
 565 ghcPrimIface :: ModIface
 566 ghcPrimIface
 567   = (emptyModIface gHC_PRIM) {
 568         mi_exports  = [(gHC_PRIM, ghcPrimExports)],
 569         mi_decls    = [],
 570         mi_fixities = fixities,
 571         mi_fix_fn  = mkIfaceFixCache fixities
 572     }
 573   where
 574     fixities = [(getOccName seqId, Fixity 0 InfixR)]
 575                         -- seq is infixr 0
 576 \end{code}
 577
 578 %*********************************************************
 579 %*                                                      *
 580 \subsection{Statistics}
 581 %*                                                      *
 582 %*********************************************************
 583
 584 \begin{code}
 585 ifaceStats :: ExternalPackageState -> SDoc
 586 ifaceStats eps
 587   = hcat [text "Renamer stats: ", msg]
 588   where
 589     stats = eps_stats eps
 590     msg = vcat
 591         [int (n_ifaces_in stats) <+> text "interfaces read",
 592          hsep [ int (n_decls_out stats), text "type/class/variable imported, out of",
 593                 int (n_decls_in stats), text "read"],
 594          hsep [ int (n_insts_out stats), text "instance decls imported, out of",
 595                 int (n_insts_in stats), text "read"],
 596          hsep [ int (n_rules_out stats), text "rule decls imported, out of",
 597                 int (n_rules_in stats), text "read"]
 598         ]
 599 \end{code}
 600
 601
 602 %************************************************************************
 603 %*                                                                      *
 604                 Printing interfaces
 605 %*                                                                      *
 606 %************************************************************************
 607
 608 \begin{code}
 609 -- | Read binary interface, and print it out
 610 showIface :: HscEnv -> FilePath -> IO ()
 611 showIface hsc_env filename = do
 612    -- skip the hi way check; we don't want to worry about profiled vs.
 613    -- non-profiled interfaces, for example.
 614    iface <- initTcRnIf 's' hsc_env () () $
 615        readBinIface IgnoreHiWay TraceBinIFaceReading filename
 616    printDump (pprModIface iface)
 617 \end{code}
 618
 619 \begin{code}
 620 pprModIface :: ModIface -> SDoc
 621 -- Show a ModIface
 622 pprModIface iface
 623  = vcat [ ptext (sLit "interface")
 624                 <+> ppr (mi_module iface) <+> pp_boot
 625                 <+> (if mi_orphan iface then ptext (sLit "[orphan module]") else empty)
 626                 <+> (if mi_finsts iface then ptext (sLit "[family instance module]") else empty)
 627                 <+> (if mi_hpc    iface then ptext (sLit "[hpc]") else empty)
 628                 <+> integer opt_HiVersion
 629         , nest 2 (text "interface hash:" <+> ppr (mi_iface_hash iface))
 630         , nest 2 (text "ABI hash:" <+> ppr (mi_mod_hash iface))
 631         , nest 2 (text "export-list hash:" <+> ppr (mi_exp_hash iface))
 632         , nest 2 (text "orphan hash:" <+> ppr (mi_orphan_hash iface))
 633         , nest 2 (ptext (sLit "where"))
 634         , vcat (map pprExport (mi_exports iface))
 635         , pprDeps (mi_deps iface)
 636         , vcat (map pprUsage (mi_usages iface))
 637         , vcat (map pprIfaceAnnotation (mi_anns iface))
 638         , pprFixities (mi_fixities iface)
 639         , vcat (map pprIfaceDecl (mi_decls iface))
 640         , vcat (map ppr (mi_insts iface))
 641         , vcat (map ppr (mi_fam_insts iface))
 642         , vcat (map ppr (mi_rules iface))
 643         , pprVectInfo (mi_vect_info iface)
 644         , ppr (mi_warns iface)
 645         ]
 646   where
 647     pp_boot | mi_boot iface = ptext (sLit "[boot]")
 648             | otherwise     = empty
 649 \end{code}
 650
 651 When printing export lists, we print like this:
 652         Avail   f               f
 653         AvailTC C [C, x, y]     C(x,y)
 654         AvailTC C [x, y]        C!(x,y)         -- Exporting x, y but not C
 655
 656 \begin{code}
 657 pprExport :: IfaceExport -> SDoc
 658 pprExport (mod, items)
 659  = hsep [ ptext (sLit "export"), ppr mod, hsep (map pp_avail items) ]
 660   where
 661     pp_avail :: GenAvailInfo OccName -> SDoc
 662     pp_avail (Avail occ)    = ppr occ
 663     pp_avail (AvailTC _ []) = empty
 664     pp_avail (AvailTC n (n':ns))
 665         | n==n'     = ppr n <> pp_export ns
 666         | otherwise = ppr n <> char '|' <> pp_export (n':ns)
 667
 668     pp_export []    = empty
 669     pp_export names = braces (hsep (map ppr names))
 670
 671 pprUsage :: Usage -> SDoc
 672 pprUsage usage@UsagePackageModule{}
 673   = hsep [ptext (sLit "import"), ppr (usg_mod usage),
 674           ppr (usg_mod_hash usage)]
 675 pprUsage usage@UsageHomeModule{}
 676   = hsep [ptext (sLit "import"), ppr (usg_mod_name usage),
 677           ppr (usg_mod_hash usage)] $$
 678     nest 2 (
 679         maybe empty (\v -> text "exports: " <> ppr v) (usg_exports usage) $$
 680         vcat [ ppr n <+> ppr v | (n,v) <- usg_entities usage ]
 681         )
 682
 683 pprDeps :: Dependencies -> SDoc
 684 pprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs,
 685                 dep_finsts = finsts })
 686   = vcat [ptext (sLit "module dependencies:") <+> fsep (map ppr_mod mods),
 687           ptext (sLit "package dependencies:") <+> fsep (map ppr pkgs),
 688           ptext (sLit "orphans:") <+> fsep (map ppr orphs),
 689           ptext (sLit "family instance modules:") <+> fsep (map ppr finsts)
 690         ]
 691   where
 692     ppr_mod (mod_name, boot) = ppr mod_name <+> ppr_boot boot
 693     ppr_boot True  = text "[boot]"
 694     ppr_boot False = empty
 695
 696 pprIfaceDecl :: (Fingerprint, IfaceDecl) -> SDoc
 697 pprIfaceDecl (ver, decl)
 698   = ppr ver $$ nest 2 (ppr decl)
 699
 700 pprFixities :: [(OccName, Fixity)] -> SDoc
 701 pprFixities []    = empty
 702 pprFixities fixes = ptext (sLit "fixities") <+> pprWithCommas pprFix fixes
 703                   where
 704                     pprFix (occ,fix) = ppr fix <+> ppr occ
 705
 706 pprVectInfo :: IfaceVectInfo -> SDoc
 707 pprVectInfo (IfaceVectInfo { ifaceVectInfoVar        = vars
 708                            , ifaceVectInfoTyCon      = tycons
 709                            , ifaceVectInfoTyConReuse = tyconsReuse
 710                            }) =
 711   vcat
 712   [ ptext (sLit "vectorised variables:") <+> hsep (map ppr vars)
 713   , ptext (sLit "vectorised tycons:") <+> hsep (map ppr tycons)
 714   , ptext (sLit "vectorised reused tycons:") <+> hsep (map ppr tyconsReuse)
 715   ]
 716
 717 instance Outputable Warnings where
 718     ppr = pprWarns
 719
 720 pprWarns :: Warnings -> SDoc
 721 pprWarns NoWarnings         = empty
 722 pprWarns (WarnAll txt)  = ptext (sLit "Warn all") <+> ppr txt
 723 pprWarns (WarnSome prs) = ptext (sLit "Warnings")
 724                         <+> vcat (map pprWarning prs)
 725     where pprWarning (name, txt) = ppr name <+> ppr txt
 726
 727 pprIfaceAnnotation :: IfaceAnnotation -> SDoc
 728 pprIfaceAnnotation (IfaceAnnotation { ifAnnotatedTarget = target, ifAnnotatedValue = serialized })
 729   = ppr target <+> ptext (sLit "annotated by") <+> ppr serialized
 730 \end{code}
 731
 732
 733 %*********************************************************
 734 %*                                                       *
 735 \subsection{Errors}
 736 %*                                                       *
 737 %*********************************************************
 738
 739 \begin{code}
 740 badIfaceFile :: String -> SDoc -> SDoc
 741 badIfaceFile file err
 742   = vcat [ptext (sLit "Bad interface file:") <+> text file,
 743           nest 4 err]
 744
 745 hiModuleNameMismatchWarn :: Module -> Module -> Message
 746 hiModuleNameMismatchWarn requested_mod read_mod =
 747   withPprStyle defaultUserStyle $
 748     -- we want the Modules below to be qualified with package names,
 749     -- so reset the PrintUnqualified setting.
 750     hsep [ ptext (sLit "Something is amiss; requested module ")
 751          , ppr requested_mod
 752          , ptext (sLit "differs from name found in the interface file")
 753          , ppr read_mod
 754          ]
 755
 756 wrongIfaceModErr :: ModIface -> Module -> String -> SDoc
 757 wrongIfaceModErr iface mod_name file_path
 758   = sep [ptext (sLit "Interface file") <+> iface_file,
 759          ptext (sLit "contains module") <+> quotes (ppr (mi_module iface)) <> comma,
 760          ptext (sLit "but we were expecting module") <+> quotes (ppr mod_name),
 761          sep [ptext (sLit "Probable cause: the source code which generated"),
 762              nest 2 iface_file,
 763              ptext (sLit "has an incompatible module name")
 764             ]
 765         ]
 766   where iface_file = doubleQuotes (text file_path)
 767
 768 homeModError :: Module -> ModLocation -> SDoc
 769 homeModError mod location
 770   = ptext (sLit "attempting to use module ") <> quotes (ppr mod)
 771     <> (case ml_hs_file location of
 772            Just file -> space <> parens (text file)
 773            Nothing   -> empty)
 774     <+> ptext (sLit "which is not loaded")
 775 \end{code}
 776