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