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