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,
 516                        orphan_hash,
 517                        dep_orphan_hashes,
 518                        dep_pkgs (mi_deps iface0))
 519                         -- dep_pkgs: see "Package Version Changes" on
 520                         -- wiki/Commentary/Compiler/RecompilationAvoidance
 521
 522    -- put the declarations in a canonical order, sorted by OccName
 523    let sorted_decls = eltsFM $ listToFM $
 524                           [(ifName d, e) | e@(_, d) <- decls_w_hashes]
 525
 526    -- the ABI hash depends on:
 527    --   - decls
 528    --   - export list
 529    --   - orphans
 530    --   - deprecations
 531    --   - XXX vect info?
 532    mod_hash <- computeFingerprint dflags putNameLiterally
 533                       (map fst sorted_decls,
 534                        export_hash,
 535                        orphan_hash,
 536                        mi_warns iface0)
 537
 538    -- The interface hash depends on:
 539    --    - the ABI hash, plus
 540    --    - usages
 541    --    - deps
 542    --    - hpc
 543    iface_hash <- computeFingerprint dflags putNameLiterally
 544                       (mod_hash,
 545                        mi_usages iface0,
 546                        sorted_deps,
 547                        mi_hpc iface0)
 548
 549    let
 550     no_change_at_all = Just iface_hash == mb_old_fingerprint
 551
 552     final_iface = iface0 {
 553                 mi_mod_hash    = mod_hash,
 554                 mi_iface_hash  = iface_hash,
 555                 mi_exp_hash    = export_hash,
 556                 mi_orphan_hash = orphan_hash,
 557                 mi_orphan      = not (null orph_rules && null orph_insts),
 558                 mi_finsts      = not . null $ mi_fam_insts iface0,
 559                 mi_decls       = sorted_decls,
 560                 mi_hash_fn     = lookupOccEnv local_env }
 561    --
 562    return (final_iface, no_change_at_all)
 563
 564   where
 565     this_mod = mi_module iface0
 566     dflags = hsc_dflags hsc_env
 567     this_pkg = thisPackage dflags
 568     (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph (mi_insts iface0)
 569     (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph (mi_rules iface0)
 570         -- ToDo: shouldn't we be splitting fam_insts into orphans and
 571         -- non-orphans?
 572     fam_insts = mi_fam_insts iface0
 573     fix_fn = mi_fix_fn iface0
 574
 575
 576 getOrphanHashes :: HscEnv -> [Module] -> IO [Fingerprint]
 577 getOrphanHashes hsc_env mods = do
 578   eps <- hscEPS hsc_env
 579   let
 580     hpt        = hsc_HPT hsc_env
 581     pit        = eps_PIT eps
 582     dflags     = hsc_dflags hsc_env
 583     get_orph_hash mod =
 584           case lookupIfaceByModule dflags hpt pit mod of
 585             Nothing    -> pprPanic "moduleOrphanHash" (ppr mod)
 586             Just iface -> mi_orphan_hash iface
 587   --
 588   return (map get_orph_hash mods)
 589
 590
 591 sortDependencies :: Dependencies -> Dependencies
 592 sortDependencies d
 593  = Deps { dep_mods   = sortBy (compare `on` (moduleNameFS.fst)) (dep_mods d),
 594           dep_pkgs   = sortBy (compare `on` packageIdFS)  (dep_pkgs d),
 595           dep_orphs  = sortBy stableModuleCmp (dep_orphs d),
 596           dep_finsts = sortBy stableModuleCmp (dep_finsts d) }
 597 \end{code}
 598
 599
 600 %************************************************************************
 601 %*                                                                      *
 602           The ABI of an IfaceDecl
 603 %*                                                                      *
 604 %************************************************************************
 605
 606 Note [The ABI of an IfaceDecl]
 607 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 608 The ABI of a declaration consists of:
 609
 610    (a) the full name of the identifier (inc. module and package,
 611        because these are used to construct the symbol name by which
 612        the identifier is known externally).
 613
 614    (b) the declaration itself, as exposed to clients.  That is, the
 615        definition of an Id is included in the fingerprint only if
 616        it is made available as as unfolding in the interface.
 617
 618    (c) the fixity of the identifier
 619    (d) for Ids: rules
 620    (e) for classes: instances, fixity & rules for methods
 621    (f) for datatypes: instances, fixity & rules for constrs
 622
 623 Items (c)-(f) are not stored in the IfaceDecl, but instead appear
 624 elsewhere in the interface file.  But they are *fingerprinted* with
 625 the Id itself. This is done by grouping (c)-(f) in IfaceDeclExtras,
 626 and fingerprinting that as part of the Id.
 627
 628 \begin{code}
 629 type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras)
 630
 631 data IfaceDeclExtras
 632   = IfaceIdExtras    Fixity [IfaceRule]
 633   | IfaceDataExtras  Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
 634   | IfaceClassExtras Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
 635   | IfaceSynExtras   Fixity
 636   | IfaceOtherDeclExtras
 637
 638 abiDecl :: IfaceDeclABI -> IfaceDecl
 639 abiDecl (_, decl, _) = decl
 640
 641 cmp_abiNames :: IfaceDeclABI -> IfaceDeclABI -> Ordering
 642 cmp_abiNames abi1 abi2 = ifName (abiDecl abi1) `compare`
 643                          ifName (abiDecl abi2)
 644
 645 freeNamesDeclABI :: IfaceDeclABI -> NameSet
 646 freeNamesDeclABI (_mod, decl, extras) =
 647   freeNamesIfDecl decl `unionNameSets` freeNamesDeclExtras extras
 648
 649 freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
 650 freeNamesDeclExtras (IfaceIdExtras    _ rules)
 651   = unionManyNameSets (map freeNamesIfRule rules)
 652 freeNamesDeclExtras (IfaceDataExtras  _ _insts subs)
 653   = unionManyNameSets (map freeNamesSub subs)
 654 freeNamesDeclExtras (IfaceClassExtras _ _insts subs)
 655   = unionManyNameSets (map freeNamesSub subs)
 656 freeNamesDeclExtras (IfaceSynExtras _)
 657   = emptyNameSet
 658 freeNamesDeclExtras IfaceOtherDeclExtras
 659   = emptyNameSet
 660
 661 freeNamesSub :: (Fixity,[IfaceRule]) -> NameSet
 662 freeNamesSub (_,rules) = unionManyNameSets (map freeNamesIfRule rules)
 663
 664 -- This instance is used only to compute fingerprints
 665 instance Binary IfaceDeclExtras where
 666   get _bh = panic "no get for IfaceDeclExtras"
 667   put_ bh (IfaceIdExtras fix rules) = do
 668    putByte bh 1; put_ bh fix; put_ bh rules
 669   put_ bh (IfaceDataExtras fix insts cons) = do
 670    putByte bh 2; put_ bh fix; put_ bh insts; put_ bh cons
 671   put_ bh (IfaceClassExtras fix insts methods) = do
 672    putByte bh 3; put_ bh fix; put_ bh insts; put_ bh methods
 673   put_ bh (IfaceSynExtras fix) = do
 674    putByte bh 4; put_ bh fix
 675   put_ bh IfaceOtherDeclExtras = do
 676    putByte bh 5
 677
 678 declExtras :: (OccName -> Fixity)
 679            -> OccEnv [IfaceRule]
 680            -> OccEnv [IfaceInst]
 681            -> IfaceDecl
 682            -> IfaceDeclExtras
 683
 684 declExtras fix_fn rule_env inst_env decl
 685   = case decl of
 686       IfaceId{} -> IfaceIdExtras (fix_fn n)
 687                         (lookupOccEnvL rule_env n)
 688       IfaceData{ifCons=cons} ->
 689                      IfaceDataExtras (fix_fn n)
 690                         (map IfaceInstABI $ lookupOccEnvL inst_env n)
 691                         (map (id_extras . ifConOcc) (visibleIfConDecls cons))
 692       IfaceClass{ifSigs=sigs} ->
 693                      IfaceClassExtras (fix_fn n)
 694                         (map IfaceInstABI $ lookupOccEnvL inst_env n)
 695                         [id_extras op | IfaceClassOp op _ _ <- sigs]
 696       IfaceSyn{} -> IfaceSynExtras (fix_fn n)
 697       _other -> IfaceOtherDeclExtras
 698   where
 699         n = ifName decl
 700         id_extras occ = (fix_fn occ, lookupOccEnvL rule_env occ)
 701
 702 --
 703 -- When hashing an instance, we hash only its structure, not the
 704 -- fingerprints of the things it mentions.  See the section on instances
 705 -- in the commentary,
 706 --    http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance
 707 --
 708 newtype IfaceInstABI = IfaceInstABI IfaceInst
 709
 710 instance Binary IfaceInstABI where
 711   get = panic "no get for IfaceInstABI"
 712   put_ bh (IfaceInstABI inst) = do
 713     let ud  = getUserData bh
 714         bh' = setUserData bh (ud{ ud_put_name = putNameLiterally })
 715     put_ bh' inst
 716
 717 lookupOccEnvL :: OccEnv [v] -> OccName -> [v]
 718 lookupOccEnvL env k = lookupOccEnv env k `orElse` []
 719
 720 -- used when we want to fingerprint a structure without depending on the
 721 -- fingerprints of external Names that it refers to.
 722 putNameLiterally :: BinHandle -> Name -> IO ()
 723 putNameLiterally bh name = ASSERT( isExternalName name )
 724   do { put_ bh $! nameModule name
 725      ; put_ bh $! nameOccName name }
 726
 727 computeFingerprint :: Binary a
 728                    => DynFlags
 729                    -> (BinHandle -> Name -> IO ())
 730                    -> a
 731                    -> IO Fingerprint
 732
 733 computeFingerprint _dflags put_name a = do
 734   bh <- openBinMem (3*1024) -- just less than a block
 735   ud <- newWriteState put_name putFS
 736   bh <- return $ setUserData bh ud
 737   put_ bh a
 738   fingerprintBinMem bh
 739
 740 {-
 741 -- for testing: use the md5sum command to generate fingerprints and
 742 -- compare the results against our built-in version.
 743   fp' <- oldMD5 dflags bh
 744   if fp /= fp' then pprPanic "computeFingerprint" (ppr fp <+> ppr fp')
 745                else return fp
 746
 747 oldMD5 dflags bh = do
 748   tmp <- newTempName dflags "bin"
 749   writeBinMem bh tmp
 750   tmp2 <- newTempName dflags "md5"
 751   let cmd = "md5sum " ++ tmp ++ " >" ++ tmp2
 752   r <- system cmd
 753   case r of
 754     ExitFailure _ -> ghcError (PhaseFailed cmd r)
 755     ExitSuccess -> do
 756         hash_str <- readFile tmp2
 757         return $! readHexFingerprint hash_str
 758 -}
 759
 760 instOrphWarn :: PrintUnqualified -> Instance -> WarnMsg
 761 instOrphWarn unqual inst
 762   = mkWarnMsg (getSrcSpan inst) unqual $
 763     hang (ptext (sLit "Warning: orphan instance:")) 2 (pprInstanceHdr inst)
 764
 765 ruleOrphWarn :: PrintUnqualified -> Module -> IfaceRule -> WarnMsg
 766 ruleOrphWarn unqual mod rule
 767   = mkWarnMsg silly_loc unqual $
 768     ptext (sLit "Orphan rule:") <+> ppr rule
 769   where
 770     silly_loc = srcLocSpan (mkSrcLoc (moduleNameFS (moduleName mod)) 1 1)
 771     -- We don't have a decent SrcSpan for a Rule, not even the CoreRule
 772     -- Could readily be fixed by adding a SrcSpan to CoreRule, if we wanted to
 773
 774 ----------------------
 775 -- mkOrphMap partitions instance decls or rules into
 776 --      (a) an OccEnv for ones that are not orphans,
 777 --          mapping the local OccName to a list of its decls
 778 --      (b) a list of orphan decls
 779 mkOrphMap :: (decl -> Maybe OccName)    -- (Just occ) for a non-orphan decl, keyed by occ
 780                                         -- Nothing for an orphan decl
 781           -> [decl]                     -- Sorted into canonical order
 782           -> (OccEnv [decl],            -- Non-orphan decls associated with their key;
 783                                         --      each sublist in canonical order
 784               [decl])                   -- Orphan decls; in canonical order
 785 mkOrphMap get_key decls
 786   = foldl go (emptyOccEnv, []) decls
 787   where
 788     go (non_orphs, orphs) d
 789         | Just occ <- get_key d
 790         = (extendOccEnv_Acc (:) singleton non_orphs occ d, orphs)
 791         | otherwise = (non_orphs, d:orphs)
 792 \end{code}
 793
 794
 795 %************************************************************************
 796 %*                                                                      *
 797        Keeping track of what we've slurped, and fingerprints
 798 %*                                                                      *
 799 %************************************************************************
 800
 801 \begin{code}
 802 mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> IO [Usage]
 803 mkUsageInfo hsc_env this_mod dir_imp_mods used_names
 804   = do  { eps <- hscEPS hsc_env
 805         ; let usages = mk_usage_info (eps_PIT eps) hsc_env this_mod
 806                                      dir_imp_mods used_names
 807         ; usages `seqList`  return usages }
 808          -- seq the list of Usages returned: occasionally these
 809          -- don't get evaluated for a while and we can end up hanging on to
 810          -- the entire collection of Ifaces.
 811
 812 mk_usage_info :: PackageIfaceTable
 813               -> HscEnv
 814               -> Module
 815               -> ImportedMods
 816               -> NameSet
 817               -> [Usage]
 818 mk_usage_info pit hsc_env this_mod direct_imports used_names
 819   = mapCatMaybes mkUsage usage_mods
 820   where
 821     hpt = hsc_HPT hsc_env
 822     dflags = hsc_dflags hsc_env
 823     this_pkg = thisPackage dflags
 824
 825     used_mods    = moduleEnvKeys ent_map
 826     dir_imp_mods = (moduleEnvKeys direct_imports)
 827     all_mods     = used_mods ++ filter (`notElem` used_mods) dir_imp_mods
 828     usage_mods   = sortBy stableModuleCmp all_mods
 829                         -- canonical order is imported, to avoid interface-file
 830                         -- wobblage.
 831
 832     -- ent_map groups together all the things imported and used
 833     -- from a particular module
 834     ent_map :: ModuleEnv [OccName]
 835     ent_map  = foldNameSet add_mv emptyModuleEnv used_names
 836      where
 837       add_mv name mv_map
 838         | isWiredInName name = mv_map  -- ignore wired-in names
 839         | otherwise
 840         = case nameModule_maybe name of
 841              Nothing  -> pprTrace "mkUsageInfo: internal name?" (ppr name) mv_map
 842              Just mod -> -- We use this fiddly lambda function rather than
 843                          -- (++) as the argument to extendModuleEnv_C to
 844                          -- avoid quadratic behaviour (trac #2680)
 845                          extendModuleEnv_C (\xs _ -> occ:xs) mv_map mod [occ]
 846                    where occ = nameOccName name
 847
 848     -- We want to create a Usage for a home module if
 849     --  a) we used something from it; has something in used_names
 850     --  b) we imported it, even if we used nothing from it
 851     --     (need to recompile if its export list changes: export_fprint)
 852     mkUsage :: Module -> Maybe Usage
 853     mkUsage mod
 854       | isNothing maybe_iface           -- We can't depend on it if we didn't
 855                                         -- load its interface.
 856       || mod == this_mod                -- We don't care about usages of
 857                                         -- things in *this* module
 858       = Nothing
 859
 860       | modulePackageId mod /= this_pkg
 861       = Just UsagePackageModule{ usg_mod      = mod,
 862                                  usg_mod_hash = mod_hash }
 863         -- for package modules, we record the module hash only
 864
 865       | (null used_occs
 866           && isNothing export_hash
 867           && not is_direct_import
 868           && not finsts_mod)
 869       = Nothing                 -- Record no usage info
 870         -- for directly-imported modules, we always want to record a usage
 871         -- on the orphan hash.  This is what triggers a recompilation if
 872         -- an orphan is added or removed somewhere below us in the future.
 873
 874       | otherwise
 875       = Just UsageHomeModule {
 876                       usg_mod_name = moduleName mod,
 877                       usg_mod_hash = mod_hash,
 878                       usg_exports  = export_hash,
 879                       usg_entities = fmToList ent_hashs }
 880       where
 881         maybe_iface  = lookupIfaceByModule dflags hpt pit mod
 882                 -- In one-shot mode, the interfaces for home-package
 883                 -- modules accumulate in the PIT not HPT.  Sigh.
 884
 885         is_direct_import = mod `elemModuleEnv` direct_imports
 886
 887         Just iface   = maybe_iface
 888         finsts_mod   = mi_finsts    iface
 889         hash_env     = mi_hash_fn   iface
 890         mod_hash     = mi_mod_hash  iface
 891         export_hash | depend_on_exports mod = Just (mi_exp_hash iface)
 892                     | otherwise             = Nothing
 893
 894         used_occs = lookupModuleEnv ent_map mod `orElse` []
 895
 896         -- Making a FiniteMap here ensures that (a) we remove duplicates
 897         -- when we have usages on several subordinates of a single parent,
 898         -- and (b) that the usages emerge in a canonical order, which
 899         -- is why we use FiniteMap rather than OccEnv: FiniteMap works
 900         -- using Ord on the OccNames, which is a lexicographic ordering.
 901         ent_hashs :: FiniteMap OccName Fingerprint
 902         ent_hashs = listToFM (map lookup_occ used_occs)
 903
 904         lookup_occ occ =
 905             case hash_env occ of
 906                 Nothing -> pprPanic "mkUsage" (ppr mod <+> ppr occ <+> ppr used_names)
 907                 Just r  -> r
 908
 909         depend_on_exports mod =
 910            case lookupModuleEnv direct_imports mod of
 911                 Just _ -> True
 912                   -- Even if we used 'import M ()', we have to register a
 913                   -- usage on the export list because we are sensitive to
 914                   -- changes in orphan instances/rules.
 915                 Nothing -> False
 916                   -- In GHC 6.8.x the above line read "True", and in
 917                   -- fact it recorded a dependency on *all* the
 918                   -- modules underneath in the dependency tree.  This
 919                   -- happens to make orphans work right, but is too
 920                   -- expensive: it'll read too many interface files.
 921                   -- The 'isNothing maybe_iface' check above saved us
 922                   -- from generating many of these usages (at least in
 923                   -- one-shot mode), but that's even more bogus!
 924 \end{code}
 925
 926 \begin{code}
 927 mkIfaceAnnotations :: [Annotation] -> [IfaceAnnotation]
 928 mkIfaceAnnotations = map mkIfaceAnnotation
 929
 930 mkIfaceAnnotation :: Annotation -> IfaceAnnotation
 931 mkIfaceAnnotation (Annotation { ann_target = target, ann_value = serialized }) = IfaceAnnotation {
 932         ifAnnotatedTarget = fmap nameOccName target,
 933         ifAnnotatedValue = serialized
 934     }
 935 \end{code}
 936
 937 \begin{code}
 938 mkIfaceExports :: [AvailInfo]
 939                -> [(Module, [GenAvailInfo OccName])]
 940                   -- Group by module and sort by occurrence
 941 mkIfaceExports exports
 942   = [ (mod, eltsFM avails)
 943     | (mod, avails) <- sortBy (stableModuleCmp `on` fst)
 944                               (moduleEnvToList groupFM)
 945                        -- NB. the fmToList is in a random order,
 946                        -- because Ord Module is not a predictable
 947                        -- ordering.  Hence we perform a final sort
 948                        -- using the stable Module ordering.
 949     ]
 950   where
 951         -- Group by the module where the exported entities are defined
 952         -- (which may not be the same for all Names in an Avail)
 953         -- Deliberately use FiniteMap rather than UniqFM so we
 954         -- get a canonical ordering
 955     groupFM :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
 956     groupFM = foldl add emptyModuleEnv exports
 957
 958     add_one :: ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
 959             -> Module -> GenAvailInfo OccName
 960             -> ModuleEnv (FiniteMap FastString (GenAvailInfo OccName))
 961     add_one env mod avail
 962       =  extendModuleEnv_C plusFM env mod
 963                 (unitFM (occNameFS (availName avail)) avail)
 964
 965         -- NB: we should not get T(X) and T(Y) in the export list
 966         --     else the plusFM will simply discard one!  They
 967         --     should have been combined by now.
 968     add env (Avail n)
 969       = ASSERT( isExternalName n )
 970         add_one env (nameModule n) (Avail (nameOccName n))
 971
 972     add env (AvailTC tc ns)
 973       = ASSERT( all isExternalName ns )
 974         foldl add_for_mod env mods
 975       where
 976         tc_occ = nameOccName tc
 977         mods   = nub (map nameModule ns)
 978                 -- Usually just one, but see Note [Original module]
 979
 980         add_for_mod env mod
 981             = add_one env mod (AvailTC tc_occ (sort names_from_mod))
 982               -- NB. sort the children, we need a canonical order
 983             where
 984               names_from_mod = [nameOccName n | n <- ns, nameModule n == mod]
 985 \end{code}
 986
 987 Note [Orignal module]
 988 ~~~~~~~~~~~~~~~~~~~~~
 989 Consider this:
 990         module X where { data family T }
 991         module Y( T(..) ) where { import X; data instance T Int = MkT Int }
 992 The exported Avail from Y will look like
 993         X.T{X.T, Y.MkT}
 994 That is, in Y,
 995   - only MkT is brought into scope by the data instance;
 996   - but the parent (used for grouping and naming in T(..) exports) is X.T
 997   - and in this case we export X.T too
 998
 999 In the result of MkIfaceExports, the names are grouped by defining module,
1000 so we may need to split up a single Avail into multiple ones.
1001
1002
1003 %************************************************************************
1004 %*                                                                      *
1005         Load the old interface file for this module (unless
1006         we have it aleady), and check whether it is up to date
1007
1008 %*                                                                      *
1009 %************************************************************************
1010
1011 \begin{code}
1012 checkOldIface :: HscEnv
1013               -> ModSummary
1014               -> Bool                   -- Source unchanged
1015               -> Maybe ModIface         -- Old interface from compilation manager, if any
1016               -> IO (RecompileRequired, Maybe ModIface)
1017
1018 checkOldIface hsc_env mod_summary source_unchanged maybe_iface
1019   = do  { showPass (hsc_dflags hsc_env)
1020                    ("Checking old interface for " ++
1021                         showSDoc (ppr (ms_mod mod_summary))) ;
1022
1023         ; initIfaceCheck hsc_env $
1024           check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1025      }
1026
1027 check_old_iface :: HscEnv -> ModSummary -> Bool -> Maybe ModIface
1028                 -> IfG (Bool, Maybe ModIface)
1029 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
1030  =  do  -- CHECK WHETHER THE SOURCE HAS CHANGED
1031     { when (not source_unchanged)
1032            (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
1033
1034      -- If the source has changed and we're in interactive mode, avoid reading
1035      -- an interface; just return the one we might have been supplied with.
1036     ; let dflags = hsc_dflags hsc_env
1037     ; if not (isObjectTarget (hscTarget dflags)) && not source_unchanged then
1038          return (outOfDate, maybe_iface)
1039       else
1040       case maybe_iface of {
1041         Just old_iface -> do -- Use the one we already have
1042           { traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary))
1043           ; recomp <- checkVersions hsc_env source_unchanged mod_summary old_iface
1044           ; return (recomp, Just old_iface) }
1045
1046       ; Nothing -> do
1047
1048         -- Try and read the old interface for the current module
1049         -- from the .hi file left from the last time we compiled it
1050     { let iface_path = msHiFilePath mod_summary
1051     ; read_result <- readIface (ms_mod mod_summary) iface_path False
1052     ; case read_result of {
1053          Failed err -> do       -- Old interface file not found, or garbled; give up
1054                 { traceIf (text "FYI: cannot read old interface file:"
1055                                  $$ nest 4 err)
1056                 ; return (outOfDate, Nothing) }
1057
1058       ;  Succeeded iface -> do
1059
1060         -- We have got the old iface; check its versions
1061     { traceIf (text "Read the interface file" <+> text iface_path)
1062     ; recomp <- checkVersions hsc_env source_unchanged mod_summary iface
1063     ; return (recomp, Just iface)
1064     }}}}}
1065
1066 \end{code}
1067
1068 @recompileRequired@ is called from the HscMain.   It checks whether
1069 a recompilation is required.  It needs access to the persistent state,
1070 finder, etc, because it may have to load lots of interface files to
1071 check their versions.
1072
1073 \begin{code}
1074 type RecompileRequired = Bool
1075 upToDate, outOfDate :: Bool
1076 upToDate  = False       -- Recompile not required
1077 outOfDate = True        -- Recompile required
1078
1079 checkVersions :: HscEnv
1080               -> Bool           -- True <=> source unchanged
1081               -> ModSummary
1082               -> ModIface       -- Old interface
1083               -> IfG RecompileRequired
1084 checkVersions hsc_env source_unchanged mod_summary iface
1085   | not source_unchanged
1086   = return outOfDate
1087   | otherwise
1088   = do  { traceHiDiffs (text "Considering whether compilation is required for" <+>
1089                         ppr (mi_module iface) <> colon)
1090
1091         ; recomp <- checkDependencies hsc_env mod_summary iface
1092         ; if recomp then return outOfDate else do {
1093
1094         -- Source code unchanged and no errors yet... carry on
1095         --
1096         -- First put the dependent-module info, read from the old
1097         -- interface, into the envt, so that when we look for
1098         -- interfaces we look for the right one (.hi or .hi-boot)
1099         --
1100         -- It's just temporary because either the usage check will succeed
1101         -- (in which case we are done with this module) or it'll fail (in which
1102         -- case we'll compile the module from scratch anyhow).
1103         --
1104         -- We do this regardless of compilation mode, although in --make mode
1105         -- all the dependent modules should be in the HPT already, so it's
1106         -- quite redundant
1107           updateEps_ $ \eps  -> eps { eps_is_boot = mod_deps }
1108
1109         ; let this_pkg = thisPackage (hsc_dflags hsc_env)
1110         ; checkList [checkModUsage this_pkg u | u <- mi_usages iface]
1111     }}
1112   where
1113         -- This is a bit of a hack really
1114     mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)
1115     mod_deps = mkModDeps (dep_mods (mi_deps iface))
1116
1117
1118 -- If the direct imports of this module are resolved to targets that
1119 -- are not among the dependencies of the previous interface file,
1120 -- then we definitely need to recompile.  This catches cases like
1121 --   - an exposed package has been upgraded
1122 --   - we are compiling with different package flags
1123 --   - a home module that was shadowing a package module has been removed
1124 --   - a new home module has been added that shadows a package module
1125 -- See bug #1372.
1126 --
1127 -- Returns True if recompilation is required.
1128 checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired
1129 checkDependencies hsc_env summary iface
1130  = orM (map dep_missing (ms_imps summary ++ ms_srcimps summary))
1131   where
1132    prev_dep_mods = dep_mods (mi_deps iface)
1133    prev_dep_pkgs = dep_pkgs (mi_deps iface)
1134
1135    this_pkg = thisPackage (hsc_dflags hsc_env)
1136
1137    orM = foldr f (return False)
1138     where f m rest = do b <- m; if b then return True else rest
1139
1140    dep_missing (L _ (ImportDecl (L _ mod) pkg _ _ _ _)) = do
1141      find_res <- liftIO $ findImportedModule hsc_env mod pkg
1142      case find_res of
1143         Found _ mod
1144           | pkg == this_pkg
1145            -> if moduleName mod `notElem` map fst prev_dep_mods
1146                  then do traceHiDiffs $
1147                            text "imported module " <> quotes (ppr mod) <>
1148                            text " not among previous dependencies"
1149                          return outOfDate
1150                  else
1151                          return upToDate
1152           | otherwise
1153            -> if pkg `notElem` prev_dep_pkgs
1154                  then do traceHiDiffs $
1155                            text "imported module " <> quotes (ppr mod) <>
1156                            text " is from package " <> quotes (ppr pkg) <>
1157                            text ", which is not among previous dependencies"
1158                          return outOfDate
1159                  else
1160                          return upToDate
1161            where pkg = modulePackageId mod
1162         _otherwise  -> return outOfDate
1163
1164 needInterface :: Module -> (ModIface -> IfG RecompileRequired)
1165               -> IfG RecompileRequired
1166 needInterface mod continue
1167   = do  -- Load the imported interface if possible
1168     let doc_str = sep [ptext (sLit "need version info for"), ppr mod]
1169     traceHiDiffs (text "Checking usages for module" <+> ppr mod)
1170
1171     mb_iface <- loadInterface doc_str mod ImportBySystem
1172         -- Load the interface, but don't complain on failure;
1173         -- Instead, get an Either back which we can test
1174
1175     case mb_iface of
1176       Failed _ ->  (out_of_date (sep [ptext (sLit "Couldn't load interface for module"),
1177                                       ppr mod]))
1178                   -- Couldn't find or parse a module mentioned in the
1179                   -- old interface file.  Don't complain: it might
1180                   -- just be that the current module doesn't need that
1181                   -- import and it's been deleted
1182       Succeeded iface -> continue iface
1183
1184
1185 checkModUsage :: PackageId ->Usage -> IfG RecompileRequired
1186 -- Given the usage information extracted from the old
1187 -- M.hi file for the module being compiled, figure out
1188 -- whether M needs to be recompiled.
1189
1190 checkModUsage _this_pkg UsagePackageModule{
1191                                 usg_mod = mod,
1192                                 usg_mod_hash = old_mod_hash }
1193   = needInterface mod $ \iface -> do
1194     checkModuleFingerprint old_mod_hash (mi_mod_hash iface)
1195         -- We only track the ABI hash of package modules, rather than
1196         -- individual entity usages, so if the ABI hash changes we must
1197         -- recompile.  This is safe but may entail more recompilation when
1198         -- a dependent package has changed.
1199
1200 checkModUsage this_pkg UsageHomeModule{
1201                                 usg_mod_name = mod_name,
1202                                 usg_mod_hash = old_mod_hash,
1203                                 usg_exports = maybe_old_export_hash,
1204                                 usg_entities = old_decl_hash }
1205   = do
1206     let mod = mkModule this_pkg mod_name
1207     needInterface mod $ \iface -> do
1208
1209     let
1210         new_mod_hash    = mi_mod_hash    iface
1211         new_decl_hash   = mi_hash_fn     iface
1212         new_export_hash = mi_exp_hash    iface
1213
1214         -- CHECK MODULE
1215     recompile <- checkModuleFingerprint old_mod_hash new_mod_hash
1216     if not recompile then return upToDate else do
1217
1218         -- CHECK EXPORT LIST
1219     checkMaybeHash maybe_old_export_hash new_export_hash
1220         (ptext (sLit "  Export list changed")) $ do
1221
1222         -- CHECK ITEMS ONE BY ONE
1223     recompile <- checkList [ checkEntityUsage new_decl_hash u
1224                            | u <- old_decl_hash]
1225     if recompile
1226       then return outOfDate     -- This one failed, so just bail out now
1227       else up_to_date (ptext (sLit "  Great!  The bits I use are up to date"))
1228
1229 ------------------------
1230 checkModuleFingerprint :: Fingerprint -> Fingerprint -> IfG Bool
1231 checkModuleFingerprint old_mod_hash new_mod_hash
1232   | new_mod_hash == old_mod_hash
1233   = up_to_date (ptext (sLit "Module fingerprint unchanged"))
1234
1235   | otherwise
1236   = out_of_date_hash (ptext (sLit "  Module fingerprint has changed"))
1237                      old_mod_hash new_mod_hash
1238
1239 ------------------------
1240 checkMaybeHash :: Maybe Fingerprint -> Fingerprint -> SDoc
1241                -> IfG RecompileRequired -> IfG RecompileRequired
1242 checkMaybeHash maybe_old_hash new_hash doc continue
1243   | Just hash <- maybe_old_hash, hash /= new_hash
1244   = out_of_date_hash doc hash new_hash
1245   | otherwise
1246   = continue
1247
1248 ------------------------
1249 checkEntityUsage :: (OccName -> Maybe (OccName, Fingerprint))
1250                  -> (OccName, Fingerprint)
1251                  -> IfG Bool
1252 checkEntityUsage new_hash (name,old_hash)
1253   = case new_hash name of
1254
1255         Nothing       ->        -- We used it before, but it ain't there now
1256                           out_of_date (sep [ptext (sLit "No longer exported:"), ppr name])
1257
1258         Just (_, new_hash)      -- It's there, but is it up to date?
1259           | new_hash == old_hash -> do traceHiDiffs (text "  Up to date" <+> ppr name <+> parens (ppr new_hash))
1260                                        return upToDate
1261           | otherwise            -> out_of_date_hash (ptext (sLit "  Out of date:") <+> ppr name)
1262                                                      old_hash new_hash
1263
1264 up_to_date, out_of_date :: SDoc -> IfG Bool
1265 up_to_date  msg = traceHiDiffs msg >> return upToDate
1266 out_of_date msg = traceHiDiffs msg >> return outOfDate
1267
1268 out_of_date_hash :: SDoc -> Fingerprint -> Fingerprint -> IfG Bool
1269 out_of_date_hash msg old_hash new_hash
1270   = out_of_date (hsep [msg, ppr old_hash, ptext (sLit "->"), ppr new_hash])
1271
1272 ----------------------
1273 checkList :: [IfG RecompileRequired] -> IfG RecompileRequired
1274 -- This helper is used in two places
1275 checkList []             = return upToDate
1276 checkList (check:checks) = do recompile <- check
1277                               if recompile
1278                                 then return outOfDate
1279                                 else checkList checks
1280 \end{code}
1281
1282 %************************************************************************
1283 %*                                                                      *
1284                 Converting things to their Iface equivalents
1285 %*                                                                      *
1286 %************************************************************************
1287
1288 \begin{code}
1289 tyThingToIfaceDecl :: TyThing -> IfaceDecl
1290 -- Assumption: the thing is already tidied, so that locally-bound names
1291 --             (lambdas, for-alls) already have non-clashing OccNames
1292 -- Reason: Iface stuff uses OccNames, and the conversion here does
1293 --         not do tidying on the way
1294 tyThingToIfaceDecl (AnId id)
1295   = IfaceId { ifName      = getOccName id,
1296               ifType      = toIfaceType (idType id),
1297               ifIdDetails = toIfaceIdDetails (idDetails id),
1298               ifIdInfo    = info }
1299   where
1300     info = case toIfaceIdInfo (idInfo id) of
1301                 []    -> NoInfo
1302                 items -> HasInfo items
1303
1304 tyThingToIfaceDecl (AClass clas)
1305   = IfaceClass { ifCtxt   = toIfaceContext sc_theta,
1306                  ifName   = getOccName clas,
1307                  ifTyVars = toIfaceTvBndrs clas_tyvars,
1308                  ifFDs    = map toIfaceFD clas_fds,
1309                  ifATs    = map (tyThingToIfaceDecl . ATyCon) clas_ats,
1310                  ifSigs   = map toIfaceClassOp op_stuff,
1311                  ifRec    = boolToRecFlag (isRecursiveTyCon tycon) }
1312   where
1313     (clas_tyvars, clas_fds, sc_theta, _, clas_ats, op_stuff)
1314       = classExtraBigSig clas
1315     tycon = classTyCon clas
1316
1317     toIfaceClassOp (sel_id, def_meth)
1318         = ASSERT(sel_tyvars == clas_tyvars)
1319           IfaceClassOp (getOccName sel_id) def_meth (toIfaceType op_ty)
1320         where
1321                 -- Be careful when splitting the type, because of things
1322                 -- like         class Foo a where
1323                 --                op :: (?x :: String) => a -> a
1324                 -- and          class Baz a where
1325                 --                op :: (Ord a) => a -> a
1326           (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
1327           op_ty                = funResultTy rho_ty
1328
1329     toIfaceFD (tvs1, tvs2) = (map getFS tvs1, map getFS tvs2)
1330
1331 tyThingToIfaceDecl (ATyCon tycon)
1332   | isSynTyCon tycon
1333   = IfaceSyn {  ifName    = getOccName tycon,
1334                 ifTyVars  = toIfaceTvBndrs tyvars,
1335                 ifSynRhs  = syn_rhs,
1336                 ifSynKind = syn_ki,
1337                 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)
1338              }
1339
1340   | isAlgTyCon tycon
1341   = IfaceData { ifName    = getOccName tycon,
1342                 ifTyVars  = toIfaceTvBndrs tyvars,
1343                 ifCtxt    = toIfaceContext (tyConStupidTheta tycon),
1344                 ifCons    = ifaceConDecls (algTyConRhs tycon),
1345                 ifRec     = boolToRecFlag (isRecursiveTyCon tycon),
1346                 ifGadtSyntax = isGadtSyntaxTyCon tycon,
1347                 ifGeneric = tyConHasGenerics tycon,
1348                 ifFamInst = famInstToIface (tyConFamInst_maybe tycon)}
1349
1350   | isForeignTyCon tycon
1351   = IfaceForeign { ifName    = getOccName tycon,
1352                    ifExtName = tyConExtName tycon }
1353
1354   | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
1355   where
1356     tyvars = tyConTyVars tycon
1357     (syn_rhs, syn_ki)
1358        = case synTyConRhs tycon of
1359             OpenSynTyCon ki _ -> (Nothing,               toIfaceType ki)
1360             SynonymTyCon ty   -> (Just (toIfaceType ty), toIfaceType (typeKind ty))
1361
1362     ifaceConDecls (NewTyCon { data_con = con })     =
1363       IfNewTyCon  (ifaceConDecl con)
1364     ifaceConDecls (DataTyCon { data_cons = cons })  =
1365       IfDataTyCon (map ifaceConDecl cons)
1366     ifaceConDecls OpenTyCon {}                      = IfOpenDataTyCon
1367     ifaceConDecls AbstractTyCon                     = IfAbstractTyCon
1368         -- The last case happens when a TyCon has been trimmed during tidying
1369         -- Furthermore, tyThingToIfaceDecl is also used
1370         -- in TcRnDriver for GHCi, when browsing a module, in which case the
1371         -- AbstractTyCon case is perfectly sensible.
1372
1373     ifaceConDecl data_con
1374         = IfCon   { ifConOcc     = getOccName (dataConName data_con),
1375                     ifConInfix   = dataConIsInfix data_con,
1376                     ifConWrapper = isJust (dataConWrapId_maybe data_con),
1377                     ifConUnivTvs = toIfaceTvBndrs (dataConUnivTyVars data_con),
1378                     ifConExTvs   = toIfaceTvBndrs (dataConExTyVars data_con),
1379                     ifConEqSpec  = to_eq_spec (dataConEqSpec data_con),
1380                     ifConCtxt    = toIfaceContext (dataConEqTheta data_con ++ dataConDictTheta data_con),
1381                     ifConArgTys  = map toIfaceType (dataConOrigArgTys data_con),
1382                     ifConFields  = map getOccName
1383                                        (dataConFieldLabels data_con),
1384                     ifConStricts = dataConStrictMarks data_con }
1385
1386     to_eq_spec spec = [(getOccName tv, toIfaceType ty) | (tv,ty) <- spec]
1387
1388     famInstToIface Nothing                    = Nothing
1389     famInstToIface (Just (famTyCon, instTys)) =
1390       Just (toIfaceTyCon famTyCon, map toIfaceType instTys)
1391
1392 tyThingToIfaceDecl (ADataCon dc)
1393  = pprPanic "toIfaceDecl" (ppr dc)      -- Should be trimmed out earlier
1394
1395
1396 getFS :: NamedThing a => a -> FastString
1397 getFS x = occNameFS (getOccName x)
1398
1399 --------------------------
1400 instanceToIfaceInst :: Instance -> IfaceInst
1401 instanceToIfaceInst (Instance { is_dfun = dfun_id, is_flag = oflag,
1402                                 is_cls = cls_name, is_tcs = mb_tcs })
1403   = ASSERT( cls_name == className cls )
1404     IfaceInst { ifDFun    = dfun_name,
1405                 ifOFlag   = oflag,
1406                 ifInstCls = cls_name,
1407                 ifInstTys = map do_rough mb_tcs,
1408                 ifInstOrph = orph }
1409   where
1410     do_rough Nothing  = Nothing
1411     do_rough (Just n) = Just (toIfaceTyCon_name n)
1412
1413     dfun_name = idName dfun_id
1414     mod       = ASSERT( isExternalName dfun_name ) nameModule dfun_name
1415     is_local name = nameIsLocalOrFrom mod name
1416
1417         -- Compute orphanhood.  See Note [Orphans] in IfaceSyn
1418     (_, cls, tys) = tcSplitDFunTy (idType dfun_id)
1419                 -- Slightly awkward: we need the Class to get the fundeps
1420     (tvs, fds) = classTvsFds cls
1421     arg_names = [filterNameSet is_local (tyClsNamesOfType ty) | ty <- tys]
1422     orph | is_local cls_name = Just (nameOccName cls_name)
1423          | all isJust mb_ns  = ASSERT( not (null mb_ns) ) head mb_ns
1424          | otherwise         = Nothing
1425
1426     mb_ns :: [Maybe OccName]    -- One for each fundep; a locally-defined name
1427                                 -- that is not in the "determined" arguments
1428     mb_ns | null fds   = [choose_one arg_names]
1429           | otherwise  = map do_one fds
1430     do_one (_ltvs, rtvs) = choose_one [ns | (tv,ns) <- tvs `zip` arg_names
1431                                           , not (tv `elem` rtvs)]
1432
1433     choose_one :: [NameSet] -> Maybe OccName
1434     choose_one nss = case nameSetToList (unionManyNameSets nss) of
1435                         []      -> Nothing
1436                         (n : _) -> Just (nameOccName n)
1437
1438 --------------------------
1439 famInstToIfaceFamInst :: FamInst -> IfaceFamInst
1440 famInstToIfaceFamInst (FamInst { fi_tycon = tycon,
1441                                  fi_fam = fam,
1442                                  fi_tcs = mb_tcs })
1443   = IfaceFamInst { ifFamInstTyCon  = toIfaceTyCon tycon
1444                  , ifFamInstFam    = fam
1445                  , ifFamInstTys    = map do_rough mb_tcs }
1446   where
1447     do_rough Nothing  = Nothing
1448     do_rough (Just n) = Just (toIfaceTyCon_name n)
1449
1450 --------------------------
1451 toIfaceLetBndr :: Id -> IfaceLetBndr
1452 toIfaceLetBndr id  = IfLetBndr (occNameFS (getOccName id))
1453                                (toIfaceType (idType id))
1454                                prag_info
1455   where
1456         -- Stripped-down version of tcIfaceIdInfo
1457         -- Change this if you want to export more IdInfo for
1458         -- non-top-level Ids.  Don't forget to change
1459         -- CoreTidy.tidyLetBndr too!
1460         --
1461         -- See Note [IdInfo on nested let-bindings] in IfaceSyn
1462     id_info = idInfo id
1463     inline_prag = inlinePragInfo id_info
1464     prag_info | isDefaultInlinePragma inline_prag = NoInfo
1465               | otherwise                         = HasInfo [HsInline inline_prag]
1466
1467 --------------------------
1468 toIfaceIdDetails :: IdDetails -> IfaceIdDetails
1469 toIfaceIdDetails VanillaId                      = IfVanillaId
1470 toIfaceIdDetails (DFunId {})                    = IfDFunId
1471 toIfaceIdDetails (RecSelId { sel_naughty = n
1472                            , sel_tycon = tc })  = IfRecSelId (toIfaceTyCon tc) n
1473 toIfaceIdDetails other                          = pprTrace "toIfaceIdDetails" (ppr other)
1474                                                   IfVanillaId   -- Unexpected
1475
1476 toIfaceIdInfo :: IdInfo -> [IfaceInfoItem]
1477 toIfaceIdInfo id_info
1478   = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
1479                inline_hsinfo,  unfold_hsinfo]
1480                -- NB: strictness must be before unfolding
1481                -- See TcIface.tcUnfolding
1482   where
1483     ------------  Arity  --------------
1484     arity_info = arityInfo id_info
1485     arity_hsinfo | arity_info == 0 = Nothing
1486                  | otherwise       = Just (HsArity arity_info)
1487
1488     ------------ Caf Info --------------
1489     caf_info   = cafInfo id_info
1490     caf_hsinfo = case caf_info of
1491                    NoCafRefs -> Just HsNoCafRefs
1492                    _other    -> Nothing
1493
1494     ------------  Strictness  --------------
1495         -- No point in explicitly exporting TopSig
1496     strict_hsinfo = case strictnessInfo id_info of
1497                         Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
1498                         _other                        -> Nothing
1499
1500     ------------  Unfolding  --------------
1501     unfold_hsinfo = toIfUnfolding loop_breaker (unfoldingInfo id_info)
1502     loop_breaker  = isNonRuleLoopBreaker (occInfo id_info)
1503
1504     ------------  Inline prag  --------------
1505     inline_prag = inlinePragInfo id_info
1506     inline_hsinfo | isDefaultInlinePragma inline_prag = Nothing
1507                   | otherwise = Just (HsInline inline_prag)
1508
1509 --------------------------
1510 toIfUnfolding :: Bool -> Unfolding -> Maybe IfaceInfoItem
1511 toIfUnfolding lb unf@(CoreUnfolding { uf_tmpl = rhs, uf_arity = arity
1512                                     , uf_src = src, uf_guidance = guidance })
1513   = Just $ HsUnfold lb $
1514     case src of
1515         InlineRule {}
1516           -> case guidance of
1517                UnfWhen unsat_ok boring_ok -> IfInlineRule arity unsat_ok boring_ok (toIfaceExpr rhs)
1518                _other                     -> pprPanic "toIfUnfolding" (ppr unf)
1519         InlineWrapper w  -> IfWrapper arity (idName w)
1520         InlineCompulsory -> IfCompulsory (toIfaceExpr rhs)
1521         InlineRhs        -> IfCoreUnfold (toIfaceExpr rhs)
1522         -- Yes, even if guidance is UnfNever, expose the unfolding
1523         -- If we didn't want to expose the unfolding, TidyPgm would
1524         -- have stuck in NoUnfolding.  For supercompilation we want
1525         -- to see that unfolding!
1526
1527 toIfUnfolding lb (DFunUnfolding _con ops)
1528   = Just (HsUnfold lb (IfDFunUnfold (map toIfaceExpr ops)))
1529       -- No need to serialise the data constructor;
1530       -- we can recover it from the type of the dfun
1531
1532 toIfUnfolding _ _
1533   = Nothing
1534
1535 --------------------------
1536 coreRuleToIfaceRule :: Module -> CoreRule -> IfaceRule
1537 coreRuleToIfaceRule _ (BuiltinRule { ru_fn = fn})
1538   = pprTrace "toHsRule: builtin" (ppr fn) $
1539     bogusIfaceRule fn
1540
1541 coreRuleToIfaceRule mod (Rule { ru_name = name, ru_fn = fn,
1542                                 ru_act = act, ru_bndrs = bndrs,
1543                                 ru_args = args, ru_rhs = rhs })
1544   = IfaceRule { ifRuleName  = name, ifActivation = act,
1545                 ifRuleBndrs = map toIfaceBndr bndrs,
1546                 ifRuleHead  = fn,
1547                 ifRuleArgs  = map do_arg args,
1548                 ifRuleRhs   = toIfaceExpr rhs,
1549                 ifRuleOrph  = orph }
1550   where
1551         -- For type args we must remove synonyms from the outermost
1552         -- level.  Reason: so that when we read it back in we'll
1553         -- construct the same ru_rough field as we have right now;
1554         -- see tcIfaceRule
1555     do_arg (Type ty) = IfaceType (toIfaceType (deNoteType ty))
1556     do_arg arg       = toIfaceExpr arg
1557
1558         -- Compute orphanhood.  See Note [Orphans] in IfaceSyn
1559         -- A rule is an orphan only if none of the variables
1560         -- mentioned on its left-hand side are locally defined
1561     lhs_names = fn : nameSetToList (exprsFreeNames args)
1562                 -- No need to delete bndrs, because
1563                 -- exprsFreeNames finds only External names
1564
1565     orph = case filter (nameIsLocalOrFrom mod) lhs_names of
1566                         (n : _) -> Just (nameOccName n)
1567                         []      -> Nothing
1568
1569 bogusIfaceRule :: Name -> IfaceRule
1570 bogusIfaceRule id_name
1571   = IfaceRule { ifRuleName = fsLit "bogus", ifActivation = NeverActive,
1572         ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
1573         ifRuleRhs = IfaceExt id_name, ifRuleOrph = Nothing }
1574
1575 ---------------------
1576 toIfaceExpr :: CoreExpr -> IfaceExpr
1577 toIfaceExpr (Var v)       = toIfaceVar v
1578 toIfaceExpr (Lit l)       = IfaceLit l
1579 toIfaceExpr (Type ty)     = IfaceType (toIfaceType ty)
1580 toIfaceExpr (Lam x b)     = IfaceLam (toIfaceBndr x) (toIfaceExpr b)
1581 toIfaceExpr (App f a)     = toIfaceApp f [a]
1582 toIfaceExpr (Case s x ty as) = IfaceCase (toIfaceExpr s) (getFS x) (toIfaceType ty) (map toIfaceAlt as)
1583 toIfaceExpr (Let b e)     = IfaceLet (toIfaceBind b) (toIfaceExpr e)
1584 toIfaceExpr (Cast e co)   = IfaceCast (toIfaceExpr e) (toIfaceType co)
1585 toIfaceExpr (Note n e)    = IfaceNote (toIfaceNote n) (toIfaceExpr e)
1586
1587 ---------------------
1588 toIfaceNote :: Note -> IfaceNote
1589 toIfaceNote (SCC cc)      = IfaceSCC cc
1590 toIfaceNote (CoreNote s)  = IfaceCoreNote s
1591
1592 ---------------------
1593 toIfaceBind :: Bind Id -> IfaceBinding
1594 toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)
1595 toIfaceBind (Rec prs)    = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]
1596
1597 ---------------------
1598 toIfaceAlt :: (AltCon, [Var], CoreExpr)
1599            -> (IfaceConAlt, [FastString], IfaceExpr)
1600 toIfaceAlt (c,bs,r) = (toIfaceCon c, map getFS bs, toIfaceExpr r)
1601
1602 ---------------------
1603 toIfaceCon :: AltCon -> IfaceConAlt
1604 toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
1605                         | otherwise       = IfaceDataAlt (getName dc)
1606                         where
1607                           tc = dataConTyCon dc
1608
1609 toIfaceCon (LitAlt l) = IfaceLitAlt l
1610 toIfaceCon DEFAULT    = IfaceDefault
1611
1612 ---------------------
1613 toIfaceApp :: Expr CoreBndr -> [Arg CoreBndr] -> IfaceExpr
1614 toIfaceApp (App f a) as = toIfaceApp f (a:as)
1615 toIfaceApp (Var v) as
1616   = case isDataConWorkId_maybe v of
1617         -- We convert the *worker* for tuples into IfaceTuples
1618         Just dc |  isTupleTyCon tc && saturated
1619                 -> IfaceTuple (tupleTyConBoxity tc) tup_args
1620           where
1621             val_args  = dropWhile isTypeArg as
1622             saturated = val_args `lengthIs` idArity v
1623             tup_args  = map toIfaceExpr val_args
1624             tc        = dataConTyCon dc
1625
1626         _ -> mkIfaceApps (toIfaceVar v) as
1627
1628 toIfaceApp e as = mkIfaceApps (toIfaceExpr e) as
1629
1630 mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr
1631 mkIfaceApps f as = foldl (\f a -> IfaceApp f (toIfaceExpr a)) f as
1632
1633 ---------------------
1634 toIfaceVar :: Id -> IfaceExpr
1635 toIfaceVar v
1636   | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))
1637           -- Foreign calls have special syntax
1638   | isExternalName name             = IfaceExt name
1639   | Just (TickBox m ix) <- isTickBoxOp_maybe v
1640                                     = IfaceTick m ix
1641   | otherwise                       = IfaceLcl (getFS name)
1642   where
1643     name = idName v
1644 \end{code}