compiler/iface/MkIface.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
   3 %
   4
   5 \begin{code}
   6 module MkIface (
   7         mkUsageInfo,    -- Construct the usage info for a module
   8
   9         mkIface,        -- Build a ModIface from a ModGuts,
  10                         -- including computing version information
  11
  12         writeIfaceFile, -- Write the interface file
  13
  14         checkOldIface,  -- See if recompilation is required, by
  15                         -- comparing version information
  16
  17         tyThingToIfaceDecl -- Converting things to their Iface equivalents
  18  ) where
  19 \end{code}
  20
  21         -----------------------------------------------
  22                 MkIface.lhs deals with versioning
  23         -----------------------------------------------
  24
  25 Here's the version-related info in an interface file
  26
  27   module Foo 8          -- module-version
  28              3          -- export-list-version
  29              2          -- rule-version
  30     Usages:     -- Version info for what this compilation of Foo imported
  31         Baz 3           -- Module version
  32             [4]         -- The export-list version if Foo depended on it
  33             (g,2)       -- Function and its version
  34             (T,1)       -- Type and its version
  35
  36     <version> f :: Int -> Int {- Unfolding: \x -> Wib.t[2] x -}
  37                 -- The [2] says that f's unfolding
  38                 -- mentions verison 2 of Wib.t
  39
  40         -----------------------------------------------
  41                         Basic idea
  42         -----------------------------------------------
  43
  44 Basic idea:
  45   * In the mi_usages information in an interface, we record the
  46     version number of each free variable of the module
  47
  48   * In mkIface, we compute the version number of each exported thing A.f
  49     by comparing its A.f's info with its new info, and bumping its
  50     version number if it differs.  If A.f mentions B.g, and B.g's version
  51     number has changed, then we count A.f as having changed too.
  52
  53   * In checkOldIface we compare the mi_usages for the module with
  54     the actual version info for all each thing recorded in mi_usages
  55
  56
  57 Fixities
  58 ~~~~~~~~
  59 We count A.f as changing if its fixity changes
  60
  61 Rules
  62 ~~~~~
  63 If a rule changes, we want to recompile any module that might be
  64 affected by that rule.  For non-orphan rules, this is relatively easy.
  65 If module M defines f, and a rule for f, just arrange that the version
  66 number for M.f changes if any of the rules for M.f change.  Any module
  67 that does not depend on M.f can't be affected by the rule-change
  68 either.
  69
  70 Orphan rules (ones whose 'head function' is not defined in M) are
  71 harder.  Here's what we do.
  72
  73   * We have a per-module orphan-rule version number which changes if
  74     any orphan rule changes. (It's unaffected by non-orphan rules.)
  75
  76   * We record usage info for any orphan module 'below' this one,
  77     giving the orphan-rule version number.  We recompile if this
  78     changes.
  79
  80 The net effect is that if an orphan rule changes, we recompile every
  81 module above it.  That's very conservative, but it's devilishly hard
  82 to know what it might affect, so we just have to be conservative.
  83
  84 Instance decls
  85 ~~~~~~~~~~~~~~
  86 In an iface file we have
  87      module A where
  88         instance Eq a => Eq [a]  =  dfun29
  89         dfun29 :: ...
  90
  91 We have a version number for dfun29, covering its unfolding
  92 etc. Suppose we are compiling a module M that imports A only
  93 indirectly.  If typechecking M uses this instance decl, we record the
  94 dependency on A.dfun29 as if it were a free variable of the module
  95 (via the tcg_inst_usages accumulator).  That means that A will appear
  96 in M's usage list.  If the shape of the instance declaration changes,
  97 then so will dfun29's version, triggering a recompilation.
  98
  99 Adding an instance declaration, or changing an instance decl that is
 100 not currently used, is more tricky.  (This really only makes a
 101 difference when we have overlapping instance decls, because then the
 102 new instance decl might kick in to override the old one.)  We handle
 103 this in a very similar way that we handle rules above.
 104
 105   * For non-orphan instance decls, identify one locally-defined tycon/class
 106     mentioned in the decl.  Treat the instance decl as part of the defn of that
 107     tycon/class, so that if the shape of the instance decl changes, so does the
 108     tycon/class; that in turn will force recompilation of anything that uses
 109     that tycon/class.
 110
 111   * For orphan instance decls, act the same way as for orphan rules.
 112     Indeed, we use the same global orphan-rule version number.
 113
 114 mkUsageInfo
 115 ~~~~~~~~~~~
 116 mkUsageInfo figures out what the ``usage information'' for this
 117 moudule is; that is, what it must record in its interface file as the
 118 things it uses.
 119
 120 We produce a line for every module B below the module, A, currently being
 121 compiled:
 122         import B <n> ;
 123 to record the fact that A does import B indirectly.  This is used to decide
 124 to look to look for B.hi rather than B.hi-boot when compiling a module that
 125 imports A.  This line says that A imports B, but uses nothing in it.
 126 So we'll get an early bale-out when compiling A if B's version changes.
 127
 128 The usage information records:
 129
 130 \begin{itemize}
 131 \item   (a) anything reachable from its body code
 132 \item   (b) any module exported with a @module Foo@
 133 \item   (c) anything reachable from an exported item
 134 \end{itemize}
 135
 136 Why (b)?  Because if @Foo@ changes then this module's export list
 137 will change, so we must recompile this module at least as far as
 138 making a new interface file --- but in practice that means complete
 139 recompilation.
 140
 141 Why (c)?  Consider this:
 142 \begin{verbatim}
 143         module A( f, g ) where  |       module B( f ) where
 144           import B( f )         |         f = h 3
 145           g = ...               |         h = ...
 146 \end{verbatim}
 147
 148 Here, @B.f@ isn't used in A.  Should we nevertheless record @B.f@ in
 149 @A@'s usages?  Our idea is that we aren't going to touch A.hi if it is
 150 *identical* to what it was before.  If anything about @B.f@ changes
 151 than anyone who imports @A@ should be recompiled in case they use
 152 @B.f@ (they'll get an early exit if they don't).  So, if anything
 153 about @B.f@ changes we'd better make sure that something in A.hi
 154 changes, and the convenient way to do that is to record the version
 155 number @B.f@ in A.hi in the usage list.  If B.f changes that'll force a
 156 complete recompiation of A, which is overkill but it's the only way to
 157 write a new, slightly different, A.hi.
 158
 159 But the example is tricker.  Even if @B.f@ doesn't change at all,
 160 @B.h@ may do so, and this change may not be reflected in @f@'s version
 161 number.  But with -O, a module that imports A must be recompiled if
 162 @B.h@ changes!  So A must record a dependency on @B.h@.  So we treat
 163 the occurrence of @B.f@ in the export list *just as if* it were in the
 164 code of A, and thereby haul in all the stuff reachable from it.
 165
 166         *** Conclusion: if A mentions B.f in its export list,
 167             behave just as if A mentioned B.f in its source code,
 168             and slurp in B.f and all its transitive closure ***
 169
 170 [NB: If B was compiled with -O, but A isn't, we should really *still*
 171 haul in all the unfoldings for B, in case the module that imports A *is*
 172 compiled with -O.  I think this is the case.]
 173
 174
 175 \begin{code}
 176 #include "HsVersions.h"
 177
 178 import IfaceSyn         -- All of it
 179 import IfaceType        ( toIfaceTvBndrs, toIfaceType, toIfaceContext )
 180 import LoadIface        ( readIface, loadInterface, pprModIface )
 181 import Id               ( Id, idName, idType, idInfo, idArity, isDataConWorkId_maybe, isFCallId_maybe )
 182 import IdInfo           ( IdInfo, CafInfo(..), WorkerInfo(..),
 183                           arityInfo, cafInfo, newStrictnessInfo,
 184                           workerInfo, unfoldingInfo, inlinePragInfo )
 185 import NewDemand        ( isTopSig )
 186 import CoreSyn
 187 import Class            ( classExtraBigSig, classTyCon )
 188 import TyCon            ( TyCon, AlgTyConRhs(..), SynTyConRhs(..),
 189                           isRecursiveTyCon, isForeignTyCon,
 190                           isSynTyCon, isAlgTyCon, isPrimTyCon, isFunTyCon,
 191                           isTupleTyCon, tupleTyConBoxity, tyConStupidTheta,
 192                           tyConHasGenerics, synTyConRhs, isGadtSyntaxTyCon,
 193                           tyConArity, tyConTyVars, algTyConRhs, tyConExtName,
 194                           tyConFamInst_maybe )
 195 import DataCon          ( dataConName, dataConFieldLabels, dataConStrictMarks,
 196                           dataConTyCon, dataConIsInfix, dataConUnivTyVars,
 197                           dataConExTyVars, dataConEqSpec, dataConTheta,
 198                           dataConOrigArgTys )
 199 import Type             ( TyThing(..), splitForAllTys, funResultTy )
 200 import TcType           ( deNoteType )
 201 import TysPrim          ( alphaTyVars )
 202 import InstEnv          ( Instance(..) )
 203 import TcRnMonad
 204 import HscTypes         ( ModIface(..), ModDetails(..),
 205                           ModGuts(..), HscEnv(..), hscEPS, Dependencies(..), FixItem(..),
 206                           ModSummary(..), msHiFilePath,
 207                           mkIfaceDepCache, mkIfaceFixCache, mkIfaceVerCache,
 208                           typeEnvElts,
 209                           GenAvailInfo(..), availName,
 210                           ExternalPackageState(..),
 211                           Usage(..), IsBootInterface,
 212                           Deprecs(..), IfaceDeprecs, Deprecations,
 213                           lookupIfaceByModule
 214                         )
 215
 216
 217 import DynFlags         ( GhcMode(..), DynFlags(..), DynFlag(..), dopt )
 218 import Name             ( Name, nameModule, nameOccName, nameParent,
 219                           isExternalName, isInternalName, nameParent_maybe, isWiredInName,
 220                           isImplicitName, NamedThing(..) )
 221 import NameEnv
 222 import NameSet
 223 import OccName          ( OccName, OccEnv, mkOccEnv, lookupOccEnv, emptyOccEnv,
 224                           extendOccEnv_C,
 225                           OccSet, emptyOccSet, elemOccSet, occSetElts,
 226                           extendOccSet, extendOccSetList,
 227                           isEmptyOccSet, intersectOccSet, intersectsOccSet,
 228                           occNameFS, isTcOcc )
 229 import Module
 230 import Outputable
 231 import BasicTypes       ( Version, initialVersion, bumpVersion, isAlwaysActive,
 232                           Activation(..), RecFlag(..), boolToRecFlag )
 233 import Outputable
 234 import Util             ( createDirectoryHierarchy, directoryOf, sortLe, seqList, lengthIs )
 235 import BinIface         ( writeBinIface )
 236 import Unique           ( Unique, Uniquable(..) )
 237 import ErrUtils         ( dumpIfSet_dyn, showPass )
 238 import Digraph          ( stronglyConnComp, SCC(..) )
 239 import SrcLoc           ( SrcSpan )
 240 import UniqFM
 241 import PackageConfig    ( PackageId )
 242 import FiniteMap
 243 import FastString
 244
 245 import Monad            ( when )
 246 import List             ( insert )
 247 import Maybes           ( orElse, mapCatMaybes, isNothing, isJust,
 248                           expectJust, catMaybes, MaybeErr(..) )
 249 \end{code}
 250
 251
 252
 253 %************************************************************************
 254 %*                                                                      *
 255 \subsection{Completing an interface}
 256 %*                                                                      *
 257 %************************************************************************
 258
 259 \begin{code}
 260 mkIface :: HscEnv
 261         -> Maybe ModIface       -- The old interface, if we have it
 262         -> ModGuts              -- Usages, deprecations, etc
 263         -> ModDetails           -- The trimmed, tidied interface
 264         -> IO (ModIface,        -- The new one, complete with decls and versions
 265                Bool)            -- True <=> there was an old Iface, and the new one
 266                                 --          is identical, so no need to write it
 267
 268 mkIface hsc_env maybe_old_iface
 269         (ModGuts{     mg_module  = this_mod,
 270                       mg_boot    = is_boot,
 271                       mg_usages  = usages,
 272                       mg_deps    = deps,
 273                       mg_rdr_env = rdr_env,
 274                       mg_fix_env = fix_env,
 275                       mg_deprecs = src_deprecs })
 276         (ModDetails{  md_insts   = insts,
 277                       md_rules   = rules,
 278                       md_types   = type_env,
 279                       md_exports = exports })
 280
 281 -- NB:  notice that mkIface does not look at the bindings
 282 --      only at the TypeEnv.  The previous Tidy phase has
 283 --      put exactly the info into the TypeEnv that we want
 284 --      to expose in the interface
 285
 286   = do  { eps <- hscEPS hsc_env
 287         ; let   { ext_nm_rhs = mkExtNameFn hsc_env eps this_mod
 288                 ; ext_nm_lhs = mkLhsNameFn this_mod
 289
 290                 ; decls  = [ tyThingToIfaceDecl ext_nm_rhs thing
 291                            | thing <- typeEnvElts type_env,
 292                              let name = getName thing,
 293                              not (isImplicitName name || isWiredInName name) ]
 294                         -- Don't put implicit Ids and class tycons in the interface file
 295                         -- Nor wired-in things; the compiler knows about them anyhow
 296
 297                 ; fixities    = [(occ,fix) | FixItem occ fix _ <- nameEnvElts fix_env]
 298                 ; deprecs     = mkIfaceDeprec src_deprecs
 299                 ; iface_rules = map (coreRuleToIfaceRule ext_nm_lhs ext_nm_rhs) rules
 300                 ; iface_insts = map (instanceToIfaceInst ext_nm_lhs) insts
 301
 302                 ; intermediate_iface = ModIface {
 303                         mi_module   = this_mod,
 304                         mi_boot     = is_boot,
 305                         mi_deps     = deps,
 306                         mi_usages   = usages,
 307                         mi_exports  = mkIfaceExports exports,
 308                         mi_insts    = sortLe le_inst iface_insts,
 309                         mi_rules    = sortLe le_rule iface_rules,
 310                         mi_fixities = fixities,
 311                         mi_deprecs  = deprecs,
 312                         mi_globals  = Just rdr_env,
 313
 314                         -- Left out deliberately: filled in by addVersionInfo
 315                         mi_mod_vers  = initialVersion,
 316                         mi_exp_vers  = initialVersion,
 317                         mi_rule_vers = initialVersion,
 318                         mi_orphan    = False,   -- Always set by addVersionInfo, but
 319                                                 -- it's a strict field, so we can't omit it.
 320                         mi_decls     = deliberatelyOmitted "decls",
 321                         mi_ver_fn    = deliberatelyOmitted "ver_fn",
 322
 323                         -- And build the cached values
 324                         mi_dep_fn = mkIfaceDepCache deprecs,
 325                         mi_fix_fn = mkIfaceFixCache fixities }
 326
 327                 -- Add version information
 328                 ; (new_iface, no_change_at_all, pp_diffs, pp_orphs)
 329                         = _scc_ "versioninfo"
 330                          addVersionInfo maybe_old_iface intermediate_iface decls
 331                 }
 332
 333                 -- Debug printing
 334         ; when (isJust pp_orphs && dopt Opt_WarnOrphans dflags)
 335                (printDump (expectJust "mkIface" pp_orphs))
 336         ; when (dopt Opt_D_dump_hi_diffs dflags) (printDump pp_diffs)
 337         ; dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE"
 338                         (pprModIface new_iface)
 339
 340         ; return (new_iface, no_change_at_all) }
 341   where
 342      r1 `le_rule` r2 = ifRuleName r1 <= ifRuleName r2
 343      i1 `le_inst` i2 = ifDFun     i1 <= ifDFun     i2
 344
 345      dflags = hsc_dflags hsc_env
 346      deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
 347
 348
 349 -----------------------------
 350 writeIfaceFile :: ModLocation -> ModIface -> IO ()
 351 writeIfaceFile location new_iface
 352     = do createDirectoryHierarchy (directoryOf hi_file_path)
 353          writeBinIface hi_file_path new_iface
 354     where hi_file_path = ml_hi_file location
 355
 356
 357 -----------------------------
 358 mkExtNameFn :: HscEnv -> ExternalPackageState -> Module -> Name -> IfaceExtName
 359 mkExtNameFn hsc_env eps this_mod
 360   = ext_nm
 361   where
 362     hpt = hsc_HPT hsc_env
 363     pit = eps_PIT eps
 364
 365     ext_nm name
 366       | mod == this_mod = case nameParent_maybe name of
 367                                 Nothing  -> LocalTop occ
 368                                 Just par -> LocalTopSub occ (nameOccName par)
 369       | isWiredInName name       = ExtPkg  mod occ
 370       | is_home mod              = HomePkg mod_name occ vers
 371       | otherwise                = ExtPkg  mod occ
 372       where
 373         dflags = hsc_dflags hsc_env
 374         this_pkg = thisPackage dflags
 375         is_home mod = modulePackageId mod == this_pkg
 376
 377         mod      = nameModule name
 378         mod_name = moduleName mod
 379         occ      = nameOccName name
 380         par_occ  = nameOccName (nameParent name)
 381                 -- The version of the *parent* is the one want
 382         vers     = lookupVersion mod par_occ
 383
 384     lookupVersion :: Module -> OccName -> Version
 385         -- Even though we're looking up a home-package thing, in
 386         -- one-shot mode the imported interfaces may be in the PIT
 387     lookupVersion mod occ
 388       = mi_ver_fn iface occ `orElse`
 389         pprPanic "lookupVers1" (ppr mod <+> ppr occ)
 390       where
 391         iface = lookupIfaceByModule (hsc_dflags hsc_env) hpt pit mod `orElse`
 392                 pprPanic "lookupVers2" (ppr mod <+> ppr occ)
 393
 394
 395 ---------------------
 396 -- mkLhsNameFn ignores versioning info altogether
 397 -- It is used for the LHS of instance decls and rules, where we
 398 -- there's no point in recording version info
 399 mkLhsNameFn :: Module -> Name -> IfaceExtName
 400 mkLhsNameFn this_mod name
 401   | isInternalName name = pprTrace "mkLhsNameFn: unexpected internal" (ppr name) $
 402                           LocalTop occ  -- Should not happen
 403   | mod == this_mod = LocalTop occ
 404   | otherwise       = ExtPkg mod occ
 405   where
 406     mod = nameModule name
 407     occ = nameOccName name
 408
 409
 410 -----------------------------
 411 -- Compute version numbers for local decls
 412
 413 addVersionInfo :: Maybe ModIface        -- The old interface, read from M.hi
 414                -> ModIface              -- The new interface decls (lacking decls)
 415                -> [IfaceDecl]           -- The new decls
 416                -> (ModIface,
 417                    Bool,                -- True <=> no changes at all; no need to write new Iface
 418                    SDoc,                -- Differences
 419                    Maybe SDoc)          -- Warnings about orphans
 420
 421 addVersionInfo Nothing new_iface new_decls
 422 -- No old interface, so definitely write a new one!
 423   = (new_iface { mi_orphan = anyNothing ifInstOrph (mi_insts new_iface)
 424                           || anyNothing ifRuleOrph (mi_rules new_iface),
 425                  mi_decls  = [(initialVersion, decl) | decl <- new_decls],
 426                  mi_ver_fn = \n -> Just initialVersion },
 427      False,
 428      ptext SLIT("No old interface file"),
 429      pprOrphans orph_insts orph_rules)
 430   where
 431     orph_insts = filter (isNothing . ifInstOrph) (mi_insts new_iface)
 432     orph_rules = filter (isNothing . ifRuleOrph) (mi_rules new_iface)
 433
 434 addVersionInfo (Just old_iface@(ModIface { mi_mod_vers  = old_mod_vers,
 435                                            mi_exp_vers  = old_exp_vers,
 436                                            mi_rule_vers = old_rule_vers,
 437                                            mi_decls     = old_decls,
 438                                            mi_ver_fn    = old_decl_vers,
 439                                            mi_fix_fn    = old_fixities }))
 440                new_iface@(ModIface { mi_fix_fn = new_fixities })
 441                new_decls
 442
 443   | no_change_at_all = (old_iface,   True,  ptext SLIT("Interface file unchanged"), pp_orphs)
 444   | otherwise        = (final_iface, False, vcat [ptext SLIT("Interface file has changed"),
 445                                                   nest 2 pp_diffs], pp_orphs)
 446   where
 447     final_iface = new_iface { mi_mod_vers  = bump_unless no_output_change old_mod_vers,
 448                               mi_exp_vers  = bump_unless no_export_change old_exp_vers,
 449                               mi_rule_vers = bump_unless no_rule_change   old_rule_vers,
 450                               mi_orphan    = not (null new_orph_rules && null new_orph_insts),
 451                               mi_decls     = decls_w_vers,
 452                               mi_ver_fn    = mkIfaceVerCache decls_w_vers }
 453
 454     decls_w_vers = [(add_vers decl, decl) | decl <- new_decls]
 455
 456     -------------------
 457     (old_non_orph_insts, old_orph_insts) = mkOrphMap ifInstOrph (mi_insts old_iface)
 458     (new_non_orph_insts, new_orph_insts) = mkOrphMap ifInstOrph (mi_insts new_iface)
 459     same_insts occ = eqMaybeBy  (eqListBy eqIfInst)
 460                                 (lookupOccEnv old_non_orph_insts occ)
 461                                 (lookupOccEnv new_non_orph_insts occ)
 462
 463     (old_non_orph_rules, old_orph_rules) = mkOrphMap ifRuleOrph (mi_rules old_iface)
 464     (new_non_orph_rules, new_orph_rules) = mkOrphMap ifRuleOrph (mi_rules new_iface)
 465     same_rules occ = eqMaybeBy  (eqListBy eqIfRule)
 466                                 (lookupOccEnv old_non_orph_rules occ)
 467                                 (lookupOccEnv new_non_orph_rules occ)
 468     -------------------
 469     -- Computing what changed
 470     no_output_change = no_decl_change   && no_rule_change &&
 471                        no_export_change && no_deprec_change
 472     no_export_change = mi_exports new_iface == mi_exports old_iface     -- Kept sorted
 473     no_decl_change   = isEmptyOccSet changed_occs
 474     no_rule_change   = not (changedWrt changed_occs (eqListBy eqIfRule old_orph_rules new_orph_rules)
 475                          || changedWrt changed_occs (eqListBy eqIfInst old_orph_insts new_orph_insts))
 476     no_deprec_change = mi_deprecs new_iface == mi_deprecs old_iface
 477
 478         -- If the usages havn't changed either, we don't need to write the interface file
 479     no_other_changes = mi_usages new_iface == mi_usages old_iface &&
 480                        mi_deps new_iface == mi_deps old_iface
 481     no_change_at_all = no_output_change && no_other_changes
 482
 483     pp_diffs = vcat [pp_change no_export_change "Export list"
 484                         (ppr old_exp_vers <+> arrow <+> ppr (mi_exp_vers final_iface)),
 485                      pp_change no_rule_change "Rules"
 486                         (ppr old_rule_vers <+> arrow <+> ppr (mi_rule_vers final_iface)),
 487                      pp_change no_deprec_change "Deprecations" empty,
 488                      pp_change no_other_changes  "Usages" empty,
 489                      pp_decl_diffs]
 490     pp_change True  what info = empty
 491     pp_change False what info = text what <+> ptext SLIT("changed") <+> info
 492
 493     -------------------
 494     old_decl_env = mkOccEnv [(ifName decl, decl) | (_,decl) <- old_decls]
 495     same_fixity n = bool (old_fixities n == new_fixities n)
 496
 497     -------------------
 498     -- Adding version info
 499     new_version = bumpVersion old_mod_vers      -- Start from the old module version, not from zero
 500                                                 -- so that if you remove f, and then add it again,
 501                                                 -- you don't thereby reduce f's version number
 502     add_vers decl | occ `elemOccSet` changed_occs = new_version
 503                   | otherwise = expectJust "add_vers" (old_decl_vers occ)
 504                                 -- If it's unchanged, there jolly well
 505                   where         -- should be an old version number
 506                     occ = ifName decl
 507
 508     -------------------
 509     changed_occs :: OccSet
 510     changed_occs = computeChangedOccs eq_info
 511
 512     eq_info :: [(OccName, IfaceEq)]
 513     eq_info = map check_eq new_decls
 514     check_eq new_decl | Just old_decl <- lookupOccEnv old_decl_env occ
 515                       = (occ, new_decl `eqIfDecl` old_decl &&&
 516                               eq_indirects new_decl)
 517                       | otherwise {- No corresponding old decl -}
 518                       = (occ, NotEqual)
 519                       where
 520                         occ = ifName new_decl
 521
 522     eq_indirects :: IfaceDecl -> IfaceEq
 523                 -- When seeing if two decls are the same, remember to
 524                 -- check whether any relevant fixity or rules have changed
 525     eq_indirects (IfaceId {ifName = occ}) = eq_ind_occ occ
 526     eq_indirects (IfaceClass {ifName = cls_occ, ifSigs = sigs})
 527         = same_insts cls_occ &&&
 528           eq_ind_occs [op | IfaceClassOp op _ _ <- sigs]
 529     eq_indirects (IfaceData {ifName = tc_occ, ifCons = cons})
 530         = same_insts tc_occ &&& same_fixity tc_occ &&&  -- The TyCon can have a fixity too
 531           eq_ind_occs (map ifConOcc (visibleIfConDecls cons))
 532     eq_indirects other = Equal  -- Synonyms and foreign declarations
 533
 534     eq_ind_occ :: OccName -> IfaceEq    -- For class ops and Ids; check fixity and rules
 535     eq_ind_occ occ = same_fixity occ &&& same_rules occ
 536     eq_ind_occs = foldr ((&&&) . eq_ind_occ) Equal
 537
 538     -------------------
 539     -- Diffs
 540     pp_decl_diffs :: SDoc       -- Nothing => no changes
 541     pp_decl_diffs
 542         | isEmptyOccSet changed_occs = empty
 543         | otherwise
 544         = vcat [ptext SLIT("Changed occs:") <+> ppr (occSetElts changed_occs),
 545                 ptext SLIT("Version change for these decls:"),
 546                 nest 2 (vcat (map show_change new_decls))]
 547
 548     eq_env = mkOccEnv eq_info
 549     show_change new_decl
 550         | not (occ `elemOccSet` changed_occs) = empty
 551         | otherwise
 552         = vcat [ppr occ <+> ppr (old_decl_vers occ) <+> arrow <+> ppr new_version,
 553                 nest 2 why]
 554         where
 555           occ = ifName new_decl
 556           why = case lookupOccEnv eq_env occ of
 557                     Just (EqBut occs) -> sep [ppr occ <> colon, ptext SLIT("Free vars (only) changed:"),
 558                                               nest 2 (braces (fsep (map ppr (occSetElts
 559                                                 (occs `intersectOccSet` changed_occs)))))]
 560                     Just NotEqual
 561                         | Just old_decl <- lookupOccEnv old_decl_env occ
 562                         -> vcat [ptext SLIT("Old:") <+> ppr old_decl,
 563                          ptext SLIT("New:") <+> ppr new_decl]
 564                         | otherwise
 565                         -> ppr occ <+> ptext SLIT("only in new interface")
 566                     other -> pprPanic "MkIface.show_change" (ppr occ)
 567
 568     pp_orphs = pprOrphans new_orph_insts new_orph_rules
 569
 570 pprOrphans insts rules
 571   | null insts && null rules = Nothing
 572   | otherwise
 573   = Just $ vcat [
 574         if null insts then empty else
 575              hang (ptext SLIT("Warning: orphan instances:"))
 576                 2 (vcat (map ppr insts)),
 577         if null rules then empty else
 578              hang (ptext SLIT("Warning: orphan rules:"))
 579                 2 (vcat (map ppr rules))
 580     ]
 581
 582 computeChangedOccs :: [(OccName, IfaceEq)] -> OccSet
 583 computeChangedOccs eq_info
 584   = foldl add_changes emptyOccSet (stronglyConnComp edges)
 585   where
 586     edges :: [((OccName,IfaceEq), Unique, [Unique])]
 587     edges = [ (node, getUnique occ, map getUnique occs)
 588             | node@(occ, iface_eq) <- eq_info
 589             , let occs = case iface_eq of
 590                            EqBut occ_set -> occSetElts occ_set
 591                            other -> [] ]
 592
 593     -- Changes in declarations
 594     add_changes :: OccSet -> SCC (OccName, IfaceEq) -> OccSet
 595     add_changes so_far (AcyclicSCC (occ, iface_eq))
 596         | changedWrt so_far iface_eq                            -- This one has changed
 597         = extendOccSet so_far occ
 598     add_changes so_far (CyclicSCC pairs)
 599         | changedWrt so_far (foldr1 (&&&) (map snd pairs))      -- One of this group has changed
 600         = extendOccSetList so_far (map fst pairs)
 601     add_changes so_far other = so_far
 602
 603 changedWrt :: OccSet -> IfaceEq -> Bool
 604 changedWrt so_far Equal        = False
 605 changedWrt so_far NotEqual     = True
 606 changedWrt so_far (EqBut kids) = so_far `intersectsOccSet` kids
 607
 608 ----------------------
 609 -- mkOrphMap partitions instance decls or rules into
 610 --      (a) an OccEnv for ones that are not orphans,
 611 --          mapping the local OccName to a list of its decls
 612 --      (b) a list of orphan decls
 613 mkOrphMap :: (decl -> Maybe OccName)    -- (Just occ) for a non-orphan decl, keyed by occ
 614                                         -- Nothing for an orphan decl
 615           -> [decl]                     -- Sorted into canonical order
 616           -> (OccEnv [decl],            -- Non-orphan decls associated with their key;
 617                                         --      each sublist in canonical order
 618               [decl])                   -- Orphan decls; in canonical order
 619 mkOrphMap get_key decls
 620   = foldl go (emptyOccEnv, []) decls
 621   where
 622     go (non_orphs, orphs) d
 623         | Just occ <- get_key d
 624         = (extendOccEnv_C (\ ds _ -> d:ds) non_orphs occ [d], orphs)
 625         | otherwise = (non_orphs, d:orphs)
 626
 627 anyNothing :: (a -> Maybe b) -> [a] -> Bool
 628 anyNothing p []     = False
 629 anyNothing p (x:xs) = isNothing (p x) || anyNothing p xs
 630
 631 ----------------------
 632 mkIfaceDeprec :: Deprecations -> IfaceDeprecs
 633 mkIfaceDeprec NoDeprecs        = NoDeprecs
 634 mkIfaceDeprec (DeprecAll t)    = DeprecAll t
 635 mkIfaceDeprec (DeprecSome env) = DeprecSome (sortLe (<=) (nameEnvElts env))
 636
 637 ----------------------
 638 bump_unless :: Bool -> Version -> Version
 639 bump_unless True  v = v -- True <=> no change
 640 bump_unless False v = bumpVersion v
 641 \end{code}
 642
 643
 644 %*********************************************************
 645 %*                                                      *
 646 \subsection{Keeping track of what we've slurped, and version numbers}
 647 %*                                                      *
 648 %*********************************************************
 649
 650
 651 \begin{code}
 652 mkUsageInfo :: HscEnv
 653             -> ModuleEnv (Module, Bool, SrcSpan)
 654             -> [(ModuleName, IsBootInterface)]
 655             -> NameSet -> IO [Usage]
 656 mkUsageInfo hsc_env dir_imp_mods dep_mods used_names
 657   = do  { eps <- hscEPS hsc_env
 658         ; let usages = mk_usage_info (eps_PIT eps) hsc_env
 659                                      dir_imp_mods dep_mods used_names
 660         ; usages `seqList`  return usages }
 661          -- seq the list of Usages returned: occasionally these
 662          -- don't get evaluated for a while and we can end up hanging on to
 663          -- the entire collection of Ifaces.
 664
 665 mk_usage_info pit hsc_env dir_imp_mods dep_mods proto_used_names
 666   = mapCatMaybes mkUsage dep_mods
 667         -- ToDo: do we need to sort into canonical order?
 668   where
 669     hpt = hsc_HPT hsc_env
 670     dflags = hsc_dflags hsc_env
 671
 672     used_names = mkNameSet $                    -- Eliminate duplicates
 673                  [ nameParent n                 -- Just record usage on the 'main' names
 674                  | n <- nameSetToList proto_used_names
 675                  , not (isWiredInName n)        -- Don't record usages for wired-in names
 676                  , isExternalName n             -- Ignore internal names
 677                  ]
 678
 679     -- ent_map groups together all the things imported and used
 680     -- from a particular module in this package
 681     ent_map :: ModuleEnv [OccName]
 682     ent_map  = foldNameSet add_mv emptyModuleEnv used_names
 683     add_mv name mv_map = extendModuleEnv_C add_item mv_map mod [occ]
 684                    where
 685                      occ = nameOccName name
 686                      mod = nameModule name
 687                      add_item occs _ = occ:occs
 688
 689     depend_on_exports mod = case lookupModuleEnv dir_imp_mods mod of
 690                                 Just (_,no_imp,_) -> not no_imp
 691                                 Nothing           -> True
 692
 693     -- We want to create a Usage for a home module if
 694     --  a) we used something from; has something in used_names
 695     --  b) we imported all of it, even if we used nothing from it
 696     --          (need to recompile if its export list changes: export_vers)
 697     --  c) is a home-package orphan module (need to recompile if its
 698     --          instance decls change: rules_vers)
 699     mkUsage :: (ModuleName, IsBootInterface) -> Maybe Usage
 700     mkUsage (mod_name, _)
 701       |  isNothing maybe_iface          -- We can't depend on it if we didn't
 702       || (null used_occs                -- load its interface.
 703           && isNothing export_vers
 704           && not orphan_mod)
 705       = Nothing                 -- Record no usage info
 706
 707       | otherwise
 708       = Just (Usage { usg_name     = mod_name,
 709                       usg_mod      = mod_vers,
 710                       usg_exports  = export_vers,
 711                       usg_entities = ent_vers,
 712                       usg_rules    = rules_vers })
 713       where
 714         maybe_iface  = lookupIfaceByModule dflags hpt pit mod
 715                 -- In one-shot mode, the interfaces for home-package
 716                 -- modules accumulate in the PIT not HPT.  Sigh.
 717
 718         mod = mkModule (thisPackage dflags) mod_name
 719
 720         Just iface   = maybe_iface
 721         orphan_mod   = mi_orphan    iface
 722         version_env  = mi_ver_fn    iface
 723         mod_vers     = mi_mod_vers  iface
 724         rules_vers   = mi_rule_vers iface
 725         export_vers | depend_on_exports mod = Just (mi_exp_vers iface)
 726                     | otherwise             = Nothing
 727
 728         -- The sort is to put them into canonical order
 729         used_occs = lookupModuleEnv ent_map mod `orElse` []
 730         ent_vers :: [(OccName,Version)]
 731         ent_vers = [ (occ, version_env occ `orElse` initialVersion)
 732                    | occ <- sortLe (<=) used_occs]
 733 \end{code}
 734
 735 \begin{code}
 736 mkIfaceExports :: NameSet -> [(Module, [GenAvailInfo OccName])]
 737   -- Group by module and sort by occurrence
 738   -- This keeps the list in canonical order
 739 mkIfaceExports exports
 740   = [ (mod, eltsUFM avails)
 741     | (mod, avails) <- fmToList groupFM
 742     ]
 743   where
 744     groupFM :: ModuleEnv (UniqFM (GenAvailInfo OccName))
 745         -- Deliberately use the FastString so we
 746         -- get a canonical ordering
 747     groupFM = foldl add emptyModuleEnv (nameSetToList exports)
 748
 749     add env name = extendModuleEnv_C add_avail env mod
 750                                         (unitUFM avail_fs avail)
 751       where
 752         occ    = nameOccName name
 753         mod    = nameModule name
 754         avail | Just p <- nameParent_maybe name = AvailTC (nameOccName p) [occ]
 755               | isTcOcc occ                     = AvailTC occ [occ]
 756               | otherwise                       = Avail occ
 757         avail_fs = occNameFS (availName avail)
 758         add_avail avail_fm _ = addToUFM_C add_item avail_fm avail_fs avail
 759
 760         add_item (AvailTC p occs) _ = AvailTC p (List.insert occ occs)
 761         add_item (Avail n)        _ = pprPanic "MkIface.addAvail" (ppr n <+> ppr name)
 762 \end{code}
 763
 764
 765 %************************************************************************
 766 %*                                                                      *
 767         Load the old interface file for this module (unless
 768         we have it aleady), and check whether it is up to date
 769
 770 %*                                                                      *
 771 %************************************************************************
 772
 773 \begin{code}
 774 checkOldIface :: HscEnv
 775               -> ModSummary
 776               -> Bool                   -- Source unchanged
 777               -> Maybe ModIface         -- Old interface from compilation manager, if any
 778               -> IO (RecompileRequired, Maybe ModIface)
 779
 780 checkOldIface hsc_env mod_summary source_unchanged maybe_iface
 781   = do  { showPass (hsc_dflags hsc_env)
 782                    ("Checking old interface for " ++
 783                         showSDoc (ppr (ms_mod mod_summary))) ;
 784
 785         ; initIfaceCheck hsc_env $
 786           check_old_iface hsc_env mod_summary source_unchanged maybe_iface
 787      }
 788
 789 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
 790  =      -- CHECK WHETHER THE SOURCE HAS CHANGED
 791     ifM (not source_unchanged)
 792         (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
 793                                                 `thenM_`
 794
 795      -- If the source has changed and we're in interactive mode, avoid reading
 796      -- an interface; just return the one we might have been supplied with.
 797     getGhcMode                                  `thenM` \ ghc_mode ->
 798     if (ghc_mode == Interactive || ghc_mode == JustTypecheck)
 799         && not source_unchanged then
 800          returnM (outOfDate, maybe_iface)
 801     else
 802
 803     case maybe_iface of {
 804        Just old_iface -> do -- Use the one we already have
 805         recomp <- checkVersions hsc_env source_unchanged old_iface
 806         return (recomp, Just old_iface)
 807
 808     ;  Nothing ->
 809
 810         -- Try and read the old interface for the current module
 811         -- from the .hi file left from the last time we compiled it
 812     let
 813         iface_path = msHiFilePath mod_summary
 814     in
 815     readIface (ms_mod mod_summary) iface_path False     `thenM` \ read_result ->
 816     case read_result of {
 817        Failed err ->    -- Old interface file not found, or garbled; give up
 818                    traceIf (text "FYI: cannot read old interface file:"
 819                                  $$ nest 4 err)         `thenM_`
 820                    returnM (outOfDate, Nothing)
 821
 822     ;  Succeeded iface ->
 823
 824         -- We have got the old iface; check its versions
 825     checkVersions hsc_env source_unchanged iface        `thenM` \ recomp ->
 826     returnM (recomp, Just iface)
 827     }}
 828 \end{code}
 829
 830 @recompileRequired@ is called from the HscMain.   It checks whether
 831 a recompilation is required.  It needs access to the persistent state,
 832 finder, etc, because it may have to load lots of interface files to
 833 check their versions.
 834
 835 \begin{code}
 836 type RecompileRequired = Bool
 837 upToDate  = False       -- Recompile not required
 838 outOfDate = True        -- Recompile required
 839
 840 checkVersions :: HscEnv
 841               -> Bool           -- True <=> source unchanged
 842               -> ModIface       -- Old interface
 843               -> IfG RecompileRequired
 844 checkVersions hsc_env source_unchanged iface
 845   | not source_unchanged
 846   = returnM outOfDate
 847   | otherwise
 848   = do  { traceHiDiffs (text "Considering whether compilation is required for" <+>
 849                         ppr (mi_module iface) <> colon)
 850
 851         -- Source code unchanged and no errors yet... carry on
 852
 853         -- First put the dependent-module info, read from the old interface, into the envt,
 854         -- so that when we look for interfaces we look for the right one (.hi or .hi-boot)
 855         --
 856         -- It's just temporary because either the usage check will succeed
 857         -- (in which case we are done with this module) or it'll fail (in which
 858         -- case we'll compile the module from scratch anyhow).
 859         --
 860         -- We do this regardless of compilation mode
 861         ; updateEps_ $ \eps  -> eps { eps_is_boot = mod_deps }
 862
 863         ; let this_pkg = thisPackage (hsc_dflags hsc_env)
 864         ; checkList [checkModUsage this_pkg u | u <- mi_usages iface]
 865     }
 866   where
 867         -- This is a bit of a hack really
 868     mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)
 869     mod_deps = mkModDeps (dep_mods (mi_deps iface))
 870
 871 checkModUsage :: PackageId ->Usage -> IfG RecompileRequired
 872 -- Given the usage information extracted from the old
 873 -- M.hi file for the module being compiled, figure out
 874 -- whether M needs to be recompiled.
 875
 876 checkModUsage this_pkg (Usage { usg_name = mod_name, usg_mod = old_mod_vers,
 877                                 usg_rules = old_rule_vers,
 878                                 usg_exports = maybe_old_export_vers,
 879                                 usg_entities = old_decl_vers })
 880   =     -- Load the imported interface is possible
 881     let
 882         doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]
 883     in
 884     traceHiDiffs (text "Checking usages for module" <+> ppr mod_name) `thenM_`
 885
 886     let
 887         mod = mkModule this_pkg mod_name
 888     in
 889     loadInterface doc_str mod ImportBySystem            `thenM` \ mb_iface ->
 890         -- Load the interface, but don't complain on failure;
 891         -- Instead, get an Either back which we can test
 892
 893     case mb_iface of {
 894         Failed exn ->  (out_of_date (sep [ptext SLIT("Can't find version number for module"),
 895                                        ppr mod_name]));
 896                 -- Couldn't find or parse a module mentioned in the
 897                 -- old interface file.  Don't complain -- it might just be that
 898                 -- the current module doesn't need that import and it's been deleted
 899
 900         Succeeded iface ->
 901     let
 902         new_mod_vers    = mi_mod_vers  iface
 903         new_decl_vers   = mi_ver_fn    iface
 904         new_export_vers = mi_exp_vers  iface
 905         new_rule_vers   = mi_rule_vers iface
 906     in
 907         -- CHECK MODULE
 908     checkModuleVersion old_mod_vers new_mod_vers        `thenM` \ recompile ->
 909     if not recompile then
 910         returnM upToDate
 911     else
 912
 913         -- CHECK EXPORT LIST
 914     if checkExportList maybe_old_export_vers new_export_vers then
 915         out_of_date_vers (ptext SLIT("  Export list changed"))
 916                          (expectJust "checkModUsage" maybe_old_export_vers)
 917                          new_export_vers
 918     else
 919
 920         -- CHECK RULES
 921     if old_rule_vers /= new_rule_vers then
 922         out_of_date_vers (ptext SLIT("  Rules changed"))
 923                          old_rule_vers new_rule_vers
 924     else
 925
 926         -- CHECK ITEMS ONE BY ONE
 927     checkList [checkEntityUsage new_decl_vers u | u <- old_decl_vers]   `thenM` \ recompile ->
 928     if recompile then
 929         returnM outOfDate       -- This one failed, so just bail out now
 930     else
 931         up_to_date (ptext SLIT("  Great!  The bits I use are up to date"))
 932     }
 933
 934 ------------------------
 935 checkModuleVersion old_mod_vers new_mod_vers
 936   | new_mod_vers == old_mod_vers
 937   = up_to_date (ptext SLIT("Module version unchanged"))
 938
 939   | otherwise
 940   = out_of_date_vers (ptext SLIT("  Module version has changed"))
 941                      old_mod_vers new_mod_vers
 942
 943 ------------------------
 944 checkExportList Nothing  new_vers = upToDate
 945 checkExportList (Just v) new_vers = v /= new_vers
 946
 947 ------------------------
 948 checkEntityUsage new_vers (name,old_vers)
 949   = case new_vers name of
 950
 951         Nothing       ->        -- We used it before, but it ain't there now
 952                           out_of_date (sep [ptext SLIT("No longer exported:"), ppr name])
 953
 954         Just new_vers   -- It's there, but is it up to date?
 955           | new_vers == old_vers -> traceHiDiffs (text "  Up to date" <+> ppr name <+> parens (ppr new_vers)) `thenM_`
 956                                     returnM upToDate
 957           | otherwise            -> out_of_date_vers (ptext SLIT("  Out of date:") <+> ppr name)
 958                                                      old_vers new_vers
 959
 960 up_to_date  msg = traceHiDiffs msg `thenM_` returnM upToDate
 961 out_of_date msg = traceHiDiffs msg `thenM_` returnM outOfDate
 962 out_of_date_vers msg old_vers new_vers
 963   = out_of_date (hsep [msg, ppr old_vers, ptext SLIT("->"), ppr new_vers])
 964
 965 ----------------------
 966 checkList :: [IfG RecompileRequired] -> IfG RecompileRequired
 967 -- This helper is used in two places
 968 checkList []             = returnM upToDate
 969 checkList (check:checks) = check        `thenM` \ recompile ->
 970                            if recompile then
 971                                 returnM outOfDate
 972                            else
 973                                 checkList checks
 974 \end{code}
 975
 976 %************************************************************************
 977 %*                                                                      *
 978                 Converting things to their Iface equivalents
 979 %*                                                                      *
 980 %************************************************************************
 981
 982 \begin{code}
 983 tyThingToIfaceDecl :: (Name -> IfaceExtName) -> TyThing -> IfaceDecl
 984 -- Assumption: the thing is already tidied, so that locally-bound names
 985 --             (lambdas, for-alls) already have non-clashing OccNames
 986 -- Reason: Iface stuff uses OccNames, and the conversion here does
 987 --         not do tidying on the way
 988 tyThingToIfaceDecl ext (AnId id)
 989   = IfaceId { ifName   = getOccName id,
 990               ifType   = toIfaceType ext (idType id),
 991               ifIdInfo = info }
 992   where
 993     info = case toIfaceIdInfo ext (idInfo id) of
 994                 []    -> NoInfo
 995                 items -> HasInfo items
 996
 997 tyThingToIfaceDecl ext (AClass clas)
 998   = IfaceClass { ifCtxt   = toIfaceContext ext sc_theta,
 999                  ifName   = getOccName clas,
1000                  ifTyVars = toIfaceTvBndrs clas_tyvars,
1001                  ifFDs    = map toIfaceFD clas_fds,
1002                  ifATs    = map (tyThingToIfaceDecl ext . ATyCon) clas_ats,
1003                  ifSigs   = map toIfaceClassOp op_stuff,
1004                  ifRec    = boolToRecFlag (isRecursiveTyCon tycon) }
1005   where
1006     (clas_tyvars, clas_fds, sc_theta, _, clas_ats, op_stuff)
1007       = classExtraBigSig clas
1008     tycon = classTyCon clas
1009
1010     toIfaceClassOp (sel_id, def_meth)
1011         = ASSERT(sel_tyvars == clas_tyvars)
1012           IfaceClassOp (getOccName sel_id) def_meth (toIfaceType ext op_ty)
1013         where
1014                 -- Be careful when splitting the type, because of things
1015                 -- like         class Foo a where
1016                 --                op :: (?x :: String) => a -> a
1017                 -- and          class Baz a where
1018                 --                op :: (Ord a) => a -> a
1019           (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
1020           op_ty                = funResultTy rho_ty
1021
1022     toIfaceFD (tvs1, tvs2) = (map (occNameFS.getOccName) tvs1, map (occNameFS.getOccName) tvs2)
1023
1024 tyThingToIfaceDecl ext (ATyCon tycon)
1025   | isSynTyCon tycon
1026   = IfaceSyn {  ifName    = getOccName tycon,
1027                 ifTyVars  = toIfaceTvBndrs tyvars,
1028                 ifOpenSyn = syn_isOpen,
1029                 ifSynRhs  = toIfaceType ext syn_tyki }
1030
1031   | isAlgTyCon tycon
1032   = IfaceData { ifName    = getOccName tycon,
1033                 ifTyVars  = toIfaceTvBndrs tyvars,
1034                 ifCtxt    = toIfaceContext ext (tyConStupidTheta tycon),
1035                 ifCons    = ifaceConDecls (algTyConRhs tycon),
1036                 ifRec     = boolToRecFlag (isRecursiveTyCon tycon),
1037                 ifGadtSyntax = isGadtSyntaxTyCon tycon,
1038                 ifGeneric = tyConHasGenerics tycon,
1039                 ifFamInst = famInstToIface $ tyConFamInst_maybe tycon }
1040
1041   | isForeignTyCon tycon
1042   = IfaceForeign { ifName    = getOccName tycon,
1043                    ifExtName = tyConExtName tycon }
1044
1045   | isPrimTyCon tycon || isFunTyCon tycon
1046         -- Needed in GHCi for ':info Int#', for example
1047   = IfaceData { ifName    = getOccName tycon,
1048                 ifTyVars  = toIfaceTvBndrs (take (tyConArity tycon) alphaTyVars),
1049                 ifCtxt    = [],
1050                 ifCons    = IfAbstractTyCon,
1051                 ifGadtSyntax = False,
1052                 ifGeneric = False,
1053                 ifRec     = NonRecursive,
1054                 ifFamInst = Nothing }
1055
1056   | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
1057   where
1058     tyvars = tyConTyVars tycon
1059     (syn_isOpen, syn_tyki) = case synTyConRhs tycon of
1060                                OpenSynTyCon ki -> (True , ki)
1061                                SynonymTyCon ty -> (False, ty)
1062
1063     ifaceConDecls (NewTyCon { data_con = con })    =
1064       IfNewTyCon  (ifaceConDecl con)
1065     ifaceConDecls (DataTyCon { data_cons = cons }) =
1066       IfDataTyCon (map ifaceConDecl cons)
1067     ifaceConDecls OpenDataTyCon                    = IfOpenDataTyCon
1068     ifaceConDecls OpenNewTyCon                     = IfOpenNewTyCon
1069     ifaceConDecls AbstractTyCon                    = IfAbstractTyCon
1070         -- The last case happens when a TyCon has been trimmed during tidying
1071         -- Furthermore, tyThingToIfaceDecl is also used
1072         -- in TcRnDriver for GHCi, when browsing a module, in which case the
1073         -- AbstractTyCon case is perfectly sensible.
1074
1075     ifaceConDecl data_con
1076         = IfCon   { ifConOcc     = getOccName (dataConName data_con),
1077                     ifConInfix   = dataConIsInfix data_con,
1078                     ifConUnivTvs = toIfaceTvBndrs (dataConUnivTyVars data_con),
1079                     ifConExTvs   = toIfaceTvBndrs (dataConExTyVars data_con),
1080                     ifConEqSpec  = to_eq_spec (dataConEqSpec data_con),
1081                     ifConCtxt    = toIfaceContext ext (dataConTheta data_con),
1082                     ifConArgTys  = map (toIfaceType ext)
1083                                        (dataConOrigArgTys data_con),
1084                     ifConFields  = map getOccName
1085                                        (dataConFieldLabels data_con),
1086                     ifConStricts = dataConStrictMarks data_con }
1087
1088     to_eq_spec spec = [(getOccName tv, toIfaceType ext ty) | (tv,ty) <- spec]
1089
1090     famInstToIface Nothing                    = Nothing
1091     famInstToIface (Just (famTyCon, instTys)) =
1092       Just (toIfaceTyCon ext famTyCon, map (toIfaceType ext) instTys)
1093
1094 tyThingToIfaceDecl ext (ADataCon dc)
1095  = pprPanic "toIfaceDecl" (ppr dc)      -- Should be trimmed out earlier
1096
1097
1098 --------------------------
1099 instanceToIfaceInst :: (Name -> IfaceExtName) -> Instance -> IfaceInst
1100 instanceToIfaceInst ext_lhs ispec@(Instance { is_dfun = dfun_id, is_flag = oflag,
1101                                               is_cls = cls, is_tcs = mb_tcs,
1102                                               is_orph = orph })
1103   = IfaceInst { ifDFun    = getOccName dfun_id,
1104                 ifOFlag   = oflag,
1105                 ifInstCls = ext_lhs cls,
1106                 ifInstTys = map do_rough mb_tcs,
1107                 ifInstOrph = orph }
1108   where
1109     do_rough Nothing  = Nothing
1110     do_rough (Just n) = Just (toIfaceTyCon_name ext_lhs n)
1111
1112 --------------------------
1113 toIfaceIdInfo :: (Name -> IfaceExtName) -> IdInfo -> [IfaceInfoItem]
1114 toIfaceIdInfo ext id_info
1115   = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
1116                inline_hsinfo, wrkr_hsinfo,  unfold_hsinfo]
1117   where
1118     ------------  Arity  --------------
1119     arity_info = arityInfo id_info
1120     arity_hsinfo | arity_info == 0 = Nothing
1121                  | otherwise       = Just (HsArity arity_info)
1122
1123     ------------ Caf Info --------------
1124     caf_info   = cafInfo id_info
1125     caf_hsinfo = case caf_info of
1126                    NoCafRefs -> Just HsNoCafRefs
1127                    _other    -> Nothing
1128
1129     ------------  Strictness  --------------
1130         -- No point in explicitly exporting TopSig
1131     strict_hsinfo = case newStrictnessInfo id_info of
1132                         Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
1133                         _other                        -> Nothing
1134
1135     ------------  Worker  --------------
1136     work_info   = workerInfo id_info
1137     has_worker  = case work_info of { HasWorker _ _ -> True; other -> False }
1138     wrkr_hsinfo = case work_info of
1139                     HasWorker work_id wrap_arity ->
1140                         Just (HsWorker (ext (idName work_id)) wrap_arity)
1141                     NoWorker -> Nothing
1142
1143     ------------  Unfolding  --------------
1144     -- The unfolding is redundant if there is a worker
1145     unfold_info  = unfoldingInfo id_info
1146     rhs          = unfoldingTemplate unfold_info
1147     no_unfolding = neverUnfold unfold_info
1148                         -- The CoreTidy phase retains unfolding info iff
1149                         -- we want to expose the unfolding, taking into account
1150                         -- unconditional NOINLINE, etc.  See TidyPgm.addExternal
1151     unfold_hsinfo | no_unfolding = Nothing
1152                   | has_worker   = Nothing      -- Unfolding is implicit
1153                   | otherwise    = Just (HsUnfold (toIfaceExpr ext rhs))
1154
1155     ------------  Inline prag  --------------
1156     inline_prag = inlinePragInfo id_info
1157     inline_hsinfo | isAlwaysActive inline_prag     = Nothing
1158                   | no_unfolding && not has_worker = Nothing
1159                         -- If the iface file give no unfolding info, we
1160                         -- don't need to say when inlining is OK!
1161                   | otherwise                      = Just (HsInline inline_prag)
1162
1163 --------------------------
1164 coreRuleToIfaceRule :: (Name -> IfaceExtName)   -- For the LHS names
1165                     -> (Name -> IfaceExtName)   -- For the RHS names
1166                     -> CoreRule -> IfaceRule
1167 coreRuleToIfaceRule ext_lhs ext_rhs (BuiltinRule { ru_fn = fn})
1168   = pprTrace "toHsRule: builtin" (ppr fn) $
1169     bogusIfaceRule (mkIfaceExtName fn)
1170
1171 coreRuleToIfaceRule ext_lhs ext_rhs
1172     (Rule { ru_name = name, ru_fn = fn, ru_act = act, ru_bndrs = bndrs,
1173             ru_args = args, ru_rhs = rhs, ru_orph = orph })
1174   = IfaceRule { ifRuleName  = name, ifActivation = act,
1175                 ifRuleBndrs = map (toIfaceBndr ext_lhs) bndrs,
1176                 ifRuleHead  = ext_lhs fn,
1177                 ifRuleArgs  = map do_arg args,
1178                 ifRuleRhs   = toIfaceExpr ext_rhs rhs,
1179                 ifRuleOrph  = orph }
1180   where
1181         -- For type args we must remove synonyms from the outermost
1182         -- level.  Reason: so that when we read it back in we'll
1183         -- construct the same ru_rough field as we have right now;
1184         -- see tcIfaceRule
1185     do_arg (Type ty) = IfaceType (toIfaceType ext_lhs (deNoteType ty))
1186     do_arg arg       = toIfaceExpr ext_lhs arg
1187
1188 bogusIfaceRule :: IfaceExtName -> IfaceRule
1189 bogusIfaceRule id_name
1190   = IfaceRule { ifRuleName = FSLIT("bogus"), ifActivation = NeverActive,
1191         ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
1192         ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing }
1193
1194 ---------------------
1195 toIfaceExpr :: (Name -> IfaceExtName) -> CoreExpr -> IfaceExpr
1196 toIfaceExpr ext (Var v)       = toIfaceVar ext v
1197 toIfaceExpr ext (Lit l)       = IfaceLit l
1198 toIfaceExpr ext (Type ty)     = IfaceType (toIfaceType ext ty)
1199 toIfaceExpr ext (Lam x b)     = IfaceLam (toIfaceBndr ext x) (toIfaceExpr ext b)
1200 toIfaceExpr ext (App f a)     = toIfaceApp ext f [a]
1201 toIfaceExpr ext (Case s x ty as) = IfaceCase (toIfaceExpr ext s) (occNameFS (getOccName x)) (toIfaceType ext ty) (map (toIfaceAlt ext) as)
1202 toIfaceExpr ext (Let b e)     = IfaceLet (toIfaceBind ext b) (toIfaceExpr ext e)
1203 toIfaceExpr ext (Cast e co)   = IfaceCast (toIfaceExpr ext e) (toIfaceType ext co)
1204 toIfaceExpr ext (Note n e)    = IfaceNote (toIfaceNote ext n) (toIfaceExpr ext e)
1205
1206 ---------------------
1207 toIfaceNote ext (SCC cc)      = IfaceSCC cc
1208 toIfaceNote ext InlineMe      = IfaceInlineMe
1209 toIfaceNote ext (CoreNote s)  = IfaceCoreNote s
1210
1211 ---------------------
1212 toIfaceBind ext (NonRec b r) = IfaceNonRec (toIfaceIdBndr ext b) (toIfaceExpr ext r)
1213 toIfaceBind ext (Rec prs)    = IfaceRec [(toIfaceIdBndr ext b, toIfaceExpr ext r) | (b,r) <- prs]
1214
1215 ---------------------
1216 toIfaceAlt ext (c,bs,r) = (toIfaceCon c, map (occNameFS.getOccName) bs, toIfaceExpr ext r)
1217
1218 ---------------------
1219 toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
1220                         | otherwise       = IfaceDataAlt (getOccName dc)
1221                         where
1222                           tc = dataConTyCon dc
1223
1224 toIfaceCon (LitAlt l) = IfaceLitAlt l
1225 toIfaceCon DEFAULT    = IfaceDefault
1226
1227 ---------------------
1228 toIfaceApp ext (App f a) as = toIfaceApp ext f (a:as)
1229 toIfaceApp ext (Var v) as
1230   = case isDataConWorkId_maybe v of
1231         -- We convert the *worker* for tuples into IfaceTuples
1232         Just dc |  isTupleTyCon tc && saturated
1233                 -> IfaceTuple (tupleTyConBoxity tc) tup_args
1234           where
1235             val_args  = dropWhile isTypeArg as
1236             saturated = val_args `lengthIs` idArity v
1237             tup_args  = map (toIfaceExpr ext) val_args
1238             tc        = dataConTyCon dc
1239
1240         other -> mkIfaceApps ext (toIfaceVar ext v) as
1241
1242 toIfaceApp ext e as = mkIfaceApps ext (toIfaceExpr ext e) as
1243
1244 mkIfaceApps ext f as = foldl (\f a -> IfaceApp f (toIfaceExpr ext a)) f as
1245
1246 ---------------------
1247 toIfaceVar :: (Name -> IfaceExtName) -> Id -> IfaceExpr
1248 toIfaceVar ext v
1249   | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType ext (idType v))
1250           -- Foreign calls have special syntax
1251   | isExternalName name             = IfaceExt (ext name)
1252   | otherwise                       = IfaceLcl (occNameFS (nameOccName name))
1253   where
1254     name = idName v
1255 \end{code}