MkIface.lhs 39.8 KB
 simonpj committed Oct 09, 2003 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 % % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998 % \begin{code} module MkIface ( showIface, -- Print the iface in Foo.hi mkUsageInfo, -- Construct the usage info for a module mkIface, -- Build a ModIface from a ModGuts, -- including computing version information checkOldIface -- See if recompilation is required, by -- comparing version information ) where \end{code} ----------------------------------------------- MkIface.lhs deals with versioning ----------------------------------------------- Here's the version-related info in an interface file module Foo 8 -- module-version 3 -- export-list-version 2 -- rule-version Usages: -- Version info for what this compilation of Foo imported Baz 3 -- Module version [4] -- The export-list version if Foo depended on it (g,2) -- Function and its version (T,1) -- Type and its version f :: Int -> Int {- Unfolding: \x -> Wib.t[2] x -} -- The [2] says that f's unfolding -- mentions verison 2 of Wib.t ----------------------------------------------- Basic idea ----------------------------------------------- Basic idea: * In the mi_usages information in an interface, we record the version number of each free variable of the module * In mkIface, we compute the version number of each exported thing A.f by comparing its A.f's info with its new info, and bumping its version number if it differs. If A.f mentions B.g, and B.g's version number has changed, then we count A.f as having changed too. * In checkOldIface we compare the mi_usages for the module with the actual version info for all each thing recorded in mi_usages Fixities ~~~~~~~~ We count A.f as changing if its fixity changes Rules ~~~~~ If a rule changes, we want to recompile any module that might be affected by that rule. For non-orphan rules, this is relatively easy. If module M defines f, and a rule for f, just arrange that the version number for M.f changes if any of the rules for M.f change. Any module that does not depend on M.f can't be affected by the rule-change either. Orphan rules (ones whose 'head function' is not defined in M) are harder. Here's what we do. * We have a per-module orphan-rule version number which changes if any orphan rule changes. (It's unaffected by non-orphan rules.) * We record usage info for any orphan module 'below' this one, giving the orphan-rule version number. We recompile if this changes. The net effect is that if an orphan rule changes, we recompile every module above it. That's very conservative, but it's devilishly hard to know what it might affect, so we just have to be conservative. Instance decls ~~~~~~~~~~~~~~ In an iface file we have module A where instance Eq a => Eq [a] = dfun29 dfun29 :: ... We have a version number for dfun29, covering its unfolding etc. Suppose we are compiling a module M that imports A only indirectly. If typechecking M uses this instance decl, we record the dependency on A.dfun29 as if it were a free variable of the module (via the tcg_inst_usages accumulator). That means that A will appear in M's usage list. If the shape of the instance declaration changes, then so will dfun29's version, triggering a recompilation. Adding an instance declaration, or changing an instance decl that is not currently used, is more tricky. (This really only makes a difference when we have overlapping instance decls, because then the new instance decl might kick in to override the old one.) We handle this in a very similar way that we handle rules above. * For non-orphan instance decls, identify one locally-defined tycon/class mentioned in the decl. Treat the instance decl as part of the defn of that tycon/class, so that if the shape of the instance decl changes, so does the tycon/class; that in turn will force recompilation of anything that uses that tycon/class. * For orphan instance decls, act the same way as for orphan rules. Indeed, we use the same global orphan-rule version number. mkUsageInfo ~~~~~~~~~~~ mkUsageInfo figures out what the usage information'' for this moudule is; that is, what it must record in its interface file as the things it uses. We produce a line for every module B below the module, A, currently being compiled: import B ; to record the fact that A does import B indirectly. This is used to decide to look to look for B.hi rather than B.hi-boot when compiling a module that imports A. This line says that A imports B, but uses nothing in it. So we'll get an early bale-out when compiling A if B's version changes. The usage information records: \begin{itemize} \item (a) anything reachable from its body code \item (b) any module exported with a @module Foo@ \item (c) anything reachable from an exported item \end{itemize} Why (b)? Because if @Foo@ changes then this module's export list will change, so we must recompile this module at least as far as making a new interface file --- but in practice that means complete recompilation. Why (c)? Consider this: \begin{verbatim} module A( f, g ) where | module B( f ) where import B( f ) | f = h 3 g = ... | h = ... \end{verbatim} Here, @B.f@ isn't used in A. Should we nevertheless record @B.f@ in @A@'s usages? Our idea is that we aren't going to touch A.hi if it is *identical* to what it was before. If anything about @B.f@ changes than anyone who imports @A@ should be recompiled in case they use @B.f@ (they'll get an early exit if they don't). So, if anything about @B.f@ changes we'd better make sure that something in A.hi changes, and the convenient way to do that is to record the version number @B.f@ in A.hi in the usage list. If B.f changes that'll force a complete recompiation of A, which is overkill but it's the only way to write a new, slightly different, A.hi. But the example is tricker. Even if @B.f@ doesn't change at all, @B.h@ may do so, and this change may not be reflected in @f@'s version number. But with -O, a module that imports A must be recompiled if @B.h@ changes! So A must record a dependency on @B.h@. So we treat the occurrence of @B.f@ in the export list *just as if* it were in the code of A, and thereby haul in all the stuff reachable from it. *** Conclusion: if A mentions B.f in its export list, behave just as if A mentioned B.f in its source code, and slurp in B.f and all its transitive closure *** [NB: If B was compiled with -O, but A isn't, we should really *still* haul in all the unfoldings for B, in case the module that imports A *is* compiled with -O. I think this is the case.] \begin{code} #include "HsVersions.h" import HsSyn  simonmar committed Nov 26, 2004 177 import Packages ( isHomeModule )  simonpj committed Oct 09, 2003 178 179 180 import IfaceSyn ( IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), IfaceRule(..), IfaceInst(..), IfaceExtName(..), IfaceTyCon(..), eqIfDecl, eqIfRule, eqIfInst, IfaceEq(..), (&&&), bool,  simonpj committed Mar 17, 2004 181  eqMaybeBy, eqListBy, visibleIfConDecls,  simonpj committed Oct 09, 2003 182 183 184 185  tyThingToIfaceDecl, dfunToIfaceInst, coreRuleToIfaceRule ) import LoadIface ( readIface, loadInterface, ifaceInstGates ) import BasicTypes ( Version, initialVersion, bumpVersion ) import TcRnMonad  simonpj committed Nov 29, 2004 186 import TcRnTypes ( mkModDeps )  simonpj committed Feb 25, 2004 187 import TcType ( isFFITy )  simonmar committed Nov 26, 2004 188 import HscTypes ( ModIface(..), TyThing(..), IfacePackage(..),  simonpj committed Oct 09, 2003 189  ModGuts(..), ModGuts, IfaceExport,  simonmar committed Nov 26, 2004 190  GhciMode(..), HscEnv(..), hscEPS,  simonpj committed Oct 09, 2003 191 192 193  Dependencies(..), FixItem(..), mkIfaceDepCache, mkIfaceFixCache, mkIfaceVerCache, typeEnvElts,  simonpj committed Sep 30, 2004 194  GenAvailInfo(..), availName,  simonpj committed Oct 09, 2003 195 196 197  ExternalPackageState(..), Usage(..), IsBootInterface, Deprecs(..), IfaceDeprecs, Deprecations,  simonmar committed Nov 26, 2004 198  lookupIfaceByModule  simonpj committed Oct 09, 2003 199 200 201 202  ) import CmdLineOpts  simonmar committed Nov 26, 2004 203 204 205 import Name ( Name, nameModule, nameOccName, nameParent, isExternalName, nameParent_maybe, isWiredInName, NamedThing(..) )  simonpj committed Oct 09, 2003 206 207 import NameEnv import NameSet  simonmar committed Nov 26, 2004 208 209 import OccName ( OccName, OccEnv, mkOccEnv, lookupOccEnv, emptyOccEnv, extendOccEnv_C,  simonpj committed Oct 09, 2003 210 211  OccSet, emptyOccSet, elemOccSet, occSetElts, extendOccSet, extendOccSetList,  simonpj committed Jan 05, 2004 212 213  isEmptyOccSet, intersectOccSet, intersectsOccSet, occNameFS, isTcOcc )  simonpj committed Sep 30, 2004 214 import TyCon ( tyConDataCons, isNewTyCon, newTyConRep )  simonpj committed Jan 12, 2004 215 import Class ( classSelIds )  simonpj committed Feb 25, 2004 216 import DataCon ( dataConName, dataConFieldLabels )  simonmar committed Nov 26, 2004 217 218 import Module ( Module, moduleFS, ModLocation(..), mkSysModuleFS, moduleUserString,  simonpj committed Oct 09, 2003 219  ModuleEnv, emptyModuleEnv, lookupModuleEnv,  simonmar committed Nov 26, 2004 220  extendModuleEnv_C  simonpj committed Oct 09, 2003 221 222 223  ) import Outputable import DriverUtil ( createDirectoryHierarchy, directoryOf )  simonpj committed Aug 17, 2004 224 import Util ( sortLe, seqList )  simonpj committed Oct 09, 2003 225 import Binary ( getBinFileWithDict )  simonmar committed Nov 10, 2003 226 import BinIface ( writeBinIface, v_IgnoreHiWay )  simonpj committed Oct 09, 2003 227 228 229 import Unique ( Unique, Uniquable(..) ) import ErrUtils ( dumpIfSet_dyn, showPass ) import Digraph ( stronglyConnComp, SCC(..) )  simonpj committed Oct 20, 2004 230 import SrcLoc ( SrcSpan )  simonpj committed Oct 09, 2003 231 232 233 234 235 import FiniteMap import FastString import DATA_IOREF ( writeIORef ) import Monad ( when )  simonpj committed Jan 05, 2004 236 import List ( insert )  simonpj committed Oct 09, 2003 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 import Maybes ( orElse, mapCatMaybes, isNothing, fromJust, expectJust ) \end{code} %************************************************************************ %* * \subsection{Completing an interface} %* * %************************************************************************ \begin{code} mkIface :: HscEnv -> ModLocation -> Maybe ModIface -- The old interface, if we have it -> ModGuts -- The compiled, tidied module -> IO ModIface -- The new one, complete with decls and versions -- mkFinalIface -- a) completes the interface -- b) writes it out to a file if necessary mkIface hsc_env location maybe_old_iface guts@ModGuts{ mg_module = this_mod, mg_usages = usages, mg_deps = deps, mg_exports = exports, mg_fix_env = fix_env, mg_deprecs = src_deprecs, mg_insts = insts, mg_rules = rules, mg_types = type_env } = do { eps <- hscEPS hsc_env  simonmar committed Nov 26, 2004 269  ; let { ext_nm = mkExtNameFn hsc_env eps this_mod  simonpj committed Jan 12, 2004 270 271 272 273 274 275 276 277 278 279  ; local_things = [thing | thing <- typeEnvElts type_env, not (isWiredInName (getName thing)) ] -- Do not export anything about wired-in things -- (GHC knows about them already) ; abstract_tcs :: NameSet -- TyCons and Classes whose representation is not exposed ; abstract_tcs | not omit_prags = emptyNameSet -- In the -O case, nothing is abstract | otherwise = mkNameSet [ getName thing | thing <- local_things  simonpj committed Feb 25, 2004 280  , not (mustExposeThing exports thing)]  simonpj committed Jan 12, 2004 281 282 283  ; decls = [ tyThingToIfaceDecl omit_prags abstract_tcs ext_nm thing | thing <- local_things, wantDeclFor exports abstract_tcs thing ]  simonpj committed Oct 09, 2003 284 285 286 287 288 289  -- Don't put implicit Ids and class tycons in the interface file ; fixities = [(occ,fix) | FixItem occ fix _ <- nameEnvElts fix_env] ; deprecs = mkIfaceDeprec src_deprecs ; iface_rules | omit_prags = []  simonpj committed Aug 17, 2004 290  | otherwise = sortLe le_rule $ simonmar committed Nov 26, 2004 291  map (coreRuleToIfaceRule this_mod ext_nm) rules  simonpj committed Aug 17, 2004 292  ; iface_insts = sortLe le_inst (map dfunToIfaceInst insts)  simonpj committed Oct 09, 2003 293 294 295  ; intermediate_iface = ModIface { mi_module = this_mod,  simonmar committed Nov 26, 2004 296  mi_package = ThisPackage,  simonpj committed Oct 09, 2003 297 298 299  mi_boot = False, mi_deps = deps, mi_usages = usages,  simonpj committed Jan 05, 2004 300  mi_exports = mkIfaceExports exports,  simonpj committed Oct 09, 2003 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330  mi_insts = iface_insts, mi_rules = iface_rules, mi_fixities = fixities, mi_deprecs = deprecs, -- Left out deliberately: filled in by addVersionInfo mi_mod_vers = initialVersion, mi_exp_vers = initialVersion, mi_rule_vers = initialVersion, mi_orphan = False, -- Always set by addVersionInfo, but -- it's a strict field, so we can't omit it. mi_decls = deliberatelyOmitted "decls", mi_ver_fn = deliberatelyOmitted "ver_fn", -- And build the cached values mi_dep_fn = mkIfaceDepCache deprecs, mi_fix_fn = mkIfaceFixCache fixities } -- Add version information ; (new_iface, no_change_at_all, pp_diffs) = _scc_ "versioninfo" addVersionInfo maybe_old_iface intermediate_iface decls } -- Write the interface file, if necessary ; when (not no_change_at_all && ghci_mode /= Interactive)$ do createDirectoryHierarchy (directoryOf hi_file_path) writeBinIface hi_file_path new_iface -- Debug printing  simonpj committed Oct 29, 2003 331  ; when (dopt Opt_D_dump_hi_diffs dflags) (printDump pp_diffs)  simonpj committed Oct 09, 2003 332 333 334 335 336  ; dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE" (pprModIface new_iface) ; return new_iface } where  simonpj committed Aug 17, 2004 337 338  r1 le_rule r2 = ifRuleName r1 <= ifRuleName r2 i1 le_inst i2 = ifDFun i1 <= ifDFun i2  simonpj committed Oct 09, 2003 339 340 341 342 343  dflags = hsc_dflags hsc_env ghci_mode = hsc_mode hsc_env hi_file_path = ml_hi_file location omit_prags = dopt Opt_OmitInterfacePragmas dflags  simonpj committed Jan 12, 2004 344 345   simonpj committed Feb 25, 2004 346 347 348 349 350 351 352 353 354 355 356 357 mustExposeThing :: NameSet -> TyThing -> Bool -- We are compiling without -O, and thus trying to write as little as -- possible into the interface file. But we must expose the details of -- any data types and classes whose constructors, fields, methods are -- visible to an importing module mustExposeThing exports (ATyCon tc) = any exported_data_con (tyConDataCons tc) -- Expose rep if any datacon or field is exported || (isNewTyCon tc && isFFITy (snd (newTyConRep tc))) -- Expose the rep for newtypes if the rep is an FFI type. -- For a very annoying reason. 'Foreign import' is meant to  simonpj committed Feb 10, 2004 358 359 360  -- be able to look through newtypes transparently, but it -- can only do that if it can "see" the newtype representation where  simonpj committed Feb 25, 2004 361  exported_data_con con  simonpj committed Sep 30, 2004 362  = any (elemNameSet exports) (dataConName con : dataConFieldLabels con)  simonpj committed Jan 12, 2004 363   simonpj committed Feb 25, 2004 364 365 366 mustExposeThing exports (AClass cls) = any exported_class_op (classSelIds cls) where -- Expose rep if any classs op is exported  simonpj committed Jan 12, 2004 367 368  exported_class_op op = getName op elemNameSet exports  simonpj committed Feb 25, 2004 369 370 mustExposeThing exports other = False  simonpj committed Jan 12, 2004 371 372 373 374 375 376 377 378 379 380 381 382  wantDeclFor :: NameSet -- User-exported things -> NameSet -- Abstract things -> TyThing -> Bool wantDeclFor exports abstracts thing | Just parent <- nameParent_maybe name -- An implicit thing = parent elemNameSet abstracts && name elemNameSet exports | otherwise = True where name = getName thing  simonpj committed Oct 09, 2003 383 384 385 386  deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x) -----------------------------  simonmar committed Nov 26, 2004 387 mkExtNameFn :: HscEnv -> ExternalPackageState -> Module -> Name -> IfaceExtName  simonpj committed Oct 09, 2003 388 389 390 mkExtNameFn hsc_env eps this_mod = ext_nm where  simonmar committed Nov 26, 2004 391  dflags = hsc_dflags hsc_env  simonpj committed Oct 09, 2003 392 393 394 395  hpt = hsc_HPT hsc_env pit = eps_PIT eps ext_nm name  simonmar committed Nov 26, 2004 396  | mod == this_mod = case nameParent_maybe name of  simonpj committed Oct 09, 2003 397 398  Nothing -> LocalTop occ Just par -> LocalTopSub occ (nameOccName par)  simonmar committed Nov 26, 2004 399 400 401  | isWiredInName name = ExtPkg mod occ | isHomeModule dflags mod = HomePkg mod occ vers | otherwise = ExtPkg mod occ  simonpj committed Oct 09, 2003 402 403 404 405 406  where mod = nameModule name occ = nameOccName name par_occ = nameOccName (nameParent name) -- The version of the *parent* is the one want  simonmar committed Nov 26, 2004 407  vers = lookupVersion mod par_occ  simonpj committed Oct 09, 2003 408   simonmar committed Nov 26, 2004 409  lookupVersion :: Module -> OccName -> Version  simonpj committed Oct 09, 2003 410 411 412 413 414 415  -- Even though we're looking up a home-package thing, in -- one-shot mode the imported interfaces may be in the PIT lookupVersion mod occ = mi_ver_fn iface occ orElse pprPanic "lookupVers1" (ppr mod <+> ppr occ) where  simonmar committed Nov 26, 2004 416  iface = lookupIfaceByModule hpt pit mod orElse  simonpj committed Oct 09, 2003 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434  pprPanic "lookupVers2" (ppr mod <+> ppr occ) ----------------------------- -- Compute version numbers for local decls addVersionInfo :: Maybe ModIface -- The old interface, read from M.hi -> ModIface -- The new interface decls (lacking decls) -> [IfaceDecl] -- The new decls -> (ModIface, Bool, -- True <=> no changes at all; no need to write new Iface SDoc) -- Differences addVersionInfo Nothing new_iface new_decls -- No old interface, so definitely write a new one! = (new_iface { mi_orphan = anyNothing getInstKey (mi_insts new_iface) || anyNothing getRuleKey (mi_rules new_iface), mi_decls = [(initialVersion, decl) | decl <- new_decls], mi_ver_fn = \n -> Just initialVersion },  simonpj committed Oct 29, 2003 435 436 437 438 439  False, ptext SLIT("No old interface file") $$pprOrphans orph_insts orph_rules) where orph_insts = filter (isNothing . getInstKey) (mi_insts new_iface) orph_rules = filter (isNothing . getRuleKey) (mi_rules new_iface)  simonpj committed Oct 09, 2003 440 441 442 443 444 445 446 447 448 449  addVersionInfo (Just old_iface@(ModIface { mi_mod_vers = old_mod_vers, mi_exp_vers = old_exp_vers, mi_rule_vers = old_rule_vers, mi_decls = old_decls, mi_ver_fn = old_decl_vers, mi_fix_fn = old_fixities })) new_iface@(ModIface { mi_fix_fn = new_fixities }) new_decls  simonpj committed Oct 29, 2003 450 451 452 453  | no_change_at_all = (old_iface, True, ptext SLIT("Interface file unchanged")$$ pp_orphs) | otherwise = (final_iface, False, vcat [ptext SLIT("Interface file has changed"), nest 2 pp_diffs, text "" $$pp_orphs])  simonpj committed Oct 09, 2003 454 455 456 457 458 459 460 461 462 463 464 465  where final_iface = new_iface { mi_mod_vers = bump_unless no_output_change old_mod_vers, mi_exp_vers = bump_unless no_export_change old_exp_vers, mi_rule_vers = bump_unless no_rule_change old_rule_vers, mi_orphan = not (null new_orph_rules && null new_orph_insts), mi_decls = decls_w_vers, mi_ver_fn = mkIfaceVerCache decls_w_vers } decls_w_vers = [(add_vers decl, decl) | decl <- new_decls] ------------------- (old_non_orph_insts, old_orph_insts) = mkRuleMap getInstKey (mi_insts old_iface)  simonpj committed Oct 29, 2003 466  (new_non_orph_insts, new_orph_insts) = mkRuleMap getInstKey (mi_insts new_iface)  simonpj committed Oct 09, 2003 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486  same_insts occ = eqMaybeBy (eqListBy eqIfInst) (lookupOccEnv old_non_orph_insts occ) (lookupOccEnv new_non_orph_insts occ) (old_non_orph_rules, old_orph_rules) = mkRuleMap getRuleKey (mi_rules old_iface) (new_non_orph_rules, new_orph_rules) = mkRuleMap getRuleKey (mi_rules new_iface) same_rules occ = eqMaybeBy (eqListBy eqIfRule) (lookupOccEnv old_non_orph_rules occ) (lookupOccEnv new_non_orph_rules occ) ------------------- -- Computing what changed no_output_change = no_decl_change && no_rule_change && no_export_change && no_deprec_change no_export_change = mi_exports new_iface == mi_exports old_iface -- Kept sorted no_decl_change = isEmptyOccSet changed_occs no_rule_change = not (changedWrt changed_occs (eqListBy eqIfRule old_orph_rules new_orph_rules) || changedWrt changed_occs (eqListBy eqIfInst old_orph_insts new_orph_insts)) no_deprec_change = mi_deprecs new_iface == mi_deprecs old_iface -- If the usages havn't changed either, we don't need to write the interface file  simonpj committed Oct 01, 2004 487 488  no_other_changes = mi_usages new_iface == mi_usages old_iface && mi_deps new_iface == mi_deps old_iface  simonpj committed Oct 09, 2003 489 490  no_change_at_all = no_output_change && no_other_changes  simonpj committed Oct 29, 2003 491  pp_diffs = vcat [pp_change no_export_change "Export list"  simonpj committed Oct 09, 2003 492 493 494 495  (ppr old_exp_vers <+> arrow <+> ppr (mi_exp_vers final_iface)), pp_change no_rule_change "Rules" (ppr old_rule_vers <+> arrow <+> ppr (mi_rule_vers final_iface)), pp_change no_deprec_change "Deprecations" empty,  simonpj committed Oct 29, 2003 496 497  pp_change no_other_changes "Usages" empty, pp_decl_diffs]  simonpj committed Oct 09, 2003 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536  pp_change True what info = empty pp_change False what info = text what <+> ptext SLIT("changed") <+> info ------------------- old_decl_env = mkOccEnv [(ifName decl, decl) | (_,decl) <- old_decls] same_fixity n = bool (old_fixities n == new_fixities n) ------------------- -- Adding version info new_version = bumpVersion old_mod_vers add_vers decl | occ elemOccSet changed_occs = new_version | otherwise = expectJust "add_vers" (old_decl_vers occ) -- If it's unchanged, there jolly well where -- should be an old version number occ = ifName decl ------------------- changed_occs :: OccSet changed_occs = computeChangedOccs eq_info eq_info :: [(OccName, IfaceEq)] eq_info = map check_eq new_decls check_eq new_decl | Just old_decl <- lookupOccEnv old_decl_env occ = (occ, new_decl eqIfDecl old_decl &&& eq_indirects new_decl) | otherwise {- No corresponding old decl -} = (occ, NotEqual) where occ = ifName new_decl eq_indirects :: IfaceDecl -> IfaceEq -- When seeing if two decls are the same, remember to -- check whether any relevant fixity or rules have changed eq_indirects (IfaceId {ifName = occ}) = eq_ind_occ occ eq_indirects (IfaceClass {ifName = cls_occ, ifSigs = sigs}) = same_insts cls_occ &&& eq_ind_occs [op | IfaceClassOp op _ _ <- sigs] eq_indirects (IfaceData {ifName = tc_occ, ifCons = cons}) = same_insts tc_occ &&& same_fixity tc_occ &&& -- The TyCon can have a fixity too  simonpj committed Sep 30, 2004 537  eq_ind_occs (map ifConOcc (visibleIfConDecls cons))  simonpj committed Oct 09, 2003 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573  eq_indirects other = Equal -- Synonyms and foreign declarations eq_ind_occ :: OccName -> IfaceEq -- For class ops and Ids; check fixity and rules eq_ind_occ occ = same_fixity occ &&& same_rules occ eq_ind_occs = foldr ((&&&) . eq_ind_occ) Equal ------------------- -- Diffs pp_decl_diffs :: SDoc -- Nothing => no changes pp_decl_diffs | isEmptyOccSet changed_occs = empty | otherwise = vcat [ptext SLIT("Changed occs:") <+> ppr (occSetElts changed_occs), ptext SLIT("Version change for these decls:"), nest 2 (vcat (map show_change new_decls))] eq_env = mkOccEnv eq_info show_change new_decl | not (occ elemOccSet changed_occs) = empty | otherwise = vcat [ppr occ <+> ppr (old_decl_vers occ) <+> arrow <+> ppr new_version, nest 2 why] where occ = ifName new_decl why = case lookupOccEnv eq_env occ of Just (EqBut occs) -> sep [ppr occ <> colon, ptext SLIT("Free vars (only) changed:"), nest 2 (braces (fsep (map ppr (occSetElts (occs intersectOccSet changed_occs)))))] Just NotEqual | Just old_decl <- lookupOccEnv old_decl_env occ -> vcat [ptext SLIT("Old:") <+> ppr old_decl, ptext SLIT("New:") <+> ppr new_decl] | otherwise -> ppr occ <+> ptext SLIT("only in new interface") other -> pprPanic "MkIface.show_change" (ppr occ)  simonpj committed Oct 29, 2003 574 575 576 577 578 579 580  pp_orphs = pprOrphans new_orph_insts new_orph_rules pprOrphans insts rules = vcat [if null insts then empty else ptext SLIT("Orphan instances:") <+> vcat (map ppr insts), if null rules then empty else ptext SLIT("Orphan rules:") <+> vcat (map ppr rules)]  simonpj committed Oct 09, 2003 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650  computeChangedOccs :: [(OccName, IfaceEq)] -> OccSet computeChangedOccs eq_info = foldl add_changes emptyOccSet (stronglyConnComp edges) where edges :: [((OccName,IfaceEq), Unique, [Unique])] edges = [ (node, getUnique occ, map getUnique occs) | node@(occ, iface_eq) <- eq_info , let occs = case iface_eq of EqBut occ_set -> occSetElts occ_set other -> [] ] -- Changes in declarations add_changes :: OccSet -> SCC (OccName, IfaceEq) -> OccSet add_changes so_far (AcyclicSCC (occ, iface_eq)) | changedWrt so_far iface_eq -- This one has changed = extendOccSet so_far occ add_changes so_far (CyclicSCC pairs) | changedWrt so_far (foldr1 (&&&) (map snd pairs)) -- One of this group has changed = extendOccSetList so_far (map fst pairs) add_changes so_far other = so_far changedWrt :: OccSet -> IfaceEq -> Bool changedWrt so_far Equal = False changedWrt so_far NotEqual = True changedWrt so_far (EqBut kids) = so_far intersectsOccSet kids ---------------------- -- mkRuleMap partitions instance decls or rules into -- (a) an OccEnv for ones that are not orphans, -- mapping the local OccName to a list of its decls -- (b) a list of orphan decls mkRuleMap :: (decl -> Maybe OccName) -- (Just occ) for a non-orphan decl, keyed by occ -- Nothing for an orphan decl -> [decl] -- Sorted into canonical order -> (OccEnv [decl], -- Non-orphan decls associated with their key; -- each sublist in canonical order [decl]) -- Orphan decls; in canonical order mkRuleMap get_key decls = foldl go (emptyOccEnv, []) decls where go (non_orphs, orphs) d | Just occ <- get_key d = (extendOccEnv_C (\ ds _ -> d:ds) non_orphs occ [d], orphs) | otherwise = (non_orphs, d:orphs) -- getXxKey: find at least one local OccName that belongs to this decl getInstKey :: IfaceInst -> Maybe OccName getInstKey (IfaceInst {ifInstHead = inst_ty}) = case [occ | LocalTop occ <- cls_ext : tc_exts] of [] -> Nothing (occ:_) -> Just occ where (cls_ext, tcs) = ifaceInstGates inst_ty tc_exts = [tc | IfaceTc tc <- tcs] -- Ignore the wired-in IfaceTyCons; the class will do as the key getRuleKey :: IfaceRule -> Maybe OccName getRuleKey (IfaceRule {ifRuleHead = LocalTop occ}) = Just occ getRuleKey other = Nothing anyNothing :: (a -> Maybe b) -> [a] -> Bool anyNothing p [] = False anyNothing p (x:xs) = isNothing (p x) || anyNothing p xs ---------------------- mkIfaceDeprec :: Deprecations -> IfaceDeprecs mkIfaceDeprec NoDeprecs = NoDeprecs mkIfaceDeprec (DeprecAll t) = DeprecAll t  simonpj committed Aug 17, 2004 651 mkIfaceDeprec (DeprecSome env) = DeprecSome (sortLe (<=) (nameEnvElts env))  simonpj committed Oct 09, 2003 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667  ---------------------- bump_unless :: Bool -> Version -> Version bump_unless True v = v -- True <=> no change bump_unless False v = bumpVersion v \end{code} %********************************************************* %* * \subsection{Keeping track of what we've slurped, and version numbers} %* * %********************************************************* \begin{code}  simonpj committed Oct 20, 2004 668 669 mkUsageInfo :: HscEnv -> ModuleEnv (Module, Maybe Bool, SrcSpan)  simonmar committed Nov 26, 2004 670  -> [(Module, IsBootInterface)]  simonpj committed Oct 20, 2004 671 672  -> NameSet -> IO [Usage] mkUsageInfo hsc_env dir_imp_mods dep_mods used_names  simonpj committed Oct 09, 2003 673  = do { eps <- hscEPS hsc_env  simonmar committed Nov 26, 2004 674  ; let usages = mk_usage_info (eps_PIT eps) hsc_env  simonpj committed Oct 20, 2004 675 676 677 678 679  dir_imp_mods dep_mods used_names ; usages seqList return usages } -- seq the list of Usages returned: occasionally these -- don't get evaluated for a while and we can end up hanging on to -- the entire collection of Ifaces.  simonpj committed Oct 09, 2003 680   simonmar committed Nov 26, 2004 681 mk_usage_info pit hsc_env dir_imp_mods dep_mods proto_used_names  simonpj committed Oct 20, 2004 682 683  = mapCatMaybes mkUsage dep_mods -- ToDo: do we need to sort into canonical order?  simonpj committed Oct 09, 2003 684  where  simonmar committed Nov 26, 2004 685 686 687  dflags = hsc_dflags hsc_env hpt = hsc_HPT hsc_env  simonpj committed Oct 09, 2003 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705  used_names = mkNameSet  -- Eliminate duplicates [ nameParent n -- Just record usage on the 'main' names | n <- nameSetToList proto_used_names , not (isWiredInName n) -- Don't record usages for wired-in names , isExternalName n -- Ignore internal names ] -- ent_map groups together all the things imported and used -- from a particular module in this package ent_map :: ModuleEnv [OccName] ent_map = foldNameSet add_mv emptyModuleEnv used_names add_mv name mv_map = extendModuleEnv_C add_item mv_map mod [occ] where occ = nameOccName name mod = nameModule name add_item occs _ = occ:occs import_all mod = case lookupModuleEnv dir_imp_mods mod of  simonpj committed May 25, 2004 706 707  Just (_,imp_all,_) -> isNothing imp_all Nothing -> False  simonpj committed Oct 09, 2003 708 709 710 711 712 713 714  -- We want to create a Usage for a home module if -- a) we used something from; has something in used_names -- b) we imported all of it, even if we used nothing from it -- (need to recompile if its export list changes: export_vers) -- c) is a home-package orphan module (need to recompile if its -- instance decls change: rules_vers)  simonmar committed Nov 26, 2004 715  mkUsage :: (Module, Bool) -> Maybe Usage  simonpj committed Oct 09, 2003 716 717  mkUsage (mod_name, _) | isNothing maybe_iface -- We can't depend on it if we didn't  simonmar committed Nov 26, 2004 718  || not (isHomeModule dflags mod) -- even open the interface!  simonpj committed Oct 09, 2003 719 720 721 722 723 724  || (null used_occs && not all_imported && not orphan_mod) = Nothing -- Record no usage info | otherwise  simonmar committed Nov 26, 2004 725  = Just (Usage { usg_name = mod,  simonpj committed Oct 09, 2003 726 727 728 729 730  usg_mod = mod_vers, usg_exports = export_vers, usg_entities = ent_vers, usg_rules = rules_vers }) where  simonmar committed Nov 26, 2004 731  maybe_iface = lookupIfaceByModule hpt pit mod_name  simonpj committed Oct 09, 2003 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748  -- In one-shot mode, the interfaces for home-package -- modules accumulate in the PIT not HPT. Sigh. Just iface = maybe_iface mod = mi_module iface orphan_mod = mi_orphan iface version_env = mi_ver_fn iface mod_vers = mi_mod_vers iface rules_vers = mi_rule_vers iface all_imported = import_all mod export_vers | all_imported = Just (mi_exp_vers iface) | otherwise = Nothing -- The sort is to put them into canonical order used_occs = lookupModuleEnv ent_map mod orElse [] ent_vers :: [(OccName,Version)] ent_vers = [ (occ, version_env occ orElse initialVersion)  simonpj committed Aug 17, 2004 749  | occ <- sortLe (<=) used_occs]  simonpj committed Oct 09, 2003 750 751 752 \end{code} \begin{code}  simonmar committed Nov 26, 2004 753 mkIfaceExports :: NameSet -> [(Module, [GenAvailInfo OccName])]  simonpj committed Oct 09, 2003 754 755  -- Group by module and sort by occurrence -- This keeps the list in canonical order  simonpj committed Jan 12, 2004 756 mkIfaceExports exports  simonmar committed Nov 26, 2004 757  = [ (mkSysModuleFS fs, eltsFM avails)  simonpj committed Jan 05, 2004 758  | (fs, avails) <- fmToList groupFM  simonpj committed Oct 09, 2003 759 760  ] where  simonpj committed Jan 05, 2004 761  groupFM :: FiniteMap FastString (FiniteMap FastString (GenAvailInfo OccName))  simonpj committed Oct 09, 2003 762 763  -- Deliberately use the FastString so we -- get a canonical ordering  simonpj committed Jan 05, 2004 764 765 766 767 768 769  groupFM = foldl add emptyFM (nameSetToList exports) add env name = addToFM_C add_avail env mod_fs (unitFM avail_fs avail) where occ = nameOccName name  simonmar committed Nov 26, 2004 770  mod_fs = moduleFS (nameModule name)  simonpj committed Jan 12, 2004 771  avail | Just p <- nameParent_maybe name = AvailTC (nameOccName p) [occ]  simonpj committed Jan 05, 2004 772 773 774 775 776 777 778  | isTcOcc occ = AvailTC occ [occ] | otherwise = Avail occ avail_fs = occNameFS (availName avail) add_avail avail_fm _ = addToFM_C add_item avail_fm avail_fs avail add_item (AvailTC p occs) _ = AvailTC p (insert occ occs) add_item (Avail n) _ = pprPanic "MkIface.addAvail" (ppr n <+> ppr name)  simonpj committed Oct 09, 2003 779 780 \end{code}  simonpj committed Jan 05, 2004 781   simonpj committed Oct 09, 2003 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 %************************************************************************ %* * Load the old interface file for this module (unless we have it aleady), and check whether it is up to date %* * %************************************************************************ \begin{code} checkOldIface :: HscEnv -> Module -> FilePath -- Where the interface file is -> Bool -- Source unchanged -> Maybe ModIface -- Old interface from compilation manager, if any -> IO (RecompileRequired, Maybe ModIface) checkOldIface hsc_env mod iface_path source_unchanged maybe_iface = do { showPass (hsc_dflags hsc_env) ("Checking old interface for " ++ moduleUserString mod) ;  simonpj committed Oct 13, 2003 802  ; initIfaceCheck hsc_env   simonpj committed Oct 09, 2003 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827  check_old_iface mod iface_path source_unchanged maybe_iface } check_old_iface this_mod iface_path source_unchanged maybe_iface = -- CHECK WHETHER THE SOURCE HAS CHANGED ifM (not source_unchanged) (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off"))) thenM_ -- If the source has changed and we're in interactive mode, avoid reading -- an interface; just return the one we might have been supplied with. getGhciMode thenM \ ghci_mode -> if (ghci_mode == Interactive) && not source_unchanged then returnM (outOfDate, maybe_iface) else case maybe_iface of { Just old_iface -> -- Use the one we already have checkVersions source_unchanged old_iface thenM \ recomp -> returnM (recomp, Just old_iface) ; Nothing -> -- Try and read the old interface for the current module -- from the .hi file left from the last time we compiled it  simonmar committed Nov 26, 2004 828  readIface this_mod iface_path False thenM \ read_result ->  simonpj committed Oct 09, 2003 829 830  case read_result of { Left err -> -- Old interface file not found, or garbled; give up  simonpj committed Oct 29, 2003 831  traceIf (text "FYI: cannot read old interface file:"  simonpj committed Oct 09, 2003 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 $$ nest 4 err) thenM_ returnM (outOfDate, Nothing) ; Right iface -> -- We have got the old iface; check its versions checkVersions source_unchanged iface thenM \ recomp -> returnM (recomp, Just iface) }} \end{code} @recompileRequired@ is called from the HscMain. It checks whether a recompilation is required. It needs access to the persistent state, finder, etc, because it may have to load lots of interface files to check their versions. \begin{code} type RecompileRequired = Bool upToDate = False -- Recompile not required outOfDate = True -- Recompile required checkVersions :: Bool -- True <=> source unchanged -> ModIface -- Old interface -> IfG RecompileRequired checkVersions source_unchanged iface | not source_unchanged = returnM outOfDate | otherwise  simonpj committed Aug 16, 2004 860 861  = do { traceHiDiffs (text "Considering whether compilation is required for" <+> ppr (mi_module iface) <> colon)  simonpj committed Oct 09, 2003 862 863  -- Source code unchanged and no errors yet... carry on  simonpj committed Aug 16, 2004 864   simonpj committed Oct 07, 2004 865  -- First put the dependent-module info, read from the old interface, into the envt,  simonpj committed Oct 09, 2003 866  -- so that when we look for interfaces we look for the right one (.hi or .hi-boot)  simonpj committed Oct 07, 2004 867  --  simonpj committed Oct 09, 2003 868 869 870  -- It's just temporary because either the usage check will succeed -- (in which case we are done with this module) or it'll fail (in which -- case we'll compile the module from scratch anyhow).  simonpj committed Oct 07, 2004 871 872 873  -- -- We do this regardless of compilation mode ; updateEps_ \$ \eps -> eps { eps_is_boot = mod_deps }  simonpj committed Aug 16, 2004 874 875 876  ; checkList [checkModUsage u | u <- mi_usages iface] }  simonpj committed Oct 09, 2003 877 878  where -- This is a bit of a hack really  simonmar committed Nov 26, 2004 879  mod_deps :: ModuleEnv (Module, IsBootInterface)  simonpj committed Oct 09, 2003 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995  mod_deps = mkModDeps (dep_mods (mi_deps iface)) checkModUsage :: Usage -> IfG RecompileRequired -- Given the usage information extracted from the old -- M.hi file for the module being compiled, figure out -- whether M needs to be recompiled. checkModUsage (Usage { usg_name = mod_name, usg_mod = old_mod_vers, usg_rules = old_rule_vers, usg_exports = maybe_old_export_vers, usg_entities = old_decl_vers }) = -- Load the imported interface is possible let doc_str = sep [ptext SLIT("need version info for"), ppr mod_name] in traceHiDiffs (text "Checking usages for module" <+> ppr mod_name) thenM_ loadInterface doc_str mod_name ImportBySystem thenM \ mb_iface -> -- Load the interface, but don't complain on failure; -- Instead, get an Either back which we can test case mb_iface of { Left exn -> (out_of_date (sep [ptext SLIT("Can't find version number for module"), ppr mod_name])); -- Couldn't find or parse a module mentioned in the -- old interface file. Don't complain -- it might just be that -- the current module doesn't need that import and it's been deleted Right iface -> let new_mod_vers = mi_mod_vers iface new_decl_vers = mi_ver_fn iface new_export_vers = mi_exp_vers iface new_rule_vers = mi_rule_vers iface in -- CHECK MODULE checkModuleVersion old_mod_vers new_mod_vers thenM \ recompile -> if not recompile then returnM upToDate else -- CHECK EXPORT LIST if checkExportList maybe_old_export_vers new_export_vers then out_of_date_vers (ptext SLIT(" Export list changed")) (fromJust maybe_old_export_vers) new_export_vers else -- CHECK RULES if old_rule_vers /= new_rule_vers then out_of_date_vers (ptext SLIT(" Rules changed")) old_rule_vers new_rule_vers else -- CHECK ITEMS ONE BY ONE checkList [checkEntityUsage new_decl_vers u | u <- old_decl_vers] thenM \ recompile -> if recompile then returnM outOfDate -- This one failed, so just bail out now else up_to_date (ptext SLIT(" Great! The bits I use are up to date")) } ------------------------ checkModuleVersion old_mod_vers new_mod_vers | new_mod_vers == old_mod_vers = up_to_date (ptext SLIT("Module version unchanged")) | otherwise = out_of_date_vers (ptext SLIT(" Module version has changed")) old_mod_vers new_mod_vers ------------------------ checkExportList Nothing new_vers = upToDate checkExportList (Just v) new_vers = v /= new_vers ------------------------ checkEntityUsage new_vers (name,old_vers) = case new_vers name of Nothing -> -- We used it before, but it ain't there now out_of_date (sep [ptext SLIT("No longer exported:"), ppr name]) Just new_vers -- It's there, but is it up to date? | new_vers == old_vers -> traceHiDiffs (text " Up to date" <+> ppr name <+> parens (ppr new_vers)) thenM_ returnM upToDate | otherwise -> out_of_date_vers (ptext SLIT(" Out of date:") <+> ppr name) old_vers new_vers up_to_date msg = traceHiDiffs msg thenM_ returnM upToDate out_of_date msg = traceHiDiffs msg thenM_ returnM outOfDate out_of_date_vers msg old_vers new_vers = out_of_date (hsep [msg, ppr old_vers, ptext SLIT("->"), ppr new_vers]) ---------------------- checkList :: [IfG RecompileRequired] -> IfG RecompileRequired -- This helper is used in two places checkList [] = returnM upToDate checkList (check:checks) = check thenM \ recompile -> if recompile then returnM outOfDate else checkList checks \end{code} %************************************************************************ %* * Printing interfaces %* * %************************************************************************ \begin{code} showIface :: FilePath -> IO () -- Raad binary interface, and print it out showIface filename = do -- skip the version check; we don't want to worry about profiled vs. -- non-profiled interfaces, for example.  simonmar committed Nov 10, 2003 996  writeIORef v_IgnoreHiWay True  simonpj committed Oct 09, 2003 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007  iface <- Binary.getBinFileWithDict filename printDump (pprModIface iface) where \end{code} \begin{code} pprModIface :: ModIface -> SDoc -- Show a ModIface pprModIface iface = vcat [ ptext SLIT("interface")  simonmar committed Nov 26, 2004 1008  <+> ppr_package (mi_package iface)  simonpj committed Oct 09, 2003 1009 1010  <+> ppr (mi_module iface) <+> ppr (mi_mod_vers iface) <+> pp_sub_vers  simonpj committed Oct 29, 2003 1011  <+> (if mi_orphan iface then ptext SLIT("[orphan module]") else empty)  simonpj committed Oct 09, 2003 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023  <+> int opt_HiVersion <+> ptext SLIT("where") , vcat (map pprExport (mi_exports iface)) , pprDeps (mi_deps iface) , vcat (map pprUsage (mi_usages iface)) , pprFixities (mi_fixities iface) , vcat (map pprIfaceDecl (mi_decls iface)) , vcat (map ppr (mi_insts iface)) , vcat (map ppr (mi_rules iface)) , pprDeprecs (mi_deprecs iface) ] where  simonmar committed Nov 26, 2004 1024 1025 1026  ppr_package ThisPackage = empty ppr_package (ExternalPackage id) = doubleQuotes (ftext id)  simonpj committed Oct 09, 2003 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096  exp_vers = mi_exp_vers iface rule_vers = mi_rule_vers iface pp_sub_vers | exp_vers == initialVersion && rule_vers == initialVersion = empty | otherwise = brackets (ppr exp_vers <+> ppr rule_vers) \end{code} When printing export lists, we print like this: Avail f f AvailTC C [C, x, y] C(x,y) AvailTC C [x, y] C!(x,y) -- Exporting x, y but not C \begin{code} pprExport :: IfaceExport -> SDoc pprExport (mod, items) = hsep [ ptext SLIT("export"), ppr mod, hsep (map pp_avail items) ] where pp_avail :: GenAvailInfo OccName -> SDoc pp_avail (Avail occ) = ppr occ pp_avail (AvailTC _ []) = empty pp_avail (AvailTC n (n':ns)) | n==n' = ppr n <> pp_export ns | otherwise = ppr n <> char '|' <> pp_export (n':ns) pp_export [] = empty pp_export names = braces (hsep (map ppr names)) pprUsage :: Usage -> SDoc pprUsage usage = hsep [ptext SLIT("import"), ppr (usg_name usage), int (usg_mod usage), pp_export_version (usg_exports usage), int (usg_rules usage), pp_versions (usg_entities usage) ] where pp_versions nvs = hsep [ ppr n <+> int v | (n,v) <- nvs ] pp_export_version Nothing = empty pp_export_version (Just v) = int v pprDeps :: Dependencies -> SDoc pprDeps (Deps { dep_mods = mods, dep_pkgs = pkgs, dep_orphs = orphs}) = vcat [ptext SLIT("module dependencies:") <+> fsep (map ppr_mod mods), ptext SLIT("package dependencies:") <+> fsep (map ppr pkgs), ptext SLIT("orphans:") <+> fsep (map ppr orphs) ] where ppr_mod (mod_name, boot) = ppr mod_name <+> ppr_boot boot ppr_boot True = text "[boot]" ppr_boot False = empty pprIfaceDecl :: (Version, IfaceDecl) -> SDoc pprIfaceDecl (ver, decl) = ppr_vers ver <+> ppr decl where -- Print the version for the decl ppr_vers v | v == initialVersion = empty | otherwise = int v pprFixities :: [(OccName, Fixity)] -> SDoc pprFixities [] = empty pprFixities fixes = ptext SLIT("fixities") <+> pprWithCommas pprFix fixes where pprFix (occ,fix) = ppr fix <+> ppr occ pprDeprecs NoDeprecs = empty pprDeprecs (DeprecAll txt) = ptext SLIT("Deprecate all") <+> doubleQuotes (ftext txt) pprDeprecs (DeprecSome prs) = ptext SLIT("Deprecate") <+> vcat (map pprDeprec prs) where pprDeprec (name, txt) = ppr name <+> doubleQuotes (ftext txt) \end{code}