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