compiler/iface/MkIface.lhs

   1 %
   2 % (c) The University of Glasgow 2006-2008
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
   4 %
   5
   6 \begin{code}
   7 module MkIface (
   8         mkUsedNames,
   9         mkDependencies,
  10         mkIface,        -- Build a ModIface from a ModGuts,
  11                         -- including computing version information
  12
  13         mkIfaceTc,
  14
  15         writeIfaceFile, -- Write the interface file
  16
  17         checkOldIface,  -- See if recompilation is required, by
  18                         -- comparing version information
  19
  20         tyThingToIfaceDecl -- Converting things to their Iface equivalents
  21  ) where
  22 \end{code}
  23
  24         -----------------------------------------------
  25                 Recompilation checking
  26         -----------------------------------------------
  27
  28 A complete description of how recompilation checking works can be
  29 found in the wiki commentary:
  30
  31  http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
  32
  33 Please read the above page for a top-down description of how this all
  34 works.  Notes below cover specific issues related to the implementation.
  35
  36 Basic idea:
  37
  38   * In the mi_usages information in an interface, we record the
  39     fingerprint of each free variable of the module
  40
  41   * In mkIface, we compute the fingerprint of each exported thing A.f.
  42     For each external thing that A.f refers to, we include the fingerprint
  43     of the external reference when computing the fingerprint of A.f.  So
  44     if anything that A.f depends on changes, then A.f's fingerprint will
  45     change.
  46
  47   * In checkOldIface we compare the mi_usages for the module with
  48     the actual fingerprint for all each thing recorded in mi_usages
  49
  50 \begin{code}
  51 #include "HsVersions.h"
  52
  53 import IfaceSyn
  54 import LoadIface
  55 import Id
  56 import IdInfo
  57 import Demand
  58 import Annotations
  59 import CoreSyn
  60 import CoreFVs
  61 import Class
  62 import TyCon
  63 import DataCon
  64 import Type
  65 import TcType
  66 import InstEnv
  67 import FamInstEnv
  68 import TcRnMonad
  69 import HsSyn
  70 import HscTypes
  71 import Finder
  72 import DynFlags
  73 import VarEnv
  74 import Var
  75 import Name
  76 import RdrName
  77 import NameEnv
  78 import NameSet
  79 import Module
  80 import BinIface
  81 import ErrUtils
  82 import Digraph
  83 import SrcLoc
  84 import Outputable
  85 import BasicTypes       hiding ( SuccessFlag(..) )
  86 import UniqFM
  87 import Unique
  88 import Util             hiding ( eqListBy )
  89 import FiniteMap
  90 import FastString
  91 import Maybes
  92 import ListSetOps
  93 import Binary
  94 import Fingerprint
  95 import Bag
  96
  97 import Control.Monad
  98 import Data.List
  99 import Data.IORef
 100 import System.FilePath
 101 \end{code}
 102
 103
 104
 105 %************************************************************************
 106 %*                                                                      *
 107 \subsection{Completing an interface}
 108 %*                                                                      *
 109 %************************************************************************
 110
 111 \begin{code}
 112 mkIface :: HscEnv
 113         -> Maybe Fingerprint    -- The old fingerprint, if we have it
 114         -> ModDetails           -- The trimmed, tidied interface
 115         -> ModGuts              -- Usages, deprecations, etc
 116         -> IO (Messages,
 117                Maybe (ModIface, -- The new one
 118                       Bool))    -- True <=> there was an old Iface, and the
 119                                 --          new one is identical, so no need
 120                                 --          to write it
 121
 122 mkIface hsc_env maybe_old_fingerprint mod_details
 123          ModGuts{     mg_module    = this_mod,
 124                       mg_boot      = is_boot,
 125                       mg_used_names = used_names,
 126                       mg_deps      = deps,
 127                       mg_dir_imps  = dir_imp_mods,
 128                       mg_rdr_env   = rdr_env,
 129                       mg_fix_env   = fix_env,
 130                       mg_warns   = warns,
 131                       mg_hpc_info  = hpc_info }
 132         = mkIface_ hsc_env maybe_old_fingerprint
 133                    this_mod is_boot used_names deps rdr_env
 134                    fix_env warns hpc_info dir_imp_mods mod_details
 135
 136 -- | make an interface from the results of typechecking only.  Useful
 137 -- for non-optimising compilation, or where we aren't generating any
 138 -- object code at all ('HscNothing').
 139 mkIfaceTc :: HscEnv
 140           -> Maybe Fingerprint  -- The old fingerprint, if we have it
 141           -> ModDetails         -- gotten from mkBootModDetails, probably
 142           -> TcGblEnv           -- Usages, deprecations, etc
 143           -> IO (Messages, Maybe (ModIface, Bool))
 144 mkIfaceTc hsc_env maybe_old_fingerprint mod_details
 145   tc_result@TcGblEnv{ tcg_mod = this_mod,
 146                       tcg_src = hsc_src,
 147                       tcg_imports = imports,
 148                       tcg_rdr_env = rdr_env,
 149                       tcg_fix_env = fix_env,
 150                       tcg_warns = warns,
 151                       tcg_hpc = other_hpc_info
 152                     }
 153   = do
 154           used_names <- mkUsedNames tc_result
 155           deps <- mkDependencies tc_result
 156           let hpc_info = emptyHpcInfo other_hpc_info
 157           mkIface_ hsc_env maybe_old_fingerprint
 158                    this_mod (isHsBoot hsc_src) used_names deps rdr_env
 159                    fix_env warns hpc_info (imp_mods imports) mod_details
 160
 161
 162 mkUsedNames :: TcGblEnv -> IO NameSet
 163 mkUsedNames
 164           TcGblEnv{ tcg_inst_uses = dfun_uses_var,
 165                     tcg_dus = dus
 166                   }
 167  = do { dfun_uses <- readIORef dfun_uses_var            -- What dfuns are used
 168       ; return (allUses dus `unionNameSets` dfun_uses) }
 169
 170 mkDependencies :: TcGblEnv -> IO Dependencies
 171 mkDependencies
 172           TcGblEnv{ tcg_mod = mod,
 173                     tcg_imports = imports,
 174                     tcg_th_used = th_var
 175                   }
 176  = do
 177       th_used   <- readIORef th_var                     -- Whether TH is used
 178       let
 179         dep_mods = eltsUFM (delFromUFM (imp_dep_mods imports) (moduleName mod))
 180                 -- M.hi-boot can be in the imp_dep_mods, but we must remove
 181                 -- it before recording the modules on which this one depends!
 182                 -- (We want to retain M.hi-boot in imp_dep_mods so that
 183                 --  loadHiBootInterface can see if M's direct imports depend
 184                 --  on M.hi-boot, and hence that we should do the hi-boot consistency
 185                 --  check.)
 186
 187         pkgs | th_used   = insertList thPackageId (imp_dep_pkgs imports)
 188              | otherwise = imp_dep_pkgs imports
 189
 190       return Deps { dep_mods   = sortBy (stableModuleNameCmp `on` fst) dep_mods,
 191                     dep_pkgs   = sortBy stablePackageIdCmp pkgs,
 192                     dep_orphs  = sortBy stableModuleCmp (imp_orphs  imports),
 193                     dep_finsts = sortBy stableModuleCmp (imp_finsts imports) }
 194                 -- sort to get into canonical order
 195                 -- NB. remember to use lexicographic ordering
 196
 197 mkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> IsBootInterface
 198          -> NameSet -> Dependencies -> GlobalRdrEnv
 199          -> NameEnv FixItem -> Warnings -> HpcInfo
 200          -> ImportedMods
 201          -> ModDetails
 202          -> IO (Messages, Maybe (ModIface, Bool))
 203 mkIface_ hsc_env maybe_old_fingerprint
 204          this_mod is_boot used_names deps rdr_env fix_env src_warns hpc_info
 205          dir_imp_mods
 206          ModDetails{  md_insts     = insts,
 207                       md_fam_insts = fam_insts,
 208                       md_rules     = rules,
 209                       md_anns      = anns,
 210                       md_vect_info = vect_info,
 211                       md_types     = type_env,
 212                       md_exports   = exports }
 213 -- NB:  notice that mkIface does not look at the bindings
 214 --      only at the TypeEnv.  The previous Tidy phase has
 215 --      put exactly the info into the TypeEnv that we want
 216 --      to expose in the interface
 217
 218   = do  { usages <- mkUsageInfo hsc_env this_mod dir_imp_mods used_names
 219
 220         ; let   { entities = typeEnvElts type_env ;
 221                   decls  = [ tyThingToIfaceDecl entity
 222                            | entity <- entities,
 223                              let name = getName entity,
 224                              not (isImplicitTyThing entity),
 225                                 -- No implicit Ids and class tycons in the interface file
 226                              not (isWiredInName name),
 227                                 -- Nor wired-in things; the compiler knows about them anyhow
 228                              nameIsLocalOrFrom this_mod name  ]
 229                                 -- Sigh: see Note [Root-main Id] in TcRnDriver
 230
 231                 ; fixities    = [(occ,fix) | FixItem occ fix <- nameEnvElts fix_env]
 232                 ; warns     = src_warns
 233                 ; iface_rules = map (coreRuleToIfaceRule this_mod) rules
 234                 ; iface_insts = map instanceToIfaceInst insts
 235                 ; iface_fam_insts = map famInstToIfaceFamInst fam_insts
 236                 ; iface_vect_info = flattenVectInfo vect_info
 237
 238                 ; intermediate_iface = ModIface {
 239                         mi_module   = this_mod,
 240                         mi_boot     = is_boot,
 241                         mi_deps     = deps,
 242                         mi_usages   = usages,
 243                         mi_exports  = mkIfaceExports exports,
 244
 245                         -- Sort these lexicographically, so that
 246                         -- the result is stable across compilations
 247                         mi_insts    = sortLe le_inst iface_insts,
 248                         mi_fam_insts= sortLe le_fam_inst iface_fam_insts,
 249                         mi_rules    = sortLe le_rule iface_rules,
 250
 251                         mi_vect_info = iface_vect_info,
 252
 253                         mi_fixities = fixities,
 254                         mi_warns  = warns,
 255                         mi_anns     = mkIfaceAnnotations anns,
 256                         mi_globals  = Just rdr_env,
 257
 258                         -- Left out deliberately: filled in by addVersionInfo
 259                         mi_iface_hash = fingerprint0,
 260                         mi_mod_hash  = fingerprint0,
 261                         mi_exp_hash  = fingerprint0,
 262                         mi_orphan_hash = fingerprint0,
 263                         mi_orphan    = False,   -- Always set by addVersionInfo, but
 264                                                 -- it's a strict field, so we can't omit it.
 265                         mi_finsts    = False,   -- Ditto
 266                         mi_decls     = deliberatelyOmitted "decls",
 267                         mi_hash_fn   = deliberatelyOmitted "hash_fn",
 268                         mi_hpc       = isHpcUsed hpc_info,
 269
 270                         -- And build the cached values
 271                         mi_warn_fn = mkIfaceWarnCache warns,
 272                         mi_fix_fn = mkIfaceFixCache fixities }
 273                 }
 274
 275         ; (new_iface, no_change_at_all)
 276                 <- {-# SCC "versioninfo" #-}
 277                          addFingerprints hsc_env maybe_old_fingerprint
 278                                          intermediate_iface decls
 279
 280                 -- Warn about orphans
 281         ; let orph_warnings   --- Laziness means no work done unless -fwarn-orphans
 282                 | dopt Opt_WarnOrphans dflags = rule_warns `unionBags` inst_warns
 283                 | otherwise                   = emptyBag
 284               errs_and_warns = (orph_warnings, emptyBag)
 285               unqual = mkPrintUnqualified dflags rdr_env
 286               inst_warns = listToBag [ instOrphWarn unqual d
 287                                      | (d,i) <- insts `zip` iface_insts
 288                                      , isNothing (ifInstOrph i) ]
 289               rule_warns = listToBag [ ruleOrphWarn unqual this_mod r
 290                                      | r <- iface_rules
 291                                      , isNothing (ifRuleOrph r) ]
 292
 293         ; if errorsFound dflags errs_and_warns
 294             then return ( errs_and_warns, Nothing )
 295             else do {
 296
 297 -- XXX  ; when (dopt Opt_D_dump_hi_diffs dflags) (printDump pp_diffs)
 298
 299                 -- Debug printing
 300         ; dumpIfSet_dyn dflags Opt_D_dump_hi "FINAL INTERFACE"
 301                         (pprModIface new_iface)
 302
 303                 -- bug #1617: on reload we weren't updating the PrintUnqualified
 304                 -- correctly.  This stems from the fact that the interface had
 305                 -- not changed, so addVersionInfo returns the old ModIface
 306                 -- with the old GlobalRdrEnv (mi_globals).
 307         ; let final_iface = new_iface{ mi_globals = Just rdr_env }
 308
 309         ; return (errs_and_warns, Just (final_iface, no_change_at_all)) }}
 310   where
 311      r1 `le_rule`     r2 = ifRuleName      r1    <=    ifRuleName      r2
 312      i1 `le_inst`     i2 = ifDFun          i1 `le_occ` ifDFun          i2
 313      i1 `le_fam_inst` i2 = ifFamInstTcName i1 `le_occ` ifFamInstTcName i2
 314
 315      le_occ :: Name -> Name -> Bool
 316         -- Compare lexicographically by OccName, *not* by unique, because
 317         -- the latter is not stable across compilations
 318      le_occ n1 n2 = nameOccName n1 <= nameOccName n2
 319
 320      dflags = hsc_dflags hsc_env
 321      deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
 322      ifFamInstTcName = ifaceTyConName . ifFamInstTyCon
 323
 324      flattenVectInfo (VectInfo { vectInfoVar   = vVar
 325                                , vectInfoTyCon = vTyCon
 326                                }) =
 327        IfaceVectInfo {
 328          ifaceVectInfoVar        = [ Var.varName v
 329                                    | (v, _) <- varEnvElts vVar],
 330          ifaceVectInfoTyCon      = [ tyConName t
 331                                    | (t, t_v) <- nameEnvElts vTyCon
 332                                    , t /= t_v],
 333          ifaceVectInfoTyConReuse = [ tyConName t
 334                                    | (t, t_v) <- nameEnvElts vTyCon
 335                                    , t == t_v]
 336        }
 337
 338 -----------------------------
 339 writeIfaceFile :: DynFlags -> ModLocation -> ModIface -> IO ()
 340 writeIfaceFile dflags location new_iface
 341     = do createDirectoryHierarchy (takeDirectory hi_file_path)
 342          writeBinIface dflags hi_file_path new_iface
 343     where hi_file_path = ml_hi_file location
 344
 345
 346 -- -----------------------------------------------------------------------------
 347 -- Look up parents and versions of Names
 348
 349 -- This is like a global version of the mi_hash_fn field in each ModIface.
 350 -- Given a Name, it finds the ModIface, and then uses mi_hash_fn to get
 351 -- the parent and version info.
 352
 353 mkHashFun
 354         :: HscEnv                       -- needed to look up versions
 355         -> ExternalPackageState         -- ditto
 356         -> (Name -> Fingerprint)
 357 mkHashFun hsc_env eps
 358   = \name ->
 359       let
 360         mod = ASSERT2( isExternalName name, ppr name ) nameModule name
 361         occ = nameOccName name
 362         iface = lookupIfaceByModule (hsc_dflags hsc_env) hpt pit mod `orElse`
 363                    pprPanic "lookupVers2" (ppr mod <+> ppr occ)
 364       in
 365         snd (mi_hash_fn iface occ `orElse`
 366                   pprPanic "lookupVers1" (ppr mod <+> ppr occ))
 367   where
 368       hpt = hsc_HPT hsc_env
 369       pit = eps_PIT eps
 370
 371 -- ---------------------------------------------------------------------------
 372 -- Compute fingerprints for the interface
 373
 374 addFingerprints
 375         :: HscEnv
 376         -> Maybe Fingerprint -- the old fingerprint, if any
 377         -> ModIface          -- The new interface (lacking decls)
 378         -> [IfaceDecl]       -- The new decls
 379         -> IO (ModIface,     -- Updated interface
 380                Bool)         -- True <=> no changes at all;
 381                              -- no need to write Iface
 382
 383 addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
 384  = do
 385    eps <- hscEPS hsc_env
 386    let
 387         -- The ABI of a declaration represents everything that is made
 388         -- visible about the declaration that a client can depend on.
 389         -- see IfaceDeclABI below.
 390        declABI :: IfaceDecl -> IfaceDeclABI
 391        declABI decl = (this_mod, decl, extras)
 392         where extras = declExtras fix_fn non_orph_rules non_orph_insts decl
 393
 394        edges :: [(IfaceDeclABI, Unique, [Unique])]
 395        edges = [ (abi, getUnique (ifName decl), out)
 396                | decl <- new_decls
 397                , let abi = declABI decl
 398                , let out = localOccs $ freeNamesDeclABI abi
 399                ]
 400
 401        name_module n = ASSERT2( isExternalName n, ppr n ) nameModule n
 402        localOccs = map (getUnique . getParent . getOccName)
 403                         . filter ((== this_mod) . name_module)
 404                         . nameSetToList
 405           where getParent occ = lookupOccEnv parent_map occ `orElse` occ
 406
 407         -- maps OccNames to their parents in the current module.
 408         -- e.g. a reference to a constructor must be turned into a reference
 409         -- to the TyCon for the purposes of calculating dependencies.
 410        parent_map :: OccEnv OccName
 411        parent_map = foldr extend emptyOccEnv new_decls
 412           where extend d env =
 413                   extendOccEnvList env [ (b,n) | b <- ifaceDeclSubBndrs d ]
 414                   where n = ifName d
 415
 416         -- strongly-connected groups of declarations, in dependency order
 417        groups = stronglyConnCompFromEdgedVertices edges
 418
 419        global_hash_fn = mkHashFun hsc_env eps
 420
 421         -- how to output Names when generating the data to fingerprint.
 422         -- Here we want to output the fingerprint for each top-level
 423         -- Name, whether it comes from the current module or another
 424         -- module.  In this way, the fingerprint for a declaration will
 425         -- change if the fingerprint for anything it refers to (transitively)
 426         -- changes.
 427        mk_put_name :: (OccEnv (OccName,Fingerprint))
 428                    -> BinHandle -> Name -> IO  ()
 429        mk_put_name local_env bh name
 430           | isWiredInName name  =  putNameLiterally bh name
 431            -- wired-in names don't have fingerprints
 432           | otherwise
 433           = ASSERT( isExternalName name )
 434             let hash | nameModule name /= this_mod =  global_hash_fn name
 435                      | otherwise =
 436                         snd (lookupOccEnv local_env (getOccName name)
 437                            `orElse` pprPanic "urk! lookup local fingerprint"
 438                                        (ppr name)) -- (undefined,fingerprint0))
 439                 -- This panic indicates that we got the dependency
 440                 -- analysis wrong, because we needed a fingerprint for
 441                 -- an entity that wasn't in the environment.  To debug
 442                 -- it, turn the panic into a trace, uncomment the
 443                 -- pprTraces below, run the compile again, and inspect
 444                 -- the output and the generated .hi file with
 445                 -- --show-iface.
 446             in
 447             put_ bh hash
 448
 449         -- take a strongly-connected group of declarations and compute
 450         -- its fingerprint.
 451
 452        fingerprint_group :: (OccEnv (OccName,Fingerprint),
 453                              [(Fingerprint,IfaceDecl)])
 454                          -> SCC IfaceDeclABI
 455                          -> IO (OccEnv (OccName,Fingerprint),
 456                                 [(Fingerprint,IfaceDecl)])
 457
 458        fingerprint_group (local_env, decls_w_hashes) (AcyclicSCC abi)
 459           = do let hash_fn = mk_put_name local_env
 460                    decl = abiDecl abi
 461                -- pprTrace "fingerprinting" (ppr (ifName decl) ) $ do
 462                hash <- computeFingerprint dflags hash_fn abi
 463                return (extend_hash_env (hash,decl) local_env,
 464                        (hash,decl) : decls_w_hashes)
 465
 466        fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis)
 467           = do let decls = map abiDecl abis
 468                    local_env' = foldr extend_hash_env local_env
 469                                    (zip (repeat fingerprint0) decls)
 470                    hash_fn = mk_put_name local_env'
 471                -- pprTrace "fingerprinting" (ppr (map ifName decls) ) $ do
 472                let stable_abis = sortBy cmp_abiNames abis
 473                 -- put the cycle in a canonical order
 474                hash <- computeFingerprint dflags hash_fn stable_abis
 475                let pairs = zip (repeat hash) decls
 476                return (foldr extend_hash_env local_env pairs,
 477                        pairs ++ decls_w_hashes)
 478
 479        extend_hash_env :: (Fingerprint,IfaceDecl)
 480                        -> OccEnv (OccName,Fingerprint)
 481                        -> OccEnv (OccName,Fingerprint)
 482        extend_hash_env (hash,d) env0 = foldr add_imp env1 (ifaceDeclSubBndrs d)
 483         where
 484           decl_name = ifName d
 485           item = (decl_name, hash)
 486           env1 = extendOccEnv env0 decl_name item
 487           add_imp bndr env = extendOccEnv env bndr item
 488
 489    --
 490    (local_env, decls_w_hashes) <-
 491        foldM fingerprint_group (emptyOccEnv, []) groups
 492
 493    -- when calculating fingerprints, we always need to use canonical
 494    -- ordering for lists of things.  In particular, the mi_deps has various
 495    -- lists of modules and suchlike, so put these all in canonical order:
 496    let sorted_deps = sortDependencies (mi_deps iface0)
 497
 498    -- the export hash of a module depends on the orphan hashes of the
 499    -- orphan modules below us in the dependency tree.  This is the way
 500    -- that changes in orphans get propagated all the way up the
 501    -- dependency tree.  We only care about orphan modules in the current
 502    -- package, because changes to orphans outside this package will be
 503    -- tracked by the usage on the ABI hash of package modules that we import.
 504    let orph_mods = filter ((== this_pkg) . modulePackageId)
 505                    $ dep_orphs sorted_deps
 506    dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods
 507
 508    orphan_hash <- computeFingerprint dflags (mk_put_name local_env)
 509                       (map IfaceInstABI orph_insts, orph_rules, fam_insts)
 510
 511    -- the export list hash doesn't depend on the fingerprints of
 512    -- the Names it mentions, only the Names themselves, hence putNameLiterally.
 513    export_hash <- computeFingerprint dflags putNameLiterally
 514                       (mi_exports iface0,
 515                        orphan_hash,
 516                        dep_orphan_hashes,
 517                        dep_pkgs (mi_deps iface0))
 518                         -- dep_pkgs: see "Package Version Changes" on
 519                         -- wiki/Commentary/Compiler/RecompilationAvoidance
 520
 521    -- put the declarations in a canonical order, sorted by OccName
 522    let sorted_decls = eltsFM $ listToFM $
 523                           [(ifName d, e) | e@(_, d) <- decls_w_hashes]
 524
 525    -- the ABI hash depends on:
 526    --   - decls
 527    --   - export list
 528    --   - orphans
 529    --   - deprecations
 530    --   - XXX vect info?
 531    mod_hash <- computeFingerprint dflags putNameLiterally
 532                       (map fst sorted_decls,
 533                        export_hash,
 534                        orphan_hash,
 535                        mi_warns iface0)
 536
 537    -- The interface hash depends on:
 538    --    - the ABI hash, plus
 539    --    - usages
 540    --    - deps
 541    --    - hpc
 542    iface_hash <- computeFingerprint dflags putNameLiterally
 543                       (mod_hash,
 544                        mi_usages iface0,
 545                        sorted_deps,
 546                        mi_hpc iface0)
 547
 548    let
 549     no_change_at_all = Just iface_hash == mb_old_fingerprint
 550
 551     final_iface = iface0 {
 552                 mi_mod_hash    = mod_hash,
 553                 mi_iface_hash  = iface_hash,
 554                 mi_exp_hash    = export_hash,
 555                 mi_orphan_hash = orphan_hash,
 556                 mi_orphan      = not (null orph_rules && null orph_insts),
 557                 mi_finsts      = not . null $ mi_fam_insts iface0,
 558                 mi_decls       = sorted_decls,
 559                 mi_hash_fn     = lookupOccEnv local_env }
 560    --
 561    return (final_iface, no_change_at_all)
 562
 563   where
 564     this_mod = mi_module iface0
 565     dflags = hsc_dflags hsc_env
 566     this_pkg = thisPackage dflags
 567     (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph (mi_insts iface0)
 568     (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph (mi_rules iface0)
 569         -- ToDo: shouldn't we be splitting fam_insts into orphans and
 570         -- non-orphans?
 571     fam_insts = mi_fam_insts iface0
 572     fix_fn = mi_fix_fn iface0
 573
 574
 575 getOrphanHashes :: HscEnv -> [Module] -> IO [Fingerprint]
 576 getOrphanHashes hsc_env mods = do
 577   eps <- hscEPS hsc_env
 578   let
 579     hpt        = hsc_HPT hsc_env
 580     pit        = eps_PIT eps
 581     dflags     = hsc_dflags hsc_env
 582     get_orph_hash mod =
 583           case lookupIfaceByModule dflags hpt pit mod of
 584             Nothing    -> pprPanic "moduleOrphanHash" (ppr mod)
 585             Just iface -> mi_orphan_hash iface
 586   --
 587   return (map get_orph_hash mods)
 588
 589
 590 sortDependencies :: Dependencies -> Dependencies
 591 sortDependencies d
 592  = Deps { dep_mods   = sortBy (compare `on` (moduleNameFS.fst)) (dep_mods d),
 593           dep_pkgs   = sortBy (compare `on` packageIdFS)  (dep_pkgs d),
 594           dep_orphs  = sortBy stableModuleCmp (dep_orphs d),
 595           dep_finsts = sortBy stableModuleCmp (dep_finsts d) }
 596 \end{code}
 597
 598
 599 %************************************************************************
 600 %*                                                                      *
 601           The ABI of an IfaceDecl
 602 %*                                                                      *
 603 %************************************************************************
 604
 605 Note [The ABI of an IfaceDecl]
 606 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 607 The ABI of a declaration consists of:
 608
 609    (a) the full name of the identifier (inc. module and package,
 610        because these are used to construct the symbol name by which
 611        the identifier is known externally).
 612
 613    (b) the declaration itself, as exposed to clients.  That is, the
 614        definition of an Id is included in the fingerprint only if
 615        it is made available as as unfolding in the interface.
 616
 617    (c) the fixity of the identifier
 618    (d) for Ids: rules
 619    (e) for classes: instances, fixity & rules for methods
 620    (f) for datatypes: instances, fixity & rules for constrs
 621
 622 Items (c)-(f) are not stored in the IfaceDecl, but instead appear
 623 elsewhere in the interface file.  But they are *fingerprinted* with
 624 the Id itself. This is done by grouping (c)-(f) in IfaceDeclExtras,
 625 and fingerprinting that as part of the Id.
 626
 627 \begin{code}
 628 type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras)
 629
 630 data IfaceDeclExtras
 631   = IfaceIdExtras    Fixity [IfaceRule]
 632   | IfaceDataExtras  Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
 633   | IfaceClassExtras Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
 634   | IfaceSynExtras   Fixity
 635   | IfaceOtherDeclExtras
 636
 637 abiDecl :: IfaceDeclABI -> IfaceDecl
 638 abiDecl (_, decl, _) = decl
 639
 640 cmp_abiNames :: IfaceDeclABI -> IfaceDeclABI -> Ordering
 641 cmp_abiNames abi1 abi2 = ifName (abiDecl abi1) `compare`
 642                          ifName (abiDecl abi2)
 643
 644 freeNamesDeclABI :: IfaceDeclABI -> NameSet
 645 freeNamesDeclABI (_mod, decl, extras) =
 646   freeNamesIfDecl decl `unionNameSets` freeNamesDeclExtras extras
 647
 648 freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
 649 freeNamesDeclExtras (IfaceIdExtras    _ rules)
 650   = unionManyNameSets (map freeNamesIfRule rules)
 651 freeNamesDeclExtras (IfaceDataExtras  _ _insts subs)
 652   = unionManyNameSets (map freeNamesSub subs)
 653 freeNamesDeclExtras (IfaceClassExtras _ _insts subs)
 654   = unionManyNameSets (map freeNamesSub subs)
 655 freeNamesDeclExtras (IfaceSynExtras _)
 656   = emptyNameSet
 657 freeNamesDeclExtras IfaceOtherDeclExtras
 658   = emptyNameSet
 659
 660 freeNamesSub :: (Fixity,[IfaceRule]) -> NameSet
 661 freeNamesSub (_,rules) = unionManyNameSets (map freeNamesIfRule rules)
 662
 663 -- This instance is used only to compute fingerprints
 664 instance Binary IfaceDeclExtras where
 665   get _bh = panic "no get for IfaceDeclExtras"
 666   put_ bh (IfaceIdExtras fix rules) = do
 667    putByte bh 1; put_ bh fix; put_ bh rules
 668   put_ bh (IfaceDataExtras fix insts cons) = do
 669    putByte bh 2; put_ bh fix; put_ bh insts; put_ bh cons
 670   put_ bh (IfaceClassExtras fix insts methods) = do
 671    putByte bh 3; put_ bh fix; put_ bh insts; put_ bh methods
 672   put_ bh (IfaceSynExtras fix) = do
 673    putByte bh 4; put_ bh fix
 674   put_ bh IfaceOtherDeclExtras = do
 675    putByte bh 5
 676
 677 declExtras :: (OccName -> Fixity)
 678            -> OccEnv [IfaceRule]
 679            -> OccEnv [IfaceInst]
 680            -> IfaceDecl
 681            -> IfaceDeclExtras
 682
 683 declExtras fix_fn rule_env inst_env decl
 684   = case decl of
 685       IfaceId{} -> IfaceIdExtras (fix_fn n)
 686                         (lookupOccEnvL rule_env n)
 687       IfaceData{ifCons=cons} ->
 688                      IfaceDataExtras (fix_fn n)
 689                         (map IfaceInstABI $ lookupOccEnvL inst_env n)
 690                         (map (id_extras . ifConOcc) (visibleIfConDecls cons))
 691       IfaceClass{ifSigs=sigs} ->
 692                      IfaceClassExtras (fix_fn n)
 693                         (map IfaceInstABI $ lookupOccEnvL inst_env n)
 694                         [id_extras op | IfaceClassOp op _ _ <- sigs]
 695       IfaceSyn{} -> IfaceSynExtras (fix_fn n)
 696       _other -> IfaceOtherDeclExtras
 697   where
 698         n = ifName decl
 699         id_extras occ = (fix_fn occ, lookupOccEnvL rule_env occ)
 700
 701 --
 702 -- When hashing an instance, we hash only its structure, not the
 703 -- fingerprints of the things it mentions.  See the section on instances
 704 -- in the commentary,
 705 --    http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
 706 --
 707 newtype IfaceInstABI = IfaceInstABI IfaceInst
 708
 709 instance Binary IfaceInstABI where
 710   get = panic "no get for IfaceInstABI"
 711   put_ bh (IfaceInstABI inst) = do
 712     let ud  = getUserData bh
 713         bh' = setUserData bh (ud{ ud_put_name = putNameLiterally })
 714     put_ bh' inst
 715
 716 lookupOccEnvL :: OccEnv [v] -> OccName -> [v]
 717 lookupOccEnvL env k = lookupOccEnv env k `orElse` []
 718
 719 -- used when we want to fingerprint a structure without depending on the
 720 -- fingerprints of external Names that it refers to.
 721 putNameLiterally :: BinHandle -> Name -> IO ()
 722 putNameLiterally bh name = ASSERT( isExternalName name )
 723   do { put_ bh $! nameModule name
 724      ; put_ bh $! nameOccName name }
 725
 726 computeFingerprint :: Binary a
 727                    => DynFlags
 728                    -> (BinHandle -> Name -> IO ())
 729                    -> a
 730                    -> IO Fingerprint
 731
 732 computeFingerprint _dflags put_name a = do
 733   bh <- openBinMem (3*1024) -- just less than a block
 734   ud <- newWriteState put_name putFS
 735   bh <- return $ setUserData bh ud
 736   put_ bh a
 737   fingerprintBinMem bh
 738
 739 {-
 740 -- for testing: use the md5sum command to generate fingerprints and
 741 -- compare the results against our built-in version.
 742   fp' <- oldMD5 dflags bh
 743   if fp /= fp' then pprPanic "computeFingerprint" (ppr fp <+> ppr fp')
 744                else return fp
 745
 746 oldMD5 dflags bh = do
 747   tmp <- newTempName dflags "bin"
 748   writeBinMem bh tmp
 749   tmp2 <- newTempName dflags "md5"
 750   let cmd = "md5sum " ++ tmp ++ " >" ++ tmp2
 751   r <- system cmd
 752   case r of
 753     ExitFailure _ -> ghcError (PhaseFailed cmd r)
 754     ExitSuccess -> do
 755         hash_str <- readFile tmp2
 756         return $! readHexFingerprint hash_str
 757 -}
 758
 759 instOrphWarn :: PrintUnqualified -> Instance -> WarnMsg
 760 instOrphWarn unqual inst
 761   = mkWarnMsg (getSrcSpan inst) unqual $
 762     hang (ptext (sLit "Warning: orphan instance:")) 2 (pprInstanceHdr inst)
 763
 764 ruleOrphWarn :: PrintUnqualified -> Module -> IfaceRule -> WarnMsg
 765 ruleOrphWarn unqual mod rule
 766   = mkWarnMsg silly_loc unqual $
 767     ptext (sLit "Orphan rule:") <+> ppr rule
 768   where
 769     silly_loc = srcLocSpan (mkSrcLoc (moduleNameFS (moduleName mod)) 1 1)
 770     -- We don't have a decent SrcSpan for a Rule, not even the CoreRule
 771     -- Could readily be fixed by adding a SrcSpan to CoreRule, if we wanted to
 772
 773 ----------------------
 774 -- mkOrphMap partitions instance decls or rules into
 775 --      (a) an OccEnv for ones that are not orphans,
 776 --          mapping the local OccName to a list of its decls
 777 --      (b) a list of orphan decls
 778 mkOrphMap :: (decl -> Maybe OccName)    -- (Just occ) for a non-orphan decl, keyed by occ
 779                                         -- Nothing for an orphan decl
 780           -> [decl]                     -- Sorted into canonical order
 781           -> (OccEnv [decl],            -- Non-orphan decls associated with their key;
 782                                         --      each sublist in canonical order
 783               [decl])                   -- Orphan decls; in canonical order
 784 mkOrphMap get_key decls
 785   = foldl go (emptyOccEnv, []) decls
 786   where
 787     go (non_orphs, orphs) d
 788         | Just occ <- get_key d
 789         = (extendOccEnv_Acc (:) singleton non_orphs occ d, orphs)
 790         | otherwise = (non_orphs, d:orphs)
 791 \end{code}
 792
 793
 794 %************************************************************************
 795 %*                                                                      *
 796        Keeping track of what we've slurped, and fingerprints
 797 %*                                                                      *
 798 %************************************************************************
 799
 800 \begin{code}
 801 mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> IO [Usage]
 802 mkUsageInfo hsc_env this_mod dir_imp_mods used_names
 803   = do  { eps <- hscEPS hsc_env
 804         ; let usages = mk_usage_info (eps_PIT eps) hsc_env this_mod
 805                                      dir_imp_mods used_names
 806         ; usages `seqList`  return usages }
 807          -- seq the list of Usages returned: occasionally these
 808          -- don't get evaluated for a while and we can end up hanging on to
 809          -- the entire collection of Ifaces.
 810
 811 mk_usage_info :: PackageIfaceTable
 812               -> HscEnv
 813               -> Module
 814               -> ImportedMods
 815               -> NameSet
 816               -> [Usage]
 817 mk_usage_info pit hsc_env this_mod direct_imports used_names
 818   = mapCatMaybes mkUsage usage_mods
 819   where
 820     hpt = hsc_HPT hsc_env
 821     dflags = hsc_dflags hsc_env
 822     this_pkg = thisPackage dflags
 823
 824     used_mods    = moduleEnvKeys ent_map
 825     dir_imp_mods = (moduleEnvKeys direct_imports)
 826     all_mods     = used_mods ++ filter (`notElem` used_mods) dir_imp_mods
 827     usage_mods   = sortBy stableModuleCmp all_mods
 828                         -- canonical order is imported, to avoid interface-file
 829                         -- wobblage.
 830
 831     -- ent_map groups together all the things imported and used
 832     -- from a particular module
 833     ent_map :: ModuleEnv [OccName]
 834     ent_map  = foldNameSet add_mv emptyModuleEnv used_names
 835      where
 836       add_mv name mv_map
 837         | isWiredInName name = mv_map  -- ignore wired-in names
 838         | otherwise
 839         = case nameModule_maybe name of
 840              Nothing  -> pprTrace "mkUsageInfo: internal name?" (ppr name) mv_map
 841              Just mod -> -- We use this fiddly lambda function rather than
 842                          -- (++) as the argument to extendModuleEnv_C to
 843                          -- avoid quadratic behaviour (trac #2680)
 844                          extendModuleEnv_C (\xs _ -> occ:xs) mv_map mod [occ]
 845                    where occ = nameOccName name
 846
 847     -- We want to create a Usage for a home module if
 848     --  a) we used something from it; has something in used_names
 849     --  b) we imported it, even if we used nothing from it
 850     --     (need to recompile if its export list changes: export_fprint)
 851     mkUsage :: Module -> Maybe Usage
 852     mkUsage mod
 853       | isNothing maybe_iface           -- We can't depend on it if we didn't
 854                                         -- load its interface.
 855       || mod == this_mod                -- We don't care about usages of
 856                                         -- things in *this* module
 857       = Nothing
 858
 859       | modulePackageId mod /= this_pkg
 860       = Just UsagePackageModule{ usg_mod      = mod,
 861                                  usg_mod_hash = mod_hash }
 862         -- for package modules, we record the module hash only
 863
 864       | (null used_occs
 865           && isNothing export_hash
 866           && not is_direct_import
 867           && not finsts_mod)
 868       = Nothing                 -- Record no usage info
 869         -- for directly-imported modules, we always want to record a usage
 870         -- on the orphan hash.  This is what triggers a recompilation if
 871         -- an orphan is added or removed somewhere below us in the future.
 872
 873       | otherwise
 874       = Just UsageHomeModule {
 875                       usg_mod_name = moduleName mod,
 876                       usg_mod_hash = mod_hash,
 877                       usg_exports  = export_hash,
 878                       usg_entities = fmToList ent_hashs }
 879       where
 880         maybe_iface  = lookupIfaceByModule dflags hpt pit mod
 881                 -- In one-shot mode, the interfaces for home-package
 882                 -- modules accumulate in the PIT not HPT.  Sigh.
 883
 884         is_direct_import = mod `elemModuleEnv` direct_imports
 885
 886         Just iface   = maybe_iface
 887         finsts_mod   = mi_finsts    iface
 888         hash_env     = mi_hash_fn   iface
 889         mod_hash     = mi_mod_hash  iface
 890         export_hash | depend_on_exports mod = Just (mi_exp_hash iface)
 891                     | otherwise             = Nothing
 892
 893         used_occs = lookupModuleEnv ent_map mod `orElse` []
 894
 895         -- Making a FiniteMap here ensures that (a) we remove duplicates
 896         -- when we have usages on several subordinates of a single parent,
 897         -- and (b) that the usages emerge in a canonical order, which
 898         -- is why we use FiniteMap rather than OccEnv: FiniteMap works
 899         -- using Ord on the OccNames, which is a lexicographic ordering.
 900         ent_hashs :: FiniteMap OccName Fingerprint
 901         ent_hashs = listToFM (map lookup_occ used_occs)
 902
 903         lookup_occ occ =
 904             case hash_env occ of
 905                 Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names)
 906                 Just r  -> r
 907
 908         depend_on_exports mod =
 909            case lookupModuleEnv direct_imports mod of
 910                 Just _ -> True
 911                   -- Even if we used 'import M ()', we have to register a
 912                   -- usage on the export list because we are sensitive to
 913                   -- changes in orphan instances/rules.
 914                 Nothing -> False
 915                   -- In GHC 6.8.x the above line read "True", and in
 916                   -- fact it recorded a dependency on *all* the
 917                   -- modules underneath in the dependency tree.  This
 918                   -- happens to make orphans work right, but is too
 919                   -- expensive: it'll read too many interface files.
 920                   -- The 'isNothing maybe_iface' check above saved us
 921                   -- from generating many of these usages (at least in
 922                   -- one-shot mode), but that's even more bogus!
 923 \end{code}
 924
 925 \begin{code}
 926 mkIfaceAnnotations :: [Annotation] -> [IfaceAnnotation]
 927 mkIfaceAnnotations = map mkIfaceAnnotation
 928
 929 mkIfaceAnnotation :: Annotation -> IfaceAnnotation
 930 mkIfaceAnnotation (Annotation { ann_target = target, ann_value = serialized }) = IfaceAnnotation {
 931         ifAnnotatedTarget = fmap nameOccName target,
 932         ifAnnotatedValue = serialized
 933     }
 934 \end{code}
 935
 936 \begin{code}
 937 mkIfaceExports :: [AvailInfo]
 938                -> [(Module, [GenAvailInfo OccName])]
 939                   -- Group by module and sort by occurrence
 940 mkIfaceExports exports
 941   = [ (mod, eltsFM avails)
 942     | (mod, avails) <- sortBy (stableModuleCmp `on` fst)
 943                               (moduleEnvToList groupFM)
 944                        -- NB. the fmToList is in a random order,
 945                        -- because Ord Module is not a predictable
 946                        -- ordering.  Hence we perform a final sort
 947                        -- using the stable Module ordering.
 948     ]
 949   where
 950         -- Group by the module where the exported entities are defined
 951         -- (which may not be the same for all Names in an Avail)
 952         -- Deliberately use FiniteMap rather than UniqFM so we
 953         -- get a canonical ordering
 954     groupFM :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
 955     groupFM = foldl add emptyModuleEnv exports
 956
 957     add_one :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
 958             -> Module -> GenAvailInfo OccName
 959             -> ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
 960     add_one env mod avail
 961       =  extendModuleEnv_C plusFM env mod
 962                 (unitFM (occNameFS (availName avail)) avail)
 963
 964         -- NB: we should not get T(X) and T(Y) in the export list
 965         --     else the plusFM will simply discard one!  They
 966         --     should have been combined by now.
 967     add env (Avail n)
 968       = ASSERT( isExternalName n )
 969         add_one env (nameModule n) (Avail (nameOccName n))
 970
 971     add env (AvailTC tc ns)
 972       = ASSERT( all isExternalName ns )
 973         foldl add_for_mod env mods
 974       where
 975         tc_occ = nameOccName tc
 976         mods   = nub (map nameModule ns)
 977                 -- Usually just one, but see Note [Original module]
 978
 979         add_for_mod env mod
 980             = add_one env mod (AvailTC tc_occ (sort names_from_mod))
 981               -- NB. sort the children, we need a canonical order
 982             where
 983               names_from_mod = [nameOccName n | n <- ns, nameModule n == mod]
 984 \end{code}
 985
 986 Note [Orignal module]
 987 ~~~~~~~~~~~~~~~~~~~~~
 988 Consider this:
 989         module X where { data family T }
 990         module Y( T(..) ) where { import X; data instance T Int = MkT Int }
 991 The exported Avail from Y will look like
 992         X.T{X.T, Y.MkT}
 993 That is, in Y,
 994   - only MkT is brought into scope by the data instance;
 995   - but the parent (used for grouping and naming in T(..) exports) is X.T
 996   - and in this case we export X.T too
 997
 998 In the result of MkIfaceExports, the names are grouped by defining module,
 999 so we may need to split up a single Avail into multiple ones.
1000
1001
1002 %************************************************************************
1003 %*                                                                      *
1004         Load the old interface file for this module (unless
1005         we have it aleady), and check whether it is up to date
1006
1007 %*                                                                      *
1008 %************************************************************************
1009
1010 \begin{code}
1011 checkOldIface :: HscEnv
1012               -> ModSummary
1013               -> Bool                   -- Source unchanged
1014               -> Maybe ModIface         -- Old interface from compilation manager, if any
1015               -> IO (RecompileRequired, Maybe ModIface)
1016
1017 checkOldIface hsc_env mod_summary source_unchanged maybe_iface
1018   = do  { showPass (hsc_dflags hsc_env)
1019                    ("Checking old interface for " ++
1020                         showSDoc (ppr (ms_mod mod_summary))) ;
1021
1022         ; initIfaceCheck hsc_env $
1023           check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1024      }
1025
1026 check_old_iface :: HscEnv -> ModSummary -> Bool -> Maybe ModIface
1027                 -> IfG (Bool, Maybe ModIface)
1028 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1029  =  do  -- CHECK WHETHER THE SOURCE HAS CHANGED
1030     { when (not source_unchanged)
1031            (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
1032
1033      -- If the source has changed and we're in interactive mode, avoid reading
1034      -- an interface; just return the one we might have been supplied with.
1035     ; let dflags = hsc_dflags hsc_env
1036     ; if not (isObjectTarget (hscTarget dflags)) && not source_unchanged then
1037          return (outOfDate, maybe_iface)
1038       else
1039       case maybe_iface of {
1040         Just old_iface -> do -- Use the one we already have
1041           { traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary))
1042           ; recomp <- checkVersions hsc_env source_unchanged mod_summary old_iface
1043           ; return (recomp, Just old_iface) }
1044
1045       ; Nothing -> do
1046
1047         -- Try and read the old interface for the current module
1048         -- from the .hi file left from the last time we compiled it
1049     { let iface_path = msHiFilePath mod_summary
1050     ; read_result <- readIface (ms_mod mod_summary) iface_path False
1051     ; case read_result of {
1052          Failed err -> do       -- Old interface file not found, or garbled; give up
1053                 { traceIf (text "FYI: cannot read old interface file:"
1054                                  $$ nest 4 err)
1055                 ; return (outOfDate, Nothing) }
1056
1057       ;  Succeeded iface -> do
1058
1059         -- We have got the old iface; check its versions
1060     { traceIf (text "Read the interface file" <+> text iface_path)
1061     ; recomp <- checkVersions hsc_env source_unchanged mod_summary iface
1062     ; return (recomp, Just iface)
1063     }}}}}
1064
1065 \end{code}
1066
1067 @recompileRequired@ is called from the HscMain.   It checks whether
1068 a recompilation is required.  It needs access to the persistent state,
1069 finder, etc, because it may have to load lots of interface files to
1070 check their versions.
1071
1072 \begin{code}
1073 type RecompileRequired = Bool
1074 upToDate, outOfDate :: Bool
1075 upToDate  = False       -- Recompile not required
1076 outOfDate = True        -- Recompile required
1077
1078 checkVersions :: HscEnv
1079               -> Bool           -- True <=> source unchanged
1080               -> ModSummary
1081               -> ModIface       -- Old interface
1082               -> IfG RecompileRequired
1083 checkVersions hsc_env source_unchanged mod_summary iface
1084   | not source_unchanged
1085   = return outOfDate
1086   | otherwise
1087   = do  { traceHiDiffs (text "Considering whether compilation is required for" <+>
1088                         ppr (mi_module iface) <> colon)
1089
1090         ; recomp <- checkDependencies hsc_env mod_summary iface
1091         ; if recomp then return outOfDate else do {
1092
1093         -- Source code unchanged and no errors yet... carry on
1094         --
1095         -- First put the dependent-module info, read from the old
1096         -- interface, into the envt, so that when we look for
1097         -- interfaces we look for the right one (.hi or .hi-boot)
1098         --
1099         -- It's just temporary because either the usage check will succeed
1100         -- (in which case we are done with this module) or it'll fail (in which
1101         -- case we'll compile the module from scratch anyhow).
1102         --
1103         -- We do this regardless of compilation mode, although in --make mode
1104         -- all the dependent modules should be in the HPT already, so it's
1105         -- quite redundant
1106           updateEps_ $ \eps  -> eps { eps_is_boot = mod_deps }
1107
1108         ; let this_pkg = thisPackage (hsc_dflags hsc_env)
1109         ; checkList [checkModUsage this_pkg u | u <- mi_usages iface]
1110     }}
1111   where
1112         -- This is a bit of a hack really
1113     mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)
1114     mod_deps = mkModDeps (dep_mods (mi_deps iface))
1115
1116
1117 -- If the direct imports of this module are resolved to targets that
1118 -- are not among the dependencies of the previous interface file,
1119 -- then we definitely need to recompile.  This catches cases like
1120 --   - an exposed package has been upgraded
1121 --   - we are compiling with different package flags
1122 --   - a home module that was shadowing a package module has been removed
1123 --   - a new home module has been added that shadows a package module
1124 -- See bug #1372.
1125 --
1126 -- Returns True if recompilation is required.
1127 checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired
1128 checkDependencies hsc_env summary iface
1129  = orM (map dep_missing (ms_imps summary ++ ms_srcimps summary))
1130   where
1131    prev_dep_mods = dep_mods (mi_deps iface)
1132    prev_dep_pkgs = dep_pkgs (mi_deps iface)
1133
1134    this_pkg = thisPackage (hsc_dflags hsc_env)
1135
1136    orM = foldr f (return False)
1137     where f m rest = do b <- m; if b then return True else rest
1138
1139    dep_missing (L _ (ImportDecl (L _ mod) pkg _ _ _ _)) = do
1140      find_res <- liftIO $ findImportedModule hsc_env mod pkg
1141      case find_res of
1142         Found _ mod
1143           | pkg == this_pkg
1144            -> if moduleName mod `notElem` map fst prev_dep_mods
1145                  then do traceHiDiffs $
1146                            text "imported module " <> quotes (ppr mod) <>
1147                            text " not among previous dependencies"
1148                          return outOfDate
1149                  else
1150                          return upToDate
1151           | otherwise
1152            -> if pkg `notElem` prev_dep_pkgs
1153                  then do traceHiDiffs $
1154                            text "imported module " <> quotes (ppr mod) <>
1155                            text " is from package " <> quotes (ppr pkg) <>
1156                            text ", which is not among previous dependencies"
1157                          return outOfDate
1158                  else
1159                          return upToDate
1160            where pkg = modulePackageId mod
1161         _otherwise  -> return outOfDate
1162
1163 needInterface :: Module -> (ModIface -> IfG RecompileRequired)
1164               -> IfG RecompileRequired
1165 needInterface mod continue
1166   = do  -- Load the imported interface if possible
1167     let doc_str = sep [ptext (sLit "need version info for"), ppr mod]
1168     traceHiDiffs (text "Checking usages for module" <+> ppr mod)
1169
1170     mb_iface <- loadInterface doc_str mod ImportBySystem
1171         -- Load the interface, but don't complain on failure;
1172         -- Instead, get an Either back which we can test
1173
1174     case mb_iface of
1175       Failed _ ->  (out_of_date (sep [ptext (sLit "Couldn't load interface for module"),
1176                                       ppr mod]))
1177                   -- Couldn't find or parse a module mentioned in the
1178                   -- old interface file.  Don't complain: it might
1179                   -- just be that the current module doesn't need that
1180                   -- import and it's been deleted
1181       Succeeded iface -> continue iface
1182
1183
1184 checkModUsage :: PackageId ->Usage -> IfG RecompileRequired
1185 -- Given the usage information extracted from the old
1186 -- M.hi file for the module being compiled, figure out
1187 -- whether M needs to be recompiled.
1188
1189 checkModUsage _this_pkg UsagePackageModule{
1190                                 usg_mod = mod,
1191                                 usg_mod_hash = old_mod_hash }
1192   = needInterface mod $ \iface -> do
1193     checkModuleFingerprint old_mod_hash (mi_mod_hash iface)
1194         -- We only track the ABI hash of package modules, rather than
1195         -- individual entity usages, so if the ABI hash changes we must
1196         -- recompile.  This is safe but may entail more recompilation when
1197         -- a dependent package has changed.
1198
1199 checkModUsage this_pkg UsageHomeModule{
1200                                 usg_mod_name = mod_name,
1201                                 usg_mod_hash = old_mod_hash,
1202                                 usg_exports = maybe_old_export_hash,
1203                                 usg_entities = old_decl_hash }
1204   = do
1205     let mod = mkModule this_pkg mod_name
1206     needInterface mod $ \iface -> do
1207
1208     let
1209         new_mod_hash    = mi_mod_hash    iface
1210         new_decl_hash   = mi_hash_fn     iface
1211         new_export_hash = mi_exp_hash    iface
1212
1213         -- CHECK MODULE
1214     recompile <- checkModuleFingerprint old_mod_hash new_mod_hash
1215     if not recompile then return upToDate else do
1216
1217         -- CHECK EXPORT LIST
1218     checkMaybeHash maybe_old_export_hash new_export_hash
1219         (ptext (sLit "  Export list changed")) $ do
1220
1221         -- CHECK ITEMS ONE BY ONE
1222     recompile <- checkList [ checkEntityUsage new_decl_hash u
1223                            | u <- old_decl_hash]
1224     if recompile
1225       then return outOfDate     -- This one failed, so just bail out now
1226       else up_to_date (ptext (sLit "  Great!  The bits I use are up to date"))
1227
1228 ------------------------
1229 checkModuleFingerprint :: Fingerprint -> Fingerprint -> IfG Bool
1230 checkModuleFingerprint old_mod_hash new_mod_hash
1231   | new_mod_hash == old_mod_hash
1232   = up_to_date (ptext (sLit "Module fingerprint unchanged"))
1233
1234   | otherwise
1235   = out_of_date_hash (ptext (sLit "  Module fingerprint has changed"))
1236                      old_mod_hash new_mod_hash
1237
1238 ------------------------
1239 checkMaybeHash :: Maybe Fingerprint -> Fingerprint -> SDoc
1240                -> IfG RecompileRequired -> IfG RecompileRequired
1241 checkMaybeHash maybe_old_hash new_hash doc continue
1242   | Just hash <- maybe_old_hash, hash /= new_hash
1243   = out_of_date_hash doc hash new_hash
1244   | otherwise
1245   = continue
1246
1247 ------------------------
1248 checkEntityUsage :: (OccName -> Maybe (OccName, Fingerprint))
1249                  -> (OccName, Fingerprint)
1250                  -> IfG Bool
1251 checkEntityUsage new_hash (name,old_hash)
1252   = case new_hash name of
1253
1254         Nothing       ->        -- We used it before, but it ain't there now
1255                           out_of_date (sep [ptext (sLit "No longer exported:"), ppr name])
1256
1257         Just (_, new_hash)      -- It's there, but is it up to date?
1258           | new_hash == old_hash -> do traceHiDiffs (text "  Up to date" <+> ppr name <+> parens (ppr new_hash))
1259                                        return upToDate
1260           | otherwise            -> out_of_date_hash (ptext (sLit "  Out of date:") <+> ppr name)
1261                                                      old_hash new_hash
1262
1263 up_to_date, out_of_date :: SDoc -> IfG Bool
1264 up_to_date  msg = traceHiDiffs msg >> return upToDate
1265 out_of_date msg = traceHiDiffs msg >> return outOfDate
1266
1267 out_of_date_hash :: SDoc -> Fingerprint -> Fingerprint -> IfG Bool
1268 out_of_date_hash msg old_hash new_hash
1269   = out_of_date (hsep [msg, ppr old_hash, ptext (sLit "->"), ppr new_hash])
1270
1271 ----------------------
1272 checkList :: [IfG RecompileRequired] -> IfG RecompileRequired
1273 -- This helper is used in two places
1274 checkList []             = return upToDate
1275 checkList (check:checks) = do recompile <- check
1276                               if recompile
1277                                 then return outOfDate
1278                                 else checkList checks
1279 \end{code}
1280
1281 %************************************************************************
1282 %*                                                                      *
1283                 Converting things to their Iface equivalents
1284 %*                                                                      *
1285 %************************************************************************
1286
1287 \begin{code}
1288 tyThingToIfaceDecl :: TyThing -> IfaceDecl
1289 -- Assumption: the thing is already tidied, so that locally-bound names
1290 --             (lambdas, for-alls) already have non-clashing OccNames
1291 -- Reason: Iface stuff uses OccNames, and the conversion here does
1292 --         not do tidying on the way
1293 tyThingToIfaceDecl (AnId id)
1294   = IfaceId { ifName      = getOccName id,
1295               ifType      = toIfaceType (idType id),
1296               ifIdDetails = toIfaceIdDetails (idDetails id),
1297               ifIdInfo    = info }
1298   where
1299     info = case toIfaceIdInfo (idInfo id) of
1300                 []    -> NoInfo
1301                 items -> HasInfo items
1302
1303 tyThingToIfaceDecl (AClass clas)
1304   = IfaceClass { ifCtxt   = toIfaceContext sc_theta,
1305                  ifName   = getOccName clas,
1306                  ifTyVars = toIfaceTvBndrs clas_tyvars,
1307                  ifFDs    = map toIfaceFD clas_fds,
1308                  ifATs    = map (tyThingToIfaceDecl . ATyCon) clas_ats,
1309                  ifSigs   = map toIfaceClassOp op_stuff,
1310                  ifRec    = boolToRecFlag (isRecursiveTyCon tycon) }
1311   where
1312     (clas_tyvars, clas_fds, sc_theta, _, clas_ats, op_stuff)
1313       = classExtraBigSig clas
1314     tycon = classTyCon clas
1315
1316     toIfaceClassOp (sel_id, def_meth)
1317         = ASSERT(sel_tyvars == clas_tyvars)
1318           IfaceClassOp (getOccName sel_id) def_meth (toIfaceType op_ty)
1319         where
1320                 -- Be careful when splitting the type, because of things
1321                 -- like         class Foo a where
1322                 --                op :: (?x :: String) => a -> a
1323                 -- and          class Baz a where
1324                 --                op :: (Ord a) => a -> a
1325           (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
1326           op_ty                = funResultTy rho_ty
1327
1328     toIfaceFD (tvs1, tvs2) = (map getFS tvs1, map getFS tvs2)
1329
1330 tyThingToIfaceDecl (ATyCon tycon)
1331   | isSynTyCon tycon
1332   = IfaceSyn {  ifName    = getOccName tycon,
1333                 ifTyVars  = toIfaceTvBndrs tyvars,
1334                 ifSynRhs  = syn_rhs,
1335                 ifSynKind = syn_ki,
1336                 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)
1337              }
1338
1339   | isAlgTyCon tycon
1340   = IfaceData { ifName    = getOccName tycon,
1341                 ifTyVars  = toIfaceTvBndrs tyvars,
1342                 ifCtxt    = toIfaceContext (tyConStupidTheta tycon),
1343                 ifCons    = ifaceConDecls (algTyConRhs tycon),
1344                 ifRec     = boolToRecFlag (isRecursiveTyCon tycon),
1345                 ifGadtSyntax = isGadtSyntaxTyCon tycon,
1346                 ifGeneric = tyConHasGenerics tycon,
1347                 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)}
1348
1349   | isForeignTyCon tycon
1350   = IfaceForeign { ifName    = getOccName tycon,
1351                    ifExtName = tyConExtName tycon }
1352
1353   | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
1354   where
1355     tyvars = tyConTyVars tycon
1356     (syn_rhs, syn_ki)
1357        = case synTyConRhs tycon of
1358             OpenSynTyCon ki _ -> (Nothing,               toIfaceType ki)
1359             SynonymTyCon ty   -> (Just (toIfaceType ty), toIfaceType (typeKind ty))
1360
1361     ifaceConDecls (NewTyCon { data_con = con })     =
1362       IfNewTyCon  (ifaceConDecl con)
1363     ifaceConDecls (DataTyCon { data_cons = cons })  =
1364       IfDataTyCon (map ifaceConDecl cons)
1365     ifaceConDecls OpenTyCon {}                      = IfOpenDataTyCon
1366     ifaceConDecls AbstractTyCon                     = IfAbstractTyCon
1367         -- The last case happens when a TyCon has been trimmed during tidying
1368         -- Furthermore, tyThingToIfaceDecl is also used
1369         -- in TcRnDriver for GHCi, when browsing a module, in which case the
1370         -- AbstractTyCon case is perfectly sensible.
1371
1372     ifaceConDecl data_con
1373         = IfCon   { ifConOcc     = getOccName (dataConName data_con),
1374                     ifConInfix   = dataConIsInfix data_con,
1375                     ifConWrapper = isJust (dataConWrapId_maybe data_con),
1376                     ifConUnivTvs = toIfaceTvBndrs (dataConUnivTyVars data_con),
1377                     ifConExTvs   = toIfaceTvBndrs (dataConExTyVars data_con),
1378                     ifConEqSpec  = to_eq_spec (dataConEqSpec data_con),
1379                     ifConCtxt    = toIfaceContext (dataConEqTheta data_con ++ dataConDictTheta data_con),
1380                     ifConArgTys  = map toIfaceType (dataConOrigArgTys data_con),
1381                     ifConFields  = map getOccName
1382                                        (dataConFieldLabels data_con),
1383                     ifConStricts = dataConStrictMarks data_con }
1384
1385     to_eq_spec spec = [(getOccName tv, toIfaceType ty) | (tv,ty) <- spec]
1386
1387     famInstToIface Nothing                    = Nothing
1388     famInstToIface (Just (famTyCon, instTys)) =
1389       Just (toIfaceTyCon famTyCon, map toIfaceType instTys)
1390
1391 tyThingToIfaceDecl (ADataCon dc)
1392  = pprPanic "toIfaceDecl" (ppr dc)      -- Should be trimmed out earlier
1393
1394
1395 getFS :: NamedThing a => a -> FastString
1396 getFS x = occNameFS (getOccName x)
1397
1398 --------------------------
1399 instanceToIfaceInst :: Instance -> IfaceInst
1400 instanceToIfaceInst (Instance { is_dfun = dfun_id, is_flag = oflag,
1401                                 is_cls = cls_name, is_tcs = mb_tcs })
1402   = ASSERT( cls_name == className cls )
1403     IfaceInst { ifDFun    = dfun_name,
1404                 ifOFlag   = oflag,
1405                 ifInstCls = cls_name,
1406                 ifInstTys = map do_rough mb_tcs,
1407                 ifInstOrph = orph }
1408   where
1409     do_rough Nothing  = Nothing
1410     do_rough (Just n) = Just (toIfaceTyCon_name n)
1411
1412     dfun_name = idName dfun_id
1413     mod       = ASSERT( isExternalName dfun_name ) nameModule dfun_name
1414     is_local name = nameIsLocalOrFrom mod name
1415
1416         -- Compute orphanhood.  See Note [Orphans] in IfaceSyn
1417     (_, cls, tys) = tcSplitDFunTy (idType dfun_id)
1418                 -- Slightly awkward: we need the Class to get the fundeps
1419     (tvs, fds) = classTvsFds cls
1420     arg_names = [filterNameSet is_local (tyClsNamesOfType ty) | ty <- tys]
1421     orph | is_local cls_name = Just (nameOccName cls_name)
1422          | all isJust mb_ns  = ASSERT( not (null mb_ns) ) head mb_ns
1423          | otherwise         = Nothing
1424
1425     mb_ns :: [Maybe OccName]    -- One for each fundep; a locally-defined name
1426                                 -- that is not in the "determined" arguments
1427     mb_ns | null fds   = [choose_one arg_names]
1428           | otherwise  = map do_one fds
1429     do_one (_ltvs, rtvs) = choose_one [ns | (tv,ns) <- tvs `zip` arg_names
1430                                           , not (tv `elem` rtvs)]
1431
1432     choose_one :: [NameSet] -> Maybe OccName
1433     choose_one nss = case nameSetToList (unionManyNameSets nss) of
1434                         []      -> Nothing
1435                         (n : _) -> Just (nameOccName n)
1436
1437 --------------------------
1438 famInstToIfaceFamInst :: FamInst -> IfaceFamInst
1439 famInstToIfaceFamInst (FamInst { fi_tycon = tycon,
1440                                  fi_fam = fam,
1441                                  fi_tcs = mb_tcs })
1442   = IfaceFamInst { ifFamInstTyCon  = toIfaceTyCon tycon
1443                  , ifFamInstFam    = fam
1444                  , ifFamInstTys    = map do_rough mb_tcs }
1445   where
1446     do_rough Nothing  = Nothing
1447     do_rough (Just n) = Just (toIfaceTyCon_name n)
1448
1449 --------------------------
1450 toIfaceLetBndr :: Id -> IfaceLetBndr
1451 toIfaceLetBndr id  = IfLetBndr (occNameFS (getOccName id))
1452                                (toIfaceType (idType id))
1453                                prag_info
1454   where
1455         -- Stripped-down version of tcIfaceIdInfo
1456         -- Change this if you want to export more IdInfo for
1457         -- non-top-level Ids.  Don't forget to change
1458         -- CoreTidy.tidyLetBndr too!
1459         --
1460         -- See Note [IdInfo on nested let-bindings] in IfaceSyn
1461     id_info = idInfo id
1462     inline_prag = inlinePragInfo id_info
1463     prag_info | isDefaultInlinePragma inline_prag = NoInfo
1464               | otherwise                         = HasInfo [HsInline inline_prag]
1465
1466 --------------------------
1467 toIfaceIdDetails :: IdDetails -> IfaceIdDetails
1468 toIfaceIdDetails VanillaId                      = IfVanillaId
1469 toIfaceIdDetails (DFunId {})                    = IfDFunId
1470 toIfaceIdDetails (RecSelId { sel_naughty = n
1471                            , sel_tycon = tc })  = IfRecSelId (toIfaceTyCon tc) n
1472 toIfaceIdDetails other                          = pprTrace "toIfaceIdDetails" (ppr other)
1473                                                   IfVanillaId   -- Unexpected
1474
1475 toIfaceIdInfo :: IdInfo -> [IfaceInfoItem]
1476 toIfaceIdInfo id_info
1477   = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
1478                inline_hsinfo,  unfold_hsinfo]
1479                -- NB: strictness must be before unfolding
1480                -- See TcIface.tcUnfolding
1481   where
1482     ------------  Arity  --------------
1483     arity_info = arityInfo id_info
1484     arity_hsinfo | arity_info == 0 = Nothing
1485                  | otherwise       = Just (HsArity arity_info)
1486
1487     ------------ Caf Info --------------
1488     caf_info   = cafInfo id_info
1489     caf_hsinfo = case caf_info of
1490                    NoCafRefs -> Just HsNoCafRefs
1491                    _other    -> Nothing
1492
1493     ------------  Strictness  --------------
1494         -- No point in explicitly exporting TopSig
1495     strict_hsinfo = case strictnessInfo id_info of
1496                         Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
1497                         _other                        -> Nothing
1498
1499     ------------  Unfolding  --------------
1500     unfold_hsinfo = toIfUnfolding loop_breaker (unfoldingInfo id_info)
1501     loop_breaker  = isNonRuleLoopBreaker (occInfo id_info)
1502
1503     ------------  Inline prag  --------------
1504     inline_prag = inlinePragInfo id_info
1505     inline_hsinfo | isDefaultInlinePragma inline_prag = Nothing
1506                   | otherwise = Just (HsInline inline_prag)
1507
1508 --------------------------
1509 toIfUnfolding :: Bool -> Unfolding -> Maybe IfaceInfoItem
1510 toIfUnfolding lb unf@(CoreUnfolding { uf_tmpl = rhs, uf_arity = arity
1511                                     , uf_src = src, uf_guidance = guidance })
1512   = Just $ HsUnfold lb $
1513     case src of
1514         InlineRule {}
1515           -> case guidance of
1516                UnfWhen unsat_ok boring_ok -> IfInlineRule arity unsat_ok boring_ok (toIfaceExpr rhs)
1517                _other                     -> pprPanic "toIfUnfolding" (ppr unf)
1518         InlineWrapper w  -> IfWrapper arity (idName w)
1519         InlineCompulsory -> IfCompulsory (toIfaceExpr rhs)
1520         InlineRhs        -> IfCoreUnfold (toIfaceExpr rhs)
1521         -- Yes, even if guidance is UnfNever, expose the unfolding
1522         -- If we didn't want to expose the unfolding, TidyPgm would
1523         -- have stuck in NoUnfolding.  For supercompilation we want
1524         -- to see that unfolding!
1525
1526 toIfUnfolding lb (DFunUnfolding _con ops)
1527   = Just (HsUnfold lb (IfDFunUnfold (map toIfaceExpr ops)))
1528       -- No need to serialise the data constructor;
1529       -- we can recover it from the type of the dfun
1530
1531 toIfUnfolding _ _
1532   = Nothing
1533
1534 --------------------------
1535 coreRuleToIfaceRule :: Module -> CoreRule -> IfaceRule
1536 coreRuleToIfaceRule _ (BuiltinRule { ru_fn = fn})
1537   = pprTrace "toHsRule: builtin" (ppr fn) $
1538     bogusIfaceRule fn
1539
1540 coreRuleToIfaceRule mod (Rule { ru_name = name, ru_fn = fn,
1541                                 ru_act = act, ru_bndrs = bndrs,
1542                                 ru_args = args, ru_rhs = rhs })
1543   = IfaceRule { ifRuleName  = name, ifActivation = act,
1544                 ifRuleBndrs = map toIfaceBndr bndrs,
1545                 ifRuleHead  = fn,
1546                 ifRuleArgs  = map do_arg args,
1547                 ifRuleRhs   = toIfaceExpr rhs,
1548                 ifRuleOrph  = orph }
1549   where
1550         -- For type args we must remove synonyms from the outermost
1551         -- level.  Reason: so that when we read it back in we'll
1552         -- construct the same ru_rough field as we have right now;
1553         -- see tcIfaceRule
1554     do_arg (Type ty) = IfaceType (toIfaceType (deNoteType ty))
1555     do_arg arg       = toIfaceExpr arg
1556
1557         -- Compute orphanhood.  See Note [Orphans] in IfaceSyn
1558         -- A rule is an orphan only if none of the variables
1559         -- mentioned on its left-hand side are locally defined
1560     lhs_names = fn : nameSetToList (exprsFreeNames args)
1561                 -- No need to delete bndrs, because
1562                 -- exprsFreeNames finds only External names
1563
1564     orph = case filter (nameIsLocalOrFrom mod) lhs_names of
1565                         (n : _) -> Just (nameOccName n)
1566                         []      -> Nothing
1567
1568 bogusIfaceRule :: Name -> IfaceRule
1569 bogusIfaceRule id_name
1570   = IfaceRule { ifRuleName = fsLit "bogus", ifActivation = NeverActive,
1571         ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
1572         ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing }
1573
1574 ---------------------
1575 toIfaceExpr :: CoreExpr -> IfaceExpr
1576 toIfaceExpr (Var v)       = toIfaceVar v
1577 toIfaceExpr (Lit l)       = IfaceLit l
1578 toIfaceExpr (Type ty)     = IfaceType (toIfaceType ty)
1579 toIfaceExpr (Lam x b)     = IfaceLam (toIfaceBndr x) (toIfaceExpr b)
1580 toIfaceExpr (App f a)     = toIfaceApp f [a]
1581 toIfaceExpr (Case s x ty as) = IfaceCase (toIfaceExpr s) (getFS x) (toIfaceType ty) (map toIfaceAlt as)
1582 toIfaceExpr (Let b e)     = IfaceLet (toIfaceBind b) (toIfaceExpr e)
1583 toIfaceExpr (Cast e co)   = IfaceCast (toIfaceExpr e) (toIfaceType co)
1584 toIfaceExpr (Note n e)    = IfaceNote (toIfaceNote n) (toIfaceExpr e)
1585
1586 ---------------------
1587 toIfaceNote :: Note -> IfaceNote
1588 toIfaceNote (SCC cc)      = IfaceSCC cc
1589 toIfaceNote (CoreNote s)  = IfaceCoreNote s
1590
1591 ---------------------
1592 toIfaceBind :: Bind Id -> IfaceBinding
1593 toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)
1594 toIfaceBind (Rec prs)    = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]
1595
1596 ---------------------
1597 toIfaceAlt :: (AltCon, [Var], CoreExpr)
1598            -> (IfaceConAlt, [FastString], IfaceExpr)
1599 toIfaceAlt (c,bs,r) = (toIfaceCon c, map getFS bs, toIfaceExpr r)
1600
1601 ---------------------
1602 toIfaceCon :: AltCon -> IfaceConAlt
1603 toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
1604                         | otherwise       = IfaceDataAlt (getName dc)
1605                         where
1606                           tc = dataConTyCon dc
1607
1608 toIfaceCon (LitAlt l) = IfaceLitAlt l
1609 toIfaceCon DEFAULT    = IfaceDefault
1610
1611 ---------------------
1612 toIfaceApp :: Expr CoreBndr -> [Arg CoreBndr] -> IfaceExpr
1613 toIfaceApp (App f a) as = toIfaceApp f (a:as)
1614 toIfaceApp (Var v) as
1615   = case isDataConWorkId_maybe v of
1616         -- We convert the *worker* for tuples into IfaceTuples
1617         Just dc |  isTupleTyCon tc && saturated
1618                 -> IfaceTuple (tupleTyConBoxity tc) tup_args
1619           where
1620             val_args  = dropWhile isTypeArg as
1621             saturated = val_args `lengthIs` idArity v
1622             tup_args  = map toIfaceExpr val_args
1623             tc        = dataConTyCon dc
1624
1625         _ -> mkIfaceApps (toIfaceVar v) as
1626
1627 toIfaceApp e as = mkIfaceApps (toIfaceExpr e) as
1628
1629 mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr
1630 mkIfaceApps f as = foldl (\f a -> IfaceApp f (toIfaceExpr a)) f as
1631
1632 ---------------------
1633 toIfaceVar :: Id -> IfaceExpr
1634 toIfaceVar v
1635   | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))
1636           -- Foreign calls have special syntax
1637   | isExternalName name             = IfaceExt name
1638   | Just (TickBox m ix) <- isTickBoxOp_maybe v
1639                                     = IfaceTick m ix
1640   | otherwise                       = IfaceLcl (getFS name)
1641   where
1642     name = idName v
1643 \end{code}