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