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