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