1{-
2(c) The University of Glasgow 2006-2008
3(c) The GRASP/AQUA Project, Glasgow University, 1993-1998
4-}
5
6{-# LANGUAGE CPP, NondecreasingIndentation #-}
7{-# LANGUAGE MultiWayIf #-}
8
9-- | Module for constructing @ModIface@ values (interface files),
10-- writing them to disk and comparing two versions to see if
11-- recompilation is required.
12module MkIface (
13        mkPartialIface,
14        mkFullIface,
15
16        mkIfaceTc,
17
18        writeIfaceFile, -- Write the interface file
19
20        checkOldIface,  -- See if recompilation is required, by
21                        -- comparing version information
22        RecompileRequired(..), recompileRequired,
23        mkIfaceExports,
24
25        coAxiomToIfaceDecl,
26        tyThingToIfaceDecl -- Converting things to their Iface equivalents
27 ) where
28
29{-
30  -----------------------------------------------
31          Recompilation checking
32  -----------------------------------------------
33
34A complete description of how recompilation checking works can be
35found in the wiki commentary:
36
37 https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance
38
39Please read the above page for a top-down description of how this all
40works.  Notes below cover specific issues related to the implementation.
41
42Basic idea:
43
44  * In the mi_usages information in an interface, we record the
45    fingerprint of each free variable of the module
46
47  * In mkIface, we compute the fingerprint of each exported thing A.f.
48    For each external thing that A.f refers to, we include the fingerprint
49    of the external reference when computing the fingerprint of A.f.  So
50    if anything that A.f depends on changes, then A.f's fingerprint will
51    change.
52    Also record any dependent files added with
53      * addDependentFile
54      * #include
55      * -optP-include
56
57  * In checkOldIface we compare the mi_usages for the module with
58    the actual fingerprint for all each thing recorded in mi_usages
59-}
60
61#include "HsVersions.h"
62
63import GhcPrelude
64
65import IfaceSyn
66import BinFingerprint
67import LoadIface
68import ToIface
69import FlagChecker
70
71import DsUsage ( mkUsageInfo, mkUsedNames, mkDependencies )
72import Id
73import Annotations
74import CoreSyn
75import Class
76import TyCon
77import CoAxiom
78import ConLike
79import DataCon
80import Type
81import TcType
82import InstEnv
83import FamInstEnv
84import TcRnMonad
85import GHC.Hs
86import HscTypes
87import Finder
88import DynFlags
89import VarEnv
90import Var
91import Name
92import Avail
93import RdrName
94import NameEnv
95import NameSet
96import Module
97import BinIface
98import ErrUtils
99import Digraph
100import SrcLoc
101import Outputable
102import BasicTypes       hiding ( SuccessFlag(..) )
103import Unique
104import Util             hiding ( eqListBy )
105import FastString
106import Maybes
107import Binary
108import Fingerprint
109import Exception
110import UniqSet
111import Packages
112import ExtractDocs
113
114import Control.Monad
115import Data.Function
116import Data.List (find, findIndex, mapAccumL, sortBy, sort)
117import qualified Data.Map as Map
118import qualified Data.Set as Set
119import Data.Ord
120import Data.IORef
121import System.Directory
122import System.FilePath
123import Plugins ( PluginRecompile(..), PluginWithArgs(..), LoadedPlugin(..),
124                 pluginRecompile', plugins )
125
126--Qualified import so we can define a Semigroup instance
127-- but it doesn't clash with Outputable.<>
128import qualified Data.Semigroup
129
130{-
131************************************************************************
132*                                                                      *
133\subsection{Completing an interface}
134*                                                                      *
135************************************************************************
136-}
137
138mkPartialIface :: HscEnv
139               -> ModDetails
140               -> ModGuts
141               -> PartialModIface
142mkPartialIface hsc_env mod_details
143  ModGuts{ mg_module       = this_mod
144         , mg_hsc_src      = hsc_src
145         , mg_usages       = usages
146         , mg_used_th      = used_th
147         , mg_deps         = deps
148         , mg_rdr_env      = rdr_env
149         , mg_fix_env      = fix_env
150         , mg_warns        = warns
151         , mg_hpc_info     = hpc_info
152         , mg_safe_haskell = safe_mode
153         , mg_trust_pkg    = self_trust
154         , mg_doc_hdr      = doc_hdr
155         , mg_decl_docs    = decl_docs
156         , mg_arg_docs     = arg_docs
157         }
158  = mkIface_ hsc_env this_mod hsc_src used_th deps rdr_env fix_env warns hpc_info self_trust
159             safe_mode usages doc_hdr decl_docs arg_docs mod_details
160
161-- | Fully instantiate a interface
162-- Adds fingerprints and potentially code generator produced information.
163mkFullIface :: HscEnv -> PartialModIface -> IO ModIface
164mkFullIface hsc_env partial_iface = do
165    full_iface <-
166      {-# SCC "addFingerprints" #-}
167      addFingerprints hsc_env partial_iface
168
169    -- Debug printing
170    dumpIfSet_dyn (hsc_dflags hsc_env) Opt_D_dump_hi "FINAL INTERFACE" (pprModIface full_iface)
171
172    return full_iface
173
174-- | Make an interface from the results of typechecking only.  Useful
175-- for non-optimising compilation, or where we aren't generating any
176-- object code at all ('HscNothing').
177mkIfaceTc :: HscEnv
178          -> SafeHaskellMode    -- The safe haskell mode
179          -> ModDetails         -- gotten from mkBootModDetails, probably
180          -> TcGblEnv           -- Usages, deprecations, etc
181          -> IO ModIface
182mkIfaceTc hsc_env safe_mode mod_details
183  tc_result@TcGblEnv{ tcg_mod = this_mod,
184                      tcg_src = hsc_src,
185                      tcg_imports = imports,
186                      tcg_rdr_env = rdr_env,
187                      tcg_fix_env = fix_env,
188                      tcg_merged = merged,
189                      tcg_warns = warns,
190                      tcg_hpc = other_hpc_info,
191                      tcg_th_splice_used = tc_splice_used,
192                      tcg_dependent_files = dependent_files
193                    }
194  = do
195          let used_names = mkUsedNames tc_result
196          let pluginModules =
197                map lpModule (cachedPlugins (hsc_dflags hsc_env))
198          deps <- mkDependencies
199                    (thisInstalledUnitId (hsc_dflags hsc_env))
200                    (map mi_module pluginModules) tc_result
201          let hpc_info = emptyHpcInfo other_hpc_info
202          used_th <- readIORef tc_splice_used
203          dep_files <- (readIORef dependent_files)
204          -- Do NOT use semantic module here; this_mod in mkUsageInfo
205          -- is used solely to decide if we should record a dependency
206          -- or not.  When we instantiate a signature, the semantic
207          -- module is something we want to record dependencies for,
208          -- but if you pass that in here, we'll decide it's the local
209          -- module and does not need to be recorded as a dependency.
210          -- See Note [Identity versus semantic module]
211          usages <- mkUsageInfo hsc_env this_mod (imp_mods imports) used_names
212                      dep_files merged pluginModules
213
214          let (doc_hdr', doc_map, arg_map) = extractDocs tc_result
215
216          let partial_iface = mkIface_ hsc_env
217                   this_mod hsc_src
218                   used_th deps rdr_env
219                   fix_env warns hpc_info
220                   (imp_trust_own_pkg imports) safe_mode usages
221                   doc_hdr' doc_map arg_map
222                   mod_details
223
224          mkFullIface hsc_env partial_iface
225
226mkIface_ :: HscEnv -> Module -> HscSource
227         -> Bool -> Dependencies -> GlobalRdrEnv
228         -> NameEnv FixItem -> Warnings -> HpcInfo
229         -> Bool
230         -> SafeHaskellMode
231         -> [Usage]
232         -> Maybe HsDocString
233         -> DeclDocMap
234         -> ArgDocMap
235         -> ModDetails
236         -> PartialModIface
237mkIface_ hsc_env
238         this_mod hsc_src used_th deps rdr_env fix_env src_warns
239         hpc_info pkg_trust_req safe_mode usages
240         doc_hdr decl_docs arg_docs
241         ModDetails{  md_insts     = insts,
242                      md_fam_insts = fam_insts,
243                      md_rules     = rules,
244                      md_anns      = anns,
245                      md_types     = type_env,
246                      md_exports   = exports,
247                      md_complete_sigs = complete_sigs }
248-- NB:  notice that mkIface does not look at the bindings
249--      only at the TypeEnv.  The previous Tidy phase has
250--      put exactly the info into the TypeEnv that we want
251--      to expose in the interface
252
253  = do
254    let semantic_mod = canonicalizeHomeModule (hsc_dflags hsc_env) (moduleName this_mod)
255        entities = typeEnvElts type_env
256        decls  = [ tyThingToIfaceDecl entity
257                 | entity <- entities,
258                   let name = getName entity,
259                   not (isImplicitTyThing entity),
260                      -- No implicit Ids and class tycons in the interface file
261                   not (isWiredInName name),
262                      -- Nor wired-in things; the compiler knows about them anyhow
263                   nameIsLocalOrFrom semantic_mod name  ]
264                      -- Sigh: see Note [Root-main Id] in TcRnDriver
265                      -- NB: ABSOLUTELY need to check against semantic_mod,
266                      -- because all of the names in an hsig p[H=<H>]:H
267                      -- are going to be for <H>, not the former id!
268                      -- See Note [Identity versus semantic module]
269
270        fixities    = sortBy (comparing fst)
271          [(occ,fix) | FixItem occ fix <- nameEnvElts fix_env]
272          -- The order of fixities returned from nameEnvElts is not
273          -- deterministic, so we sort by OccName to canonicalize it.
274          -- See Note [Deterministic UniqFM] in UniqDFM for more details.
275        warns       = src_warns
276        iface_rules = map coreRuleToIfaceRule rules
277        iface_insts = map instanceToIfaceInst $ fixSafeInstances safe_mode insts
278        iface_fam_insts = map famInstToIfaceFamInst fam_insts
279        trust_info  = setSafeMode safe_mode
280        annotations = map mkIfaceAnnotation anns
281        icomplete_sigs = map mkIfaceCompleteSig complete_sigs
282
283    ModIface {
284          mi_module      = this_mod,
285          -- Need to record this because it depends on the -instantiated-with flag
286          -- which could change
287          mi_sig_of      = if semantic_mod == this_mod
288                            then Nothing
289                            else Just semantic_mod,
290          mi_hsc_src     = hsc_src,
291          mi_deps        = deps,
292          mi_usages      = usages,
293          mi_exports     = mkIfaceExports exports,
294
295          -- Sort these lexicographically, so that
296          -- the result is stable across compilations
297          mi_insts       = sortBy cmp_inst     iface_insts,
298          mi_fam_insts   = sortBy cmp_fam_inst iface_fam_insts,
299          mi_rules       = sortBy cmp_rule     iface_rules,
300
301          mi_fixities    = fixities,
302          mi_warns       = warns,
303          mi_anns        = annotations,
304          mi_globals     = maybeGlobalRdrEnv rdr_env,
305          mi_used_th     = used_th,
306          mi_decls       = decls,
307          mi_hpc         = isHpcUsed hpc_info,
308          mi_trust       = trust_info,
309          mi_trust_pkg   = pkg_trust_req,
310          mi_complete_sigs = icomplete_sigs,
311          mi_doc_hdr     = doc_hdr,
312          mi_decl_docs   = decl_docs,
313          mi_arg_docs    = arg_docs,
314          mi_final_exts        = () }
315  where
316     cmp_rule     = comparing ifRuleName
317     -- Compare these lexicographically by OccName, *not* by unique,
318     -- because the latter is not stable across compilations:
319     cmp_inst     = comparing (nameOccName . ifDFun)
320     cmp_fam_inst = comparing (nameOccName . ifFamInstTcName)
321
322     dflags = hsc_dflags hsc_env
323
324     -- We only fill in mi_globals if the module was compiled to byte
325     -- code.  Otherwise, the compiler may not have retained all the
326     -- top-level bindings and they won't be in the TypeEnv (see
327     -- Desugar.addExportFlagsAndRules).  The mi_globals field is used
328     -- by GHCi to decide whether the module has its full top-level
329     -- scope available. (#5534)
330     maybeGlobalRdrEnv :: GlobalRdrEnv -> Maybe GlobalRdrEnv
331     maybeGlobalRdrEnv rdr_env
332         | targetRetainsAllBindings (hscTarget dflags) = Just rdr_env
333         | otherwise                                   = Nothing
334
335     ifFamInstTcName = ifFamInstFam
336
337-----------------------------
338writeIfaceFile :: DynFlags -> FilePath -> ModIface -> IO ()
339writeIfaceFile dflags hi_file_path new_iface
340    = do createDirectoryIfMissing True (takeDirectory hi_file_path)
341         writeBinIface dflags hi_file_path new_iface
342
343
344-- -----------------------------------------------------------------------------
345-- Look up parents and versions of Names
346
347-- This is like a global version of the mi_hash_fn field in each ModIface.
348-- Given a Name, it finds the ModIface, and then uses mi_hash_fn to get
349-- the parent and version info.
350
351mkHashFun
352        :: HscEnv                       -- needed to look up versions
353        -> ExternalPackageState         -- ditto
354        -> (Name -> IO Fingerprint)
355mkHashFun hsc_env eps name
356  | isHoleModule orig_mod
357  = lookup (mkModule (thisPackage dflags) (moduleName orig_mod))
358  | otherwise
359  = lookup orig_mod
360  where
361      dflags = hsc_dflags hsc_env
362      hpt = hsc_HPT hsc_env
363      pit = eps_PIT eps
364      occ = nameOccName name
365      orig_mod = nameModule name
366      lookup mod = do
367        MASSERT2( isExternalName name, ppr name )
368        iface <- case lookupIfaceByModule hpt pit mod of
369                  Just iface -> return iface
370                  Nothing -> do
371                      -- This can occur when we're writing out ifaces for
372                      -- requirements; we didn't do any /real/ typechecking
373                      -- so there's no guarantee everything is loaded.
374                      -- Kind of a heinous hack.
375                      iface <- initIfaceLoad hsc_env . withException
376                            $ loadInterface (text "lookupVers2") mod ImportBySystem
377                      return iface
378        return $ snd (mi_hash_fn (mi_final_exts iface) occ `orElse`
379                  pprPanic "lookupVers1" (ppr mod <+> ppr occ))
380
381-- ---------------------------------------------------------------------------
382-- Compute fingerprints for the interface
383
384{-
385Note [Fingerprinting IfaceDecls]
386~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
387
388The general idea here is that we first examine the 'IfaceDecl's and determine
389the recursive groups of them. We then walk these groups in dependency order,
390serializing each contained 'IfaceDecl' to a "Binary" buffer which we then
391hash using MD5 to produce a fingerprint for the group.
392
393However, the serialization that we use is a bit funny: we override the @putName@
394operation with our own which serializes the hash of a 'Name' instead of the
395'Name' itself. This ensures that the fingerprint of a decl changes if anything
396in its transitive closure changes. This trick is why we must be careful about
397traversing in dependency order: we need to ensure that we have hashes for
398everything referenced by the decl which we are fingerprinting.
399
400Moreover, we need to be careful to distinguish between serialization of binding
401Names (e.g. the ifName field of a IfaceDecl) and non-binding (e.g. the ifInstCls
402field of a IfaceClsInst): only in the non-binding case should we include the
403fingerprint; in the binding case we shouldn't since it is merely the name of the
404thing that we are currently fingerprinting.
405-}
406
407-- | Add fingerprints for top-level declarations to a 'ModIface'.
408--
409-- See Note [Fingerprinting IfaceDecls]
410addFingerprints
411        :: HscEnv
412        -> PartialModIface
413        -> IO ModIface
414addFingerprints hsc_env iface0
415 = do
416   eps <- hscEPS hsc_env
417   let
418       decls = mi_decls iface0
419       warn_fn = mkIfaceWarnCache (mi_warns iface0)
420       fix_fn = mkIfaceFixCache (mi_fixities iface0)
421
422        -- The ABI of a declaration represents everything that is made
423        -- visible about the declaration that a client can depend on.
424        -- see IfaceDeclABI below.
425       declABI :: IfaceDecl -> IfaceDeclABI
426       -- TODO: I'm not sure if this should be semantic_mod or this_mod.
427       -- See also Note [Identity versus semantic module]
428       declABI decl = (this_mod, decl, extras)
429        where extras = declExtras fix_fn ann_fn non_orph_rules non_orph_insts
430                                  non_orph_fis top_lvl_name_env decl
431
432       -- This is used for looking up the Name of a default method
433       -- from its OccName. See Note [default method Name]
434       top_lvl_name_env =
435         mkOccEnv [ (nameOccName nm, nm)
436                  | IfaceId { ifName = nm } <- decls ]
437
438       -- Dependency edges between declarations in the current module.
439       -- This is computed by finding the free external names of each
440       -- declaration, including IfaceDeclExtras (things that a
441       -- declaration implicitly depends on).
442       edges :: [ Node Unique IfaceDeclABI ]
443       edges = [ DigraphNode abi (getUnique (getOccName decl)) out
444               | decl <- decls
445               , let abi = declABI decl
446               , let out = localOccs $ freeNamesDeclABI abi
447               ]
448
449       name_module n = ASSERT2( isExternalName n, ppr n ) nameModule n
450       localOccs =
451         map (getUnique . getParent . getOccName)
452                        -- NB: names always use semantic module, so
453                        -- filtering must be on the semantic module!
454                        -- See Note [Identity versus semantic module]
455                        . filter ((== semantic_mod) . name_module)
456                        . nonDetEltsUniqSet
457                   -- It's OK to use nonDetEltsUFM as localOccs is only
458                   -- used to construct the edges and
459                   -- stronglyConnCompFromEdgedVertices is deterministic
460                   -- even with non-deterministic order of edges as
461                   -- explained in Note [Deterministic SCC] in Digraph.
462          where getParent :: OccName -> OccName
463                getParent occ = lookupOccEnv parent_map occ `orElse` occ
464
465        -- maps OccNames to their parents in the current module.
466        -- e.g. a reference to a constructor must be turned into a reference
467        -- to the TyCon for the purposes of calculating dependencies.
468       parent_map :: OccEnv OccName
469       parent_map = foldl' extend emptyOccEnv decls
470          where extend env d =
471                  extendOccEnvList env [ (b,n) | b <- ifaceDeclImplicitBndrs d ]
472                  where n = getOccName d
473
474        -- Strongly-connected groups of declarations, in dependency order
475       groups :: [SCC IfaceDeclABI]
476       groups = stronglyConnCompFromEdgedVerticesUniq edges
477
478       global_hash_fn = mkHashFun hsc_env eps
479
480        -- How to output Names when generating the data to fingerprint.
481        -- Here we want to output the fingerprint for each top-level
482        -- Name, whether it comes from the current module or another
483        -- module.  In this way, the fingerprint for a declaration will
484        -- change if the fingerprint for anything it refers to (transitively)
485        -- changes.
486       mk_put_name :: OccEnv (OccName,Fingerprint)
487                   -> BinHandle -> Name -> IO  ()
488       mk_put_name local_env bh name
489          | isWiredInName name  =  putNameLiterally bh name
490           -- wired-in names don't have fingerprints
491          | otherwise
492          = ASSERT2( isExternalName name, ppr name )
493            let hash | nameModule name /= semantic_mod =  global_hash_fn name
494                     -- Get it from the REAL interface!!
495                     -- This will trigger when we compile an hsig file
496                     -- and we know a backing impl for it.
497                     -- See Note [Identity versus semantic module]
498                     | semantic_mod /= this_mod
499                     , not (isHoleModule semantic_mod) = global_hash_fn name
500                     | otherwise = return (snd (lookupOccEnv local_env (getOccName name)
501                           `orElse` pprPanic "urk! lookup local fingerprint"
502                                       (ppr name $$ ppr local_env)))
503                -- This panic indicates that we got the dependency
504                -- analysis wrong, because we needed a fingerprint for
505                -- an entity that wasn't in the environment.  To debug
506                -- it, turn the panic into a trace, uncomment the
507                -- pprTraces below, run the compile again, and inspect
508                -- the output and the generated .hi file with
509                -- --show-iface.
510            in hash >>= put_ bh
511
512        -- take a strongly-connected group of declarations and compute
513        -- its fingerprint.
514
515       fingerprint_group :: (OccEnv (OccName,Fingerprint),
516                             [(Fingerprint,IfaceDecl)])
517                         -> SCC IfaceDeclABI
518                         -> IO (OccEnv (OccName,Fingerprint),
519                                [(Fingerprint,IfaceDecl)])
520
521       fingerprint_group (local_env, decls_w_hashes) (AcyclicSCC abi)
522          = do let hash_fn = mk_put_name local_env
523                   decl = abiDecl abi
524               --pprTrace "fingerprinting" (ppr (ifName decl) ) $ do
525               hash <- computeFingerprint hash_fn abi
526               env' <- extend_hash_env local_env (hash,decl)
527               return (env', (hash,decl) : decls_w_hashes)
528
529       fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis)
530          = do let decls = map abiDecl abis
531               local_env1 <- foldM extend_hash_env local_env
532                                   (zip (repeat fingerprint0) decls)
533               let hash_fn = mk_put_name local_env1
534               -- pprTrace "fingerprinting" (ppr (map ifName decls) ) $ do
535               let stable_abis = sortBy cmp_abiNames abis
536                -- put the cycle in a canonical order
537               hash <- computeFingerprint hash_fn stable_abis
538               let pairs = zip (repeat hash) decls
539               local_env2 <- foldM extend_hash_env local_env pairs
540               return (local_env2, pairs ++ decls_w_hashes)
541
542       -- we have fingerprinted the whole declaration, but we now need
543       -- to assign fingerprints to all the OccNames that it binds, to
544       -- use when referencing those OccNames in later declarations.
545       --
546       extend_hash_env :: OccEnv (OccName,Fingerprint)
547                       -> (Fingerprint,IfaceDecl)
548                       -> IO (OccEnv (OccName,Fingerprint))
549       extend_hash_env env0 (hash,d) = do
550          return (foldr (\(b,fp) env -> extendOccEnv env b (b,fp)) env0
551                 (ifaceDeclFingerprints hash d))
552
553   --
554   (local_env, decls_w_hashes) <-
555       foldM fingerprint_group (emptyOccEnv, []) groups
556
557   -- when calculating fingerprints, we always need to use canonical
558   -- ordering for lists of things.  In particular, the mi_deps has various
559   -- lists of modules and suchlike, so put these all in canonical order:
560   let sorted_deps = sortDependencies (mi_deps iface0)
561
562   -- The export hash of a module depends on the orphan hashes of the
563   -- orphan modules below us in the dependency tree.  This is the way
564   -- that changes in orphans get propagated all the way up the
565   -- dependency tree.
566   --
567   -- Note [A bad dep_orphs optimization]
568   -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
569   -- In a previous version of this code, we filtered out orphan modules which
570   -- were not from the home package, justifying it by saying that "we'd
571   -- pick up the ABI hashes of the external module instead".  This is wrong.
572   -- Suppose that we have:
573   --
574   --       module External where
575   --           instance Show (a -> b)
576   --
577   --       module Home1 where
578   --           import External
579   --
580   --       module Home2 where
581   --           import Home1
582   --
583   -- The export hash of Home1 needs to reflect the orphan instances of
584   -- External. It's true that Home1 will get rebuilt if the orphans
585   -- of External, but we also need to make sure Home2 gets rebuilt
586   -- as well.  See #12733 for more details.
587   let orph_mods
588        = filter (/= this_mod) -- Note [Do not update EPS with your own hi-boot]
589        $ dep_orphs sorted_deps
590   dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods
591
592   -- Note [Do not update EPS with your own hi-boot]
593   -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
594   -- (See also #10182).  When your hs-boot file includes an orphan
595   -- instance declaration, you may find that the dep_orphs of a module you
596   -- import contains reference to yourself.  DO NOT actually load this module
597   -- or add it to the orphan hashes: you're going to provide the orphan
598   -- instances yourself, no need to consult hs-boot; if you do load the
599   -- interface into EPS, you will see a duplicate orphan instance.
600
601   orphan_hash <- computeFingerprint (mk_put_name local_env)
602                                     (map ifDFun orph_insts, orph_rules, orph_fis)
603
604   -- the export list hash doesn't depend on the fingerprints of
605   -- the Names it mentions, only the Names themselves, hence putNameLiterally.
606   export_hash <- computeFingerprint putNameLiterally
607                      (mi_exports iface0,
608                       orphan_hash,
609                       dep_orphan_hashes,
610                       dep_pkgs (mi_deps iface0),
611                       -- See Note [Export hash depends on non-orphan family instances]
612                       dep_finsts (mi_deps iface0),
613                        -- dep_pkgs: see "Package Version Changes" on
614                        -- wiki/commentary/compiler/recompilation-avoidance
615                       mi_trust iface0)
616                        -- Make sure change of Safe Haskell mode causes recomp.
617
618   -- Note [Export hash depends on non-orphan family instances]
619   -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
620   --
621   -- Suppose we have:
622   --
623   --   module A where
624   --       type instance F Int = Bool
625   --
626   --   module B where
627   --       import A
628   --
629   --   module C where
630   --       import B
631   --
632   -- The family instance consistency check for C depends on the dep_finsts of
633   -- B.  If we rename module A to A2, when the dep_finsts of B changes, we need
634   -- to make sure that C gets rebuilt. Effectively, the dep_finsts are part of
635   -- the exports of B, because C always considers them when checking
636   -- consistency.
637   --
638   -- A full discussion is in #12723.
639   --
640   -- We do NOT need to hash dep_orphs, because this is implied by
641   -- dep_orphan_hashes, and we do not need to hash ordinary class instances,
642   -- because there is no eager consistency check as there is with type families
643   -- (also we didn't store it anywhere!)
644   --
645
646   -- put the declarations in a canonical order, sorted by OccName
647   let sorted_decls = Map.elems $ Map.fromList $
648                          [(getOccName d, e) | e@(_, d) <- decls_w_hashes]
649
650   -- the flag hash depends on:
651   --   - (some of) dflags
652   -- it returns two hashes, one that shouldn't change
653   -- the abi hash and one that should
654   flag_hash <- fingerprintDynFlags dflags this_mod putNameLiterally
655
656   opt_hash <- fingerprintOptFlags dflags putNameLiterally
657
658   hpc_hash <- fingerprintHpcFlags dflags putNameLiterally
659
660   plugin_hash <- fingerprintPlugins hsc_env
661
662   -- the ABI hash depends on:
663   --   - decls
664   --   - export list
665   --   - orphans
666   --   - deprecations
667   --   - flag abi hash
668   mod_hash <- computeFingerprint putNameLiterally
669                      (map fst sorted_decls,
670                       export_hash,  -- includes orphan_hash
671                       mi_warns iface0)
672
673   -- The interface hash depends on:
674   --   - the ABI hash, plus
675   --   - the module level annotations,
676   --   - usages
677   --   - deps (home and external packages, dependent files)
678   --   - hpc
679   iface_hash <- computeFingerprint putNameLiterally
680                      (mod_hash,
681                       ann_fn (mkVarOcc "module"),  -- See mkIfaceAnnCache
682                       mi_usages iface0,
683                       sorted_deps,
684                       mi_hpc iface0)
685
686   let
687    final_iface_exts = ModIfaceBackend
688      { mi_iface_hash  = iface_hash
689      , mi_mod_hash    = mod_hash
690      , mi_flag_hash   = flag_hash
691      , mi_opt_hash    = opt_hash
692      , mi_hpc_hash    = hpc_hash
693      , mi_plugin_hash = plugin_hash
694      , mi_orphan      = not (   all ifRuleAuto orph_rules
695                                   -- See Note [Orphans and auto-generated rules]
696                              && null orph_insts
697                              && null orph_fis)
698      , mi_finsts      = not (null (mi_fam_insts iface0))
699      , mi_exp_hash    = export_hash
700      , mi_orphan_hash = orphan_hash
701      , mi_warn_fn     = warn_fn
702      , mi_fix_fn      = fix_fn
703      , mi_hash_fn     = lookupOccEnv local_env
704      }
705    final_iface = iface0 { mi_decls = sorted_decls, mi_final_exts = final_iface_exts }
706   --
707   return final_iface
708
709  where
710    this_mod = mi_module iface0
711    semantic_mod = mi_semantic_module iface0
712    dflags = hsc_dflags hsc_env
713    (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph    (mi_insts iface0)
714    (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph    (mi_rules iface0)
715    (non_orph_fis,   orph_fis)   = mkOrphMap ifFamInstOrph (mi_fam_insts iface0)
716    ann_fn = mkIfaceAnnCache (mi_anns iface0)
717
718-- | Retrieve the orphan hashes 'mi_orphan_hash' for a list of modules
719-- (in particular, the orphan modules which are transitively imported by the
720-- current module).
721--
722-- Q: Why do we need the hash at all, doesn't the list of transitively
723-- imported orphan modules suffice?
724--
725-- A: If one of our transitive imports adds a new orphan instance, our
726-- export hash must change so that modules which import us rebuild.  If we just
727-- hashed the [Module], the hash would not change even when a new instance was
728-- added to a module that already had an orphan instance.
729--
730-- Q: Why don't we just hash the orphan hashes of our direct dependencies?
731-- Why the full transitive closure?
732--
733-- A: Suppose we have these modules:
734--
735--      module A where
736--          instance Show (a -> b) where
737--      module B where
738--          import A -- **
739--      module C where
740--          import A
741--          import B
742--
743-- Whether or not we add or remove the import to A in B affects the
744-- orphan hash of B.  But it shouldn't really affect the orphan hash
745-- of C.  If we hashed only direct dependencies, there would be no
746-- way to tell that the net effect was a wash, and we'd be forced
747-- to recompile C and everything else.
748getOrphanHashes :: HscEnv -> [Module] -> IO [Fingerprint]
749getOrphanHashes hsc_env mods = do
750  eps <- hscEPS hsc_env
751  let
752    hpt        = hsc_HPT hsc_env
753    pit        = eps_PIT eps
754    get_orph_hash mod =
755          case lookupIfaceByModule hpt pit mod of
756            Just iface -> return (mi_orphan_hash (mi_final_exts iface))
757            Nothing    -> do -- similar to 'mkHashFun'
758                iface <- initIfaceLoad hsc_env . withException
759                            $ loadInterface (text "getOrphanHashes") mod ImportBySystem
760                return (mi_orphan_hash (mi_final_exts iface))
761
762  --
763  mapM get_orph_hash mods
764
765
766sortDependencies :: Dependencies -> Dependencies
767sortDependencies d
768 = Deps { dep_mods   = sortBy (compare `on` (moduleNameFS.fst)) (dep_mods d),
769          dep_pkgs   = sortBy (compare `on` fst) (dep_pkgs d),
770          dep_orphs  = sortBy stableModuleCmp (dep_orphs d),
771          dep_finsts = sortBy stableModuleCmp (dep_finsts d),
772          dep_plgins = sortBy (compare `on` moduleNameFS) (dep_plgins d) }
773
774-- | Creates cached lookup for the 'mi_anns' field of ModIface
775-- Hackily, we use "module" as the OccName for any module-level annotations
776mkIfaceAnnCache :: [IfaceAnnotation] -> OccName -> [AnnPayload]
777mkIfaceAnnCache anns
778  = \n -> lookupOccEnv env n `orElse` []
779  where
780    pair (IfaceAnnotation target value) =
781      (case target of
782          NamedTarget occn -> occn
783          ModuleTarget _   -> mkVarOcc "module"
784      , [value])
785    -- flipping (++), so the first argument is always short
786    env = mkOccEnv_C (flip (++)) (map pair anns)
787
788{-
789************************************************************************
790*                                                                      *
791          The ABI of an IfaceDecl
792*                                                                      *
793************************************************************************
794
795Note [The ABI of an IfaceDecl]
796~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
797The ABI of a declaration consists of:
798
799   (a) the full name of the identifier (inc. module and package,
800       because these are used to construct the symbol name by which
801       the identifier is known externally).
802
803   (b) the declaration itself, as exposed to clients.  That is, the
804       definition of an Id is included in the fingerprint only if
805       it is made available as an unfolding in the interface.
806
807   (c) the fixity of the identifier (if it exists)
808   (d) for Ids: rules
809   (e) for classes: instances, fixity & rules for methods
810   (f) for datatypes: instances, fixity & rules for constrs
811
812Items (c)-(f) are not stored in the IfaceDecl, but instead appear
813elsewhere in the interface file.  But they are *fingerprinted* with
814the declaration itself. This is done by grouping (c)-(f) in IfaceDeclExtras,
815and fingerprinting that as part of the declaration.
816-}
817
818type IfaceDeclABI = (Module, IfaceDecl, IfaceDeclExtras)
819
820data IfaceDeclExtras
821  = IfaceIdExtras IfaceIdExtras
822
823  | IfaceDataExtras
824       (Maybe Fixity)           -- Fixity of the tycon itself (if it exists)
825       [IfaceInstABI]           -- Local class and family instances of this tycon
826                                -- See Note [Orphans] in InstEnv
827       [AnnPayload]             -- Annotations of the type itself
828       [IfaceIdExtras]          -- For each constructor: fixity, RULES and annotations
829
830  | IfaceClassExtras
831       (Maybe Fixity)           -- Fixity of the class itself (if it exists)
832       [IfaceInstABI]           -- Local instances of this class *or*
833                                --   of its associated data types
834                                -- See Note [Orphans] in InstEnv
835       [AnnPayload]             -- Annotations of the type itself
836       [IfaceIdExtras]          -- For each class method: fixity, RULES and annotations
837       [IfExtName]              -- Default methods. If a module
838                                -- mentions a class, then it can
839                                -- instantiate the class and thereby
840                                -- use the default methods, so we must
841                                -- include these in the fingerprint of
842                                -- a class.
843
844  | IfaceSynonymExtras (Maybe Fixity) [AnnPayload]
845
846  | IfaceFamilyExtras   (Maybe Fixity) [IfaceInstABI] [AnnPayload]
847
848  | IfaceOtherDeclExtras
849
850data IfaceIdExtras
851  = IdExtras
852       (Maybe Fixity)           -- Fixity of the Id (if it exists)
853       [IfaceRule]              -- Rules for the Id
854       [AnnPayload]             -- Annotations for the Id
855
856-- When hashing a class or family instance, we hash only the
857-- DFunId or CoAxiom, because that depends on all the
858-- information about the instance.
859--
860type IfaceInstABI = IfExtName   -- Name of DFunId or CoAxiom that is evidence for the instance
861
862abiDecl :: IfaceDeclABI -> IfaceDecl
863abiDecl (_, decl, _) = decl
864
865cmp_abiNames :: IfaceDeclABI -> IfaceDeclABI -> Ordering
866cmp_abiNames abi1 abi2 = getOccName (abiDecl abi1) `compare`
867                         getOccName (abiDecl abi2)
868
869freeNamesDeclABI :: IfaceDeclABI -> NameSet
870freeNamesDeclABI (_mod, decl, extras) =
871  freeNamesIfDecl decl `unionNameSet` freeNamesDeclExtras extras
872
873freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
874freeNamesDeclExtras (IfaceIdExtras id_extras)
875  = freeNamesIdExtras id_extras
876freeNamesDeclExtras (IfaceDataExtras  _ insts _ subs)
877  = unionNameSets (mkNameSet insts : map freeNamesIdExtras subs)
878freeNamesDeclExtras (IfaceClassExtras _ insts _ subs defms)
879  = unionNameSets $
880      mkNameSet insts : mkNameSet defms : map freeNamesIdExtras subs
881freeNamesDeclExtras (IfaceSynonymExtras _ _)
882  = emptyNameSet
883freeNamesDeclExtras (IfaceFamilyExtras _ insts _)
884  = mkNameSet insts
885freeNamesDeclExtras IfaceOtherDeclExtras
886  = emptyNameSet
887
888freeNamesIdExtras :: IfaceIdExtras -> NameSet
889freeNamesIdExtras (IdExtras _ rules _) = unionNameSets (map freeNamesIfRule rules)
890
891instance Outputable IfaceDeclExtras where
892  ppr IfaceOtherDeclExtras       = Outputable.empty
893  ppr (IfaceIdExtras  extras)    = ppr_id_extras extras
894  ppr (IfaceSynonymExtras fix anns) = vcat [ppr fix, ppr anns]
895  ppr (IfaceFamilyExtras fix finsts anns) = vcat [ppr fix, ppr finsts, ppr anns]
896  ppr (IfaceDataExtras fix insts anns stuff) = vcat [ppr fix, ppr_insts insts, ppr anns,
897                                                ppr_id_extras_s stuff]
898  ppr (IfaceClassExtras fix insts anns stuff defms) =
899    vcat [ppr fix, ppr_insts insts, ppr anns,
900          ppr_id_extras_s stuff, ppr defms]
901
902ppr_insts :: [IfaceInstABI] -> SDoc
903ppr_insts _ = text "<insts>"
904
905ppr_id_extras_s :: [IfaceIdExtras] -> SDoc
906ppr_id_extras_s stuff = vcat (map ppr_id_extras stuff)
907
908ppr_id_extras :: IfaceIdExtras -> SDoc
909ppr_id_extras (IdExtras fix rules anns) = ppr fix $$ vcat (map ppr rules) $$ vcat (map ppr anns)
910
911-- This instance is used only to compute fingerprints
912instance Binary IfaceDeclExtras where
913  get _bh = panic "no get for IfaceDeclExtras"
914  put_ bh (IfaceIdExtras extras) = do
915   putByte bh 1; put_ bh extras
916  put_ bh (IfaceDataExtras fix insts anns cons) = do
917   putByte bh 2; put_ bh fix; put_ bh insts; put_ bh anns; put_ bh cons
918  put_ bh (IfaceClassExtras fix insts anns methods defms) = do
919   putByte bh 3
920   put_ bh fix
921   put_ bh insts
922   put_ bh anns
923   put_ bh methods
924   put_ bh defms
925  put_ bh (IfaceSynonymExtras fix anns) = do
926   putByte bh 4; put_ bh fix; put_ bh anns
927  put_ bh (IfaceFamilyExtras fix finsts anns) = do
928   putByte bh 5; put_ bh fix; put_ bh finsts; put_ bh anns
929  put_ bh IfaceOtherDeclExtras = putByte bh 6
930
931instance Binary IfaceIdExtras where
932  get _bh = panic "no get for IfaceIdExtras"
933  put_ bh (IdExtras fix rules anns)= do { put_ bh fix; put_ bh rules; put_ bh anns }
934
935declExtras :: (OccName -> Maybe Fixity)
936           -> (OccName -> [AnnPayload])
937           -> OccEnv [IfaceRule]
938           -> OccEnv [IfaceClsInst]
939           -> OccEnv [IfaceFamInst]
940           -> OccEnv IfExtName          -- lookup default method names
941           -> IfaceDecl
942           -> IfaceDeclExtras
943
944declExtras fix_fn ann_fn rule_env inst_env fi_env dm_env decl
945  = case decl of
946      IfaceId{} -> IfaceIdExtras (id_extras n)
947      IfaceData{ifCons=cons} ->
948                     IfaceDataExtras (fix_fn n)
949                        (map ifFamInstAxiom (lookupOccEnvL fi_env n) ++
950                         map ifDFun         (lookupOccEnvL inst_env n))
951                        (ann_fn n)
952                        (map (id_extras . occName . ifConName) (visibleIfConDecls cons))
953      IfaceClass{ifBody = IfConcreteClass { ifSigs=sigs, ifATs=ats }} ->
954                     IfaceClassExtras (fix_fn n) insts (ann_fn n) meths defms
955          where
956            insts = (map ifDFun $ (concatMap at_extras ats)
957                                    ++ lookupOccEnvL inst_env n)
958                           -- Include instances of the associated types
959                           -- as well as instances of the class (#5147)
960            meths = [id_extras (getOccName op) | IfaceClassOp op _ _ <- sigs]
961            -- Names of all the default methods (see Note [default method Name])
962            defms = [ dmName
963                    | IfaceClassOp bndr _ (Just _) <- sigs
964                    , let dmOcc = mkDefaultMethodOcc (nameOccName bndr)
965                    , Just dmName <- [lookupOccEnv dm_env dmOcc] ]
966      IfaceSynonym{} -> IfaceSynonymExtras (fix_fn n)
967                                           (ann_fn n)
968      IfaceFamily{} -> IfaceFamilyExtras (fix_fn n)
969                        (map ifFamInstAxiom (lookupOccEnvL fi_env n))
970                        (ann_fn n)
971      _other -> IfaceOtherDeclExtras
972  where
973        n = getOccName decl
974        id_extras occ = IdExtras (fix_fn occ) (lookupOccEnvL rule_env occ) (ann_fn occ)
975        at_extras (IfaceAT decl _) = lookupOccEnvL inst_env (getOccName decl)
976
977
978{- Note [default method Name] (see also #15970)
979
980The Names for the default methods aren't available in the IfaceSyn.
981
982* We originally start with a DefMethInfo from the class, contain a
983  Name for the default method
984
985* We turn that into IfaceSyn as a DefMethSpec which lacks a Name
986  entirely. Why? Because the Name can be derived from the method name
987  (in TcIface), so doesn't need to be serialised into the interface
988  file.
989
990But now we have to get the Name back, because the class declaration's
991fingerprint needs to depend on it (this was the bug in #15970).  This
992is done in a slightly convoluted way:
993
994* Then, in addFingerprints we build a map that maps OccNames to Names
995
996* We pass that map to declExtras which laboriously looks up in the map
997  (using the derived occurrence name) to recover the Name we have just
998  thrown away.
999-}
1000
1001lookupOccEnvL :: OccEnv [v] -> OccName -> [v]
1002lookupOccEnvL env k = lookupOccEnv env k `orElse` []
1003
1004{-
1005-- for testing: use the md5sum command to generate fingerprints and
1006-- compare the results against our built-in version.
1007  fp' <- oldMD5 dflags bh
1008  if fp /= fp' then pprPanic "computeFingerprint" (ppr fp <+> ppr fp')
1009               else return fp
1010
1011oldMD5 dflags bh = do
1012  tmp <- newTempName dflags CurrentModule "bin"
1013  writeBinMem bh tmp
1014  tmp2 <- newTempName dflags CurrentModule "md5"
1015  let cmd = "md5sum " ++ tmp ++ " >" ++ tmp2
1016  r <- system cmd
1017  case r of
1018    ExitFailure _ -> throwGhcExceptionIO (PhaseFailed cmd r)
1019    ExitSuccess -> do
1020        hash_str <- readFile tmp2
1021        return $! readHexFingerprint hash_str
1022-}
1023
1024----------------------
1025-- mkOrphMap partitions instance decls or rules into
1026--      (a) an OccEnv for ones that are not orphans,
1027--          mapping the local OccName to a list of its decls
1028--      (b) a list of orphan decls
1029mkOrphMap :: (decl -> IsOrphan) -- Extract orphan status from decl
1030          -> [decl]             -- Sorted into canonical order
1031          -> (OccEnv [decl],    -- Non-orphan decls associated with their key;
1032                                --      each sublist in canonical order
1033              [decl])           -- Orphan decls; in canonical order
1034mkOrphMap get_key decls
1035  = foldl' go (emptyOccEnv, []) decls
1036  where
1037    go (non_orphs, orphs) d
1038        | NotOrphan occ <- get_key d
1039        = (extendOccEnv_Acc (:) singleton non_orphs occ d, orphs)
1040        | otherwise = (non_orphs, d:orphs)
1041
1042{-
1043************************************************************************
1044*                                                                      *
1045       COMPLETE Pragmas
1046*                                                                      *
1047************************************************************************
1048-}
1049
1050mkIfaceCompleteSig :: CompleteMatch -> IfaceCompleteMatch
1051mkIfaceCompleteSig (CompleteMatch cls tc) = IfaceCompleteMatch cls tc
1052
1053
1054{-
1055************************************************************************
1056*                                                                      *
1057       Keeping track of what we've slurped, and fingerprints
1058*                                                                      *
1059************************************************************************
1060-}
1061
1062
1063mkIfaceAnnotation :: Annotation -> IfaceAnnotation
1064mkIfaceAnnotation (Annotation { ann_target = target, ann_value = payload })
1065  = IfaceAnnotation {
1066        ifAnnotatedTarget = fmap nameOccName target,
1067        ifAnnotatedValue = payload
1068    }
1069
1070mkIfaceExports :: [AvailInfo] -> [IfaceExport]  -- Sort to make canonical
1071mkIfaceExports exports
1072  = sortBy stableAvailCmp (map sort_subs exports)
1073  where
1074    sort_subs :: AvailInfo -> AvailInfo
1075    sort_subs (Avail n) = Avail n
1076    sort_subs (AvailTC n [] fs) = AvailTC n [] (sort_flds fs)
1077    sort_subs (AvailTC n (m:ms) fs)
1078       | n==m      = AvailTC n (m:sortBy stableNameCmp ms) (sort_flds fs)
1079       | otherwise = AvailTC n (sortBy stableNameCmp (m:ms)) (sort_flds fs)
1080       -- Maintain the AvailTC Invariant
1081
1082    sort_flds = sortBy (stableNameCmp `on` flSelector)
1083
1084{-
1085Note [Original module]
1086~~~~~~~~~~~~~~~~~~~~~
1087Consider this:
1088        module X where { data family T }
1089        module Y( T(..) ) where { import X; data instance T Int = MkT Int }
1090The exported Avail from Y will look like
1091        X.T{X.T, Y.MkT}
1092That is, in Y,
1093  - only MkT is brought into scope by the data instance;
1094  - but the parent (used for grouping and naming in T(..) exports) is X.T
1095  - and in this case we export X.T too
1096
1097In the result of MkIfaceExports, the names are grouped by defining module,
1098so we may need to split up a single Avail into multiple ones.
1099
1100Note [Internal used_names]
1101~~~~~~~~~~~~~~~~~~~~~~~~~~
1102Most of the used_names are External Names, but we can have Internal
1103Names too: see Note [Binders in Template Haskell] in Convert, and
1104#5362 for an example.  Such Names are always
1105  - Such Names are always for locally-defined things, for which we
1106    don't gather usage info, so we can just ignore them in ent_map
1107  - They are always System Names, hence the assert, just as a double check.
1108
1109
1110************************************************************************
1111*                                                                      *
1112        Load the old interface file for this module (unless
1113        we have it already), and check whether it is up to date
1114*                                                                      *
1115************************************************************************
1116-}
1117
1118data RecompileRequired
1119  = UpToDate
1120       -- ^ everything is up to date, recompilation is not required
1121  | MustCompile
1122       -- ^ The .hs file has been touched, or the .o/.hi file does not exist
1123  | RecompBecause String
1124       -- ^ The .o/.hi files are up to date, but something else has changed
1125       -- to force recompilation; the String says what (one-line summary)
1126   deriving Eq
1127
1128instance Semigroup RecompileRequired where
1129  UpToDate <> r = r
1130  mc <> _       = mc
1131
1132instance Monoid RecompileRequired where
1133  mempty = UpToDate
1134
1135recompileRequired :: RecompileRequired -> Bool
1136recompileRequired UpToDate = False
1137recompileRequired _ = True
1138
1139
1140
1141-- | Top level function to check if the version of an old interface file
1142-- is equivalent to the current source file the user asked us to compile.
1143-- If the same, we can avoid recompilation. We return a tuple where the
1144-- first element is a bool saying if we should recompile the object file
1145-- and the second is maybe the interface file, where Nothing means to
1146-- rebuild the interface file and not use the existing one.
1147checkOldIface
1148  :: HscEnv
1149  -> ModSummary
1150  -> SourceModified
1151  -> Maybe ModIface         -- Old interface from compilation manager, if any
1152  -> IO (RecompileRequired, Maybe ModIface)
1153
1154checkOldIface hsc_env mod_summary source_modified maybe_iface
1155  = do  let dflags = hsc_dflags hsc_env
1156        showPass dflags $
1157            "Checking old interface for " ++
1158              (showPpr dflags $ ms_mod mod_summary) ++
1159              " (use -ddump-hi-diffs for more details)"
1160        initIfaceCheck (text "checkOldIface") hsc_env $
1161            check_old_iface hsc_env mod_summary source_modified maybe_iface
1162
1163check_old_iface
1164  :: HscEnv
1165  -> ModSummary
1166  -> SourceModified
1167  -> Maybe ModIface
1168  -> IfG (RecompileRequired, Maybe ModIface)
1169
1170check_old_iface hsc_env mod_summary src_modified maybe_iface
1171  = let dflags = hsc_dflags hsc_env
1172        getIface =
1173            case maybe_iface of
1174                Just _  -> do
1175                    traceIf (text "We already have the old interface for" <+>
1176                      ppr (ms_mod mod_summary))
1177                    return maybe_iface
1178                Nothing -> loadIface
1179
1180        loadIface = do
1181             let iface_path = msHiFilePath mod_summary
1182             read_result <- readIface (ms_mod mod_summary) iface_path
1183             case read_result of
1184                 Failed err -> do
1185                     traceIf (text "FYI: cannot read old interface file:" $$ nest 4 err)
1186                     traceHiDiffs (text "Old interface file was invalid:" $$ nest 4 err)
1187                     return Nothing
1188                 Succeeded iface -> do
1189                     traceIf (text "Read the interface file" <+> text iface_path)
1190                     return $ Just iface
1191
1192        src_changed
1193            | gopt Opt_ForceRecomp (hsc_dflags hsc_env) = True
1194            | SourceModified <- src_modified = True
1195            | otherwise = False
1196    in do
1197        when src_changed $
1198            traceHiDiffs (nest 4 $ text "Source file changed or recompilation check turned off")
1199
1200        case src_changed of
1201            -- If the source has changed and we're in interactive mode,
1202            -- avoid reading an interface; just return the one we might
1203            -- have been supplied with.
1204            True | not (isObjectTarget $ hscTarget dflags) ->
1205                return (MustCompile, maybe_iface)
1206
1207            -- Try and read the old interface for the current module
1208            -- from the .hi file left from the last time we compiled it
1209            True -> do
1210                maybe_iface' <- getIface
1211                return (MustCompile, maybe_iface')
1212
1213            False -> do
1214                maybe_iface' <- getIface
1215                case maybe_iface' of
1216                    -- We can't retrieve the iface
1217                    Nothing    -> return (MustCompile, Nothing)
1218
1219                    -- We have got the old iface; check its versions
1220                    -- even in the SourceUnmodifiedAndStable case we
1221                    -- should check versions because some packages
1222                    -- might have changed or gone away.
1223                    Just iface -> checkVersions hsc_env mod_summary iface
1224
1225-- | Check if a module is still the same 'version'.
1226--
1227-- This function is called in the recompilation checker after we have
1228-- determined that the module M being checked hasn't had any changes
1229-- to its source file since we last compiled M. So at this point in general
1230-- two things may have changed that mean we should recompile M:
1231--   * The interface export by a dependency of M has changed.
1232--   * The compiler flags specified this time for M have changed
1233--     in a manner that is significant for recompilation.
1234-- We return not just if we should recompile the object file but also
1235-- if we should rebuild the interface file.
1236checkVersions :: HscEnv
1237              -> ModSummary
1238              -> ModIface       -- Old interface
1239              -> IfG (RecompileRequired, Maybe ModIface)
1240checkVersions hsc_env mod_summary iface
1241  = do { traceHiDiffs (text "Considering whether compilation is required for" <+>
1242                        ppr (mi_module iface) <> colon)
1243
1244       -- readIface will have verified that the InstalledUnitId matches,
1245       -- but we ALSO must make sure the instantiation matches up.  See
1246       -- test case bkpcabal04!
1247       ; if moduleUnitId (mi_module iface) /= thisPackage (hsc_dflags hsc_env)
1248            then return (RecompBecause "-this-unit-id changed", Nothing) else do {
1249       ; recomp <- checkFlagHash hsc_env iface
1250       ; if recompileRequired recomp then return (recomp, Nothing) else do {
1251       ; recomp <- checkOptimHash hsc_env iface
1252       ; if recompileRequired recomp then return (recomp, Nothing) else do {
1253       ; recomp <- checkHpcHash hsc_env iface
1254       ; if recompileRequired recomp then return (recomp, Nothing) else do {
1255       ; recomp <- checkMergedSignatures mod_summary iface
1256       ; if recompileRequired recomp then return (recomp, Nothing) else do {
1257       ; recomp <- checkHsig mod_summary iface
1258       ; if recompileRequired recomp then return (recomp, Nothing) else do {
1259       ; recomp <- checkHie mod_summary
1260       ; if recompileRequired recomp then return (recomp, Nothing) else do {
1261       ; recomp <- checkDependencies hsc_env mod_summary iface
1262       ; if recompileRequired recomp then return (recomp, Just iface) else do {
1263       ; recomp <- checkPlugins hsc_env iface
1264       ; if recompileRequired recomp then return (recomp, Nothing) else do {
1265
1266
1267       -- Source code unchanged and no errors yet... carry on
1268       --
1269       -- First put the dependent-module info, read from the old
1270       -- interface, into the envt, so that when we look for
1271       -- interfaces we look for the right one (.hi or .hi-boot)
1272       --
1273       -- It's just temporary because either the usage check will succeed
1274       -- (in which case we are done with this module) or it'll fail (in which
1275       -- case we'll compile the module from scratch anyhow).
1276       --
1277       -- We do this regardless of compilation mode, although in --make mode
1278       -- all the dependent modules should be in the HPT already, so it's
1279       -- quite redundant
1280       ; updateEps_ $ \eps  -> eps { eps_is_boot = mod_deps }
1281       ; recomp <- checkList [checkModUsage this_pkg u | u <- mi_usages iface]
1282       ; return (recomp, Just iface)
1283    }}}}}}}}}}
1284  where
1285    this_pkg = thisPackage (hsc_dflags hsc_env)
1286    -- This is a bit of a hack really
1287    mod_deps :: ModuleNameEnv (ModuleName, IsBootInterface)
1288    mod_deps = mkModDeps (dep_mods (mi_deps iface))
1289
1290-- | Check if any plugins are requesting recompilation
1291checkPlugins :: HscEnv -> ModIface -> IfG RecompileRequired
1292checkPlugins hsc iface = liftIO $ do
1293  new_fingerprint <- fingerprintPlugins hsc
1294  let old_fingerprint = mi_plugin_hash (mi_final_exts iface)
1295  pr <- mconcat <$> mapM pluginRecompile' (plugins (hsc_dflags hsc))
1296  return $
1297    pluginRecompileToRecompileRequired old_fingerprint new_fingerprint pr
1298
1299fingerprintPlugins :: HscEnv -> IO Fingerprint
1300fingerprintPlugins hsc_env = do
1301  fingerprintPlugins' $ plugins (hsc_dflags hsc_env)
1302
1303fingerprintPlugins' :: [PluginWithArgs] -> IO Fingerprint
1304fingerprintPlugins' plugins = do
1305  res <- mconcat <$> mapM pluginRecompile' plugins
1306  return $ case res of
1307      NoForceRecompile ->  fingerprintString "NoForceRecompile"
1308      ForceRecompile   -> fingerprintString "ForceRecompile"
1309      -- is the chance of collision worth worrying about?
1310      -- An alternative is to fingerprintFingerprints [fingerprintString
1311      -- "maybeRecompile", fp]
1312      (MaybeRecompile fp) -> fp
1313
1314
1315pluginRecompileToRecompileRequired
1316    :: Fingerprint -> Fingerprint -> PluginRecompile -> RecompileRequired
1317pluginRecompileToRecompileRequired old_fp new_fp pr
1318  | old_fp == new_fp =
1319    case pr of
1320      NoForceRecompile  -> UpToDate
1321
1322      -- we already checked the fingerprint above so a mismatch is not possible
1323      -- here, remember that: `fingerprint (MaybeRecomp x) == x`.
1324      MaybeRecompile _  -> UpToDate
1325
1326      -- when we have an impure plugin in the stack we have to unconditionally
1327      -- recompile since it might integrate all sorts of crazy IO results into
1328      -- its compilation output.
1329      ForceRecompile    -> RecompBecause "Impure plugin forced recompilation"
1330
1331  | old_fp `elem` magic_fingerprints ||
1332    new_fp `elem` magic_fingerprints
1333    -- The fingerprints do not match either the old or new one is a magic
1334    -- fingerprint. This happens when non-pure plugins are added for the first
1335    -- time or when we go from one recompilation strategy to another: (force ->
1336    -- no-force, maybe-recomp -> no-force, no-force -> maybe-recomp etc.)
1337    --
1338    -- For example when we go from from ForceRecomp to NoForceRecomp
1339    -- recompilation is triggered since the old impure plugins could have
1340    -- changed the build output which is now back to normal.
1341    = RecompBecause "Plugins changed"
1342
1343  | otherwise =
1344    let reason = "Plugin fingerprint changed" in
1345    case pr of
1346      -- even though a plugin is forcing recompilation the fingerprint changed
1347      -- which would cause recompilation anyways so we report the fingerprint
1348      -- change instead.
1349      ForceRecompile   -> RecompBecause reason
1350
1351      _                -> RecompBecause reason
1352
1353 where
1354   magic_fingerprints =
1355       [ fingerprintString "NoForceRecompile"
1356       , fingerprintString "ForceRecompile"
1357       ]
1358
1359
1360-- | Check if an hsig file needs recompilation because its
1361-- implementing module has changed.
1362checkHsig :: ModSummary -> ModIface -> IfG RecompileRequired
1363checkHsig mod_summary iface = do
1364    dflags <- getDynFlags
1365    let outer_mod = ms_mod mod_summary
1366        inner_mod = canonicalizeHomeModule dflags (moduleName outer_mod)
1367    MASSERT( moduleUnitId outer_mod == thisPackage dflags )
1368    case inner_mod == mi_semantic_module iface of
1369        True -> up_to_date (text "implementing module unchanged")
1370        False -> return (RecompBecause "implementing module changed")
1371
1372-- | Check if @.hie@ file is out of date or missing.
1373checkHie :: ModSummary -> IfG RecompileRequired
1374checkHie mod_summary = do
1375    dflags <- getDynFlags
1376    let hie_date_opt = ms_hie_date mod_summary
1377        hs_date = ms_hs_date mod_summary
1378    pure $ case gopt Opt_WriteHie dflags of
1379               False -> UpToDate
1380               True -> case hie_date_opt of
1381                           Nothing -> RecompBecause "HIE file is missing"
1382                           Just hie_date
1383                               | hie_date < hs_date
1384                               -> RecompBecause "HIE file is out of date"
1385                               | otherwise
1386                               -> UpToDate
1387
1388-- | Check the flags haven't changed
1389checkFlagHash :: HscEnv -> ModIface -> IfG RecompileRequired
1390checkFlagHash hsc_env iface = do
1391    let old_hash = mi_flag_hash (mi_final_exts iface)
1392    new_hash <- liftIO $ fingerprintDynFlags (hsc_dflags hsc_env)
1393                                             (mi_module iface)
1394                                             putNameLiterally
1395    case old_hash == new_hash of
1396        True  -> up_to_date (text "Module flags unchanged")
1397        False -> out_of_date_hash "flags changed"
1398                     (text "  Module flags have changed")
1399                     old_hash new_hash
1400
1401-- | Check the optimisation flags haven't changed
1402checkOptimHash :: HscEnv -> ModIface -> IfG RecompileRequired
1403checkOptimHash hsc_env iface = do
1404    let old_hash = mi_opt_hash (mi_final_exts iface)
1405    new_hash <- liftIO $ fingerprintOptFlags (hsc_dflags hsc_env)
1406                                               putNameLiterally
1407    if | old_hash == new_hash
1408         -> up_to_date (text "Optimisation flags unchanged")
1409       | gopt Opt_IgnoreOptimChanges (hsc_dflags hsc_env)
1410         -> up_to_date (text "Optimisation flags changed; ignoring")
1411       | otherwise
1412         -> out_of_date_hash "Optimisation flags changed"
1413                     (text "  Optimisation flags have changed")
1414                     old_hash new_hash
1415
1416-- | Check the HPC flags haven't changed
1417checkHpcHash :: HscEnv -> ModIface -> IfG RecompileRequired
1418checkHpcHash hsc_env iface = do
1419    let old_hash = mi_hpc_hash (mi_final_exts iface)
1420    new_hash <- liftIO $ fingerprintHpcFlags (hsc_dflags hsc_env)
1421                                               putNameLiterally
1422    if | old_hash == new_hash
1423         -> up_to_date (text "HPC flags unchanged")
1424       | gopt Opt_IgnoreHpcChanges (hsc_dflags hsc_env)
1425         -> up_to_date (text "HPC flags changed; ignoring")
1426       | otherwise
1427         -> out_of_date_hash "HPC flags changed"
1428                     (text "  HPC flags have changed")
1429                     old_hash new_hash
1430
1431-- Check that the set of signatures we are merging in match.
1432-- If the -unit-id flags change, this can change too.
1433checkMergedSignatures :: ModSummary -> ModIface -> IfG RecompileRequired
1434checkMergedSignatures mod_summary iface = do
1435    dflags <- getDynFlags
1436    let old_merged = sort [ mod | UsageMergedRequirement{ usg_mod = mod } <- mi_usages iface ]
1437        new_merged = case Map.lookup (ms_mod_name mod_summary)
1438                                     (requirementContext (pkgState dflags)) of
1439                        Nothing -> []
1440                        Just r -> sort $ map (indefModuleToModule dflags) r
1441    if old_merged == new_merged
1442        then up_to_date (text "signatures to merge in unchanged" $$ ppr new_merged)
1443        else return (RecompBecause "signatures to merge in changed")
1444
1445-- If the direct imports of this module are resolved to targets that
1446-- are not among the dependencies of the previous interface file,
1447-- then we definitely need to recompile.  This catches cases like
1448--   - an exposed package has been upgraded
1449--   - we are compiling with different package flags
1450--   - a home module that was shadowing a package module has been removed
1451--   - a new home module has been added that shadows a package module
1452-- See bug #1372.
1453--
1454-- In addition, we also check if the union of dependencies of the imported
1455-- modules has any difference to the previous set of dependencies. We would need
1456-- to recompile in that case also since the `mi_deps` field of ModIface needs
1457-- to be updated to match that information. This is one of the invariants
1458-- of interface files (see https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance#interface-file-invariants).
1459-- See bug #16511.
1460--
1461-- Returns (RecompBecause <textual reason>) if recompilation is required.
1462checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired
1463checkDependencies hsc_env summary iface
1464 = do
1465   checkList $
1466     [ checkList (map dep_missing (ms_imps summary ++ ms_srcimps summary))
1467     , do
1468         (recomp, mnames_seen) <- runUntilRecompRequired $ map
1469           checkForNewHomeDependency
1470           (ms_home_imps summary)
1471         case recomp of
1472           UpToDate -> do
1473             let
1474               seen_home_deps = Set.unions $ map Set.fromList mnames_seen
1475             checkIfAllOldHomeDependenciesAreSeen seen_home_deps
1476           _ -> return recomp]
1477 where
1478   prev_dep_mods = dep_mods (mi_deps iface)
1479   prev_dep_plgn = dep_plgins (mi_deps iface)
1480   prev_dep_pkgs = dep_pkgs (mi_deps iface)
1481
1482   this_pkg = thisPackage (hsc_dflags hsc_env)
1483
1484   dep_missing (mb_pkg, L _ mod) = do
1485     find_res <- liftIO $ findImportedModule hsc_env mod (mb_pkg)
1486     let reason = moduleNameString mod ++ " changed"
1487     case find_res of
1488        Found _ mod
1489          | pkg == this_pkg
1490           -> if moduleName mod `notElem` map fst prev_dep_mods ++ prev_dep_plgn
1491                 then do traceHiDiffs $
1492                           text "imported module " <> quotes (ppr mod) <>
1493                           text " not among previous dependencies"
1494                         return (RecompBecause reason)
1495                 else
1496                         return UpToDate
1497          | otherwise
1498           -> if toInstalledUnitId pkg `notElem` (map fst prev_dep_pkgs)
1499                 then do traceHiDiffs $
1500                           text "imported module " <> quotes (ppr mod) <>
1501                           text " is from package " <> quotes (ppr pkg) <>
1502                           text ", which is not among previous dependencies"
1503                         return (RecompBecause reason)
1504                 else
1505                         return UpToDate
1506           where pkg = moduleUnitId mod
1507        _otherwise  -> return (RecompBecause reason)
1508
1509   old_deps = Set.fromList $ map fst $ filter (not . snd) prev_dep_mods
1510   isOldHomeDeps = flip Set.member old_deps
1511   checkForNewHomeDependency (L _ mname) = do
1512     let
1513       mod = mkModule this_pkg mname
1514       str_mname = moduleNameString mname
1515       reason = str_mname ++ " changed"
1516     -- We only want to look at home modules to check if any new home dependency
1517     -- pops in and thus here, skip modules that are not home. Checking
1518     -- membership in old home dependencies suffice because the `dep_missing`
1519     -- check already verified that all imported home modules are present there.
1520     if not (isOldHomeDeps mname)
1521       then return (UpToDate, [])
1522       else do
1523         mb_result <- getFromModIface "need mi_deps for" mod $ \imported_iface -> do
1524           let mnames = mname:(map fst $ filter (not . snd) $
1525                 dep_mods $ mi_deps imported_iface)
1526           case find (not . isOldHomeDeps) mnames of
1527             Nothing -> return (UpToDate, mnames)
1528             Just new_dep_mname -> do
1529               traceHiDiffs $
1530                 text "imported home module " <> quotes (ppr mod) <>
1531                 text " has a new dependency " <> quotes (ppr new_dep_mname)
1532               return (RecompBecause reason, [])
1533         return $ fromMaybe (MustCompile, []) mb_result
1534
1535   -- Performs all recompilation checks in the list until a check that yields
1536   -- recompile required is encountered. Returns the list of the results of
1537   -- all UpToDate checks.
1538   runUntilRecompRequired []             = return (UpToDate, [])
1539   runUntilRecompRequired (check:checks) = do
1540     (recompile, value) <- check
1541     if recompileRequired recompile
1542       then return (recompile, [])
1543       else do
1544         (recomp, values) <- runUntilRecompRequired checks
1545         return (recomp, value:values)
1546
1547   checkIfAllOldHomeDependenciesAreSeen seen_deps = do
1548     let unseen_old_deps = Set.difference
1549          old_deps
1550          seen_deps
1551     if not (null unseen_old_deps)
1552       then do
1553         let missing_dep = Set.elemAt 0 unseen_old_deps
1554         traceHiDiffs $
1555           text "missing old home dependency " <> quotes (ppr missing_dep)
1556         return $ RecompBecause "missing old dependency"
1557       else return UpToDate
1558
1559needInterface :: Module -> (ModIface -> IfG RecompileRequired)
1560             -> IfG RecompileRequired
1561needInterface mod continue
1562  = do
1563      mb_recomp <- getFromModIface
1564        "need version info for"
1565        mod
1566        continue
1567      case mb_recomp of
1568        Nothing -> return MustCompile
1569        Just recomp -> return recomp
1570
1571getFromModIface :: String -> Module -> (ModIface -> IfG a)
1572              -> IfG (Maybe a)
1573getFromModIface doc_msg mod getter
1574  = do  -- Load the imported interface if possible
1575    let doc_str = sep [text doc_msg, ppr mod]
1576    traceHiDiffs (text "Checking innterface for module" <+> ppr mod)
1577
1578    mb_iface <- loadInterface doc_str mod ImportBySystem
1579        -- Load the interface, but don't complain on failure;
1580        -- Instead, get an Either back which we can test
1581
1582    case mb_iface of
1583      Failed _ -> do
1584        traceHiDiffs (sep [text "Couldn't load interface for module",
1585                           ppr mod])
1586        return Nothing
1587                  -- Couldn't find or parse a module mentioned in the
1588                  -- old interface file.  Don't complain: it might
1589                  -- just be that the current module doesn't need that
1590                  -- import and it's been deleted
1591      Succeeded iface -> Just <$> getter iface
1592
1593-- | Given the usage information extracted from the old
1594-- M.hi file for the module being compiled, figure out
1595-- whether M needs to be recompiled.
1596checkModUsage :: UnitId -> Usage -> IfG RecompileRequired
1597checkModUsage _this_pkg UsagePackageModule{
1598                                usg_mod = mod,
1599                                usg_mod_hash = old_mod_hash }
1600  = needInterface mod $ \iface -> do
1601    let reason = moduleNameString (moduleName mod) ++ " changed"
1602    checkModuleFingerprint reason old_mod_hash (mi_mod_hash (mi_final_exts iface))
1603        -- We only track the ABI hash of package modules, rather than
1604        -- individual entity usages, so if the ABI hash changes we must
1605        -- recompile.  This is safe but may entail more recompilation when
1606        -- a dependent package has changed.
1607
1608checkModUsage _ UsageMergedRequirement{ usg_mod = mod, usg_mod_hash = old_mod_hash }
1609  = needInterface mod $ \iface -> do
1610    let reason = moduleNameString (moduleName mod) ++ " changed (raw)"
1611    checkModuleFingerprint reason old_mod_hash (mi_mod_hash (mi_final_exts iface))
1612
1613checkModUsage this_pkg UsageHomeModule{
1614                                usg_mod_name = mod_name,
1615                                usg_mod_hash = old_mod_hash,
1616                                usg_exports = maybe_old_export_hash,
1617                                usg_entities = old_decl_hash }
1618  = do
1619    let mod = mkModule this_pkg mod_name
1620    needInterface mod $ \iface -> do
1621
1622    let
1623        new_mod_hash    = mi_mod_hash (mi_final_exts iface)
1624        new_decl_hash   = mi_hash_fn  (mi_final_exts iface)
1625        new_export_hash = mi_exp_hash (mi_final_exts iface)
1626
1627        reason = moduleNameString mod_name ++ " changed"
1628
1629        -- CHECK MODULE
1630    recompile <- checkModuleFingerprint reason old_mod_hash new_mod_hash
1631    if not (recompileRequired recompile)
1632      then return UpToDate
1633      else do
1634
1635        -- CHECK EXPORT LIST
1636        checkMaybeHash reason maybe_old_export_hash new_export_hash
1637            (text "  Export list changed") $ do
1638
1639        -- CHECK ITEMS ONE BY ONE
1640        recompile <- checkList [ checkEntityUsage reason new_decl_hash u
1641                               | u <- old_decl_hash]
1642        if recompileRequired recompile
1643          then return recompile     -- This one failed, so just bail out now
1644          else up_to_date (text "  Great!  The bits I use are up to date")
1645
1646
1647checkModUsage _this_pkg UsageFile{ usg_file_path = file,
1648                                   usg_file_hash = old_hash } =
1649  liftIO $
1650    handleIO handle $ do
1651      new_hash <- getFileHash file
1652      if (old_hash /= new_hash)
1653         then return recomp
1654         else return UpToDate
1655 where
1656   recomp = RecompBecause (file ++ " changed")
1657   handle =
1658#if defined(DEBUG)
1659       \e -> pprTrace "UsageFile" (text (show e)) $ return recomp
1660#else
1661       \_ -> return recomp -- if we can't find the file, just recompile, don't fail
1662#endif
1663
1664------------------------
1665checkModuleFingerprint :: String -> Fingerprint -> Fingerprint
1666                       -> IfG RecompileRequired
1667checkModuleFingerprint reason old_mod_hash new_mod_hash
1668  | new_mod_hash == old_mod_hash
1669  = up_to_date (text "Module fingerprint unchanged")
1670
1671  | otherwise
1672  = out_of_date_hash reason (text "  Module fingerprint has changed")
1673                     old_mod_hash new_mod_hash
1674
1675------------------------
1676checkMaybeHash :: String -> Maybe Fingerprint -> Fingerprint -> SDoc
1677               -> IfG RecompileRequired -> IfG RecompileRequired
1678checkMaybeHash reason maybe_old_hash new_hash doc continue
1679  | Just hash <- maybe_old_hash, hash /= new_hash
1680  = out_of_date_hash reason doc hash new_hash
1681  | otherwise
1682  = continue
1683
1684------------------------
1685checkEntityUsage :: String
1686                 -> (OccName -> Maybe (OccName, Fingerprint))
1687                 -> (OccName, Fingerprint)
1688                 -> IfG RecompileRequired
1689checkEntityUsage reason new_hash (name,old_hash)
1690  = case new_hash name of
1691
1692        Nothing       ->        -- We used it before, but it ain't there now
1693                          out_of_date reason (sep [text "No longer exported:", ppr name])
1694
1695        Just (_, new_hash)      -- It's there, but is it up to date?
1696          | new_hash == old_hash -> do traceHiDiffs (text "  Up to date" <+> ppr name <+> parens (ppr new_hash))
1697                                       return UpToDate
1698          | otherwise            -> out_of_date_hash reason (text "  Out of date:" <+> ppr name)
1699                                                     old_hash new_hash
1700
1701up_to_date :: SDoc -> IfG RecompileRequired
1702up_to_date  msg = traceHiDiffs msg >> return UpToDate
1703
1704out_of_date :: String -> SDoc -> IfG RecompileRequired
1705out_of_date reason msg = traceHiDiffs msg >> return (RecompBecause reason)
1706
1707out_of_date_hash :: String -> SDoc -> Fingerprint -> Fingerprint -> IfG RecompileRequired
1708out_of_date_hash reason msg old_hash new_hash
1709  = out_of_date reason (hsep [msg, ppr old_hash, text "->", ppr new_hash])
1710
1711----------------------
1712checkList :: [IfG RecompileRequired] -> IfG RecompileRequired
1713-- This helper is used in two places
1714checkList []             = return UpToDate
1715checkList (check:checks) = do recompile <- check
1716                              if recompileRequired recompile
1717                                then return recompile
1718                                else checkList checks
1719
1720{-
1721************************************************************************
1722*                                                                      *
1723                Converting things to their Iface equivalents
1724*                                                                      *
1725************************************************************************
1726-}
1727
1728tyThingToIfaceDecl :: TyThing -> IfaceDecl
1729tyThingToIfaceDecl (AnId id)      = idToIfaceDecl id
1730tyThingToIfaceDecl (ATyCon tycon) = snd (tyConToIfaceDecl emptyTidyEnv tycon)
1731tyThingToIfaceDecl (ACoAxiom ax)  = coAxiomToIfaceDecl ax
1732tyThingToIfaceDecl (AConLike cl)  = case cl of
1733    RealDataCon dc -> dataConToIfaceDecl dc -- for ppr purposes only
1734    PatSynCon ps   -> patSynToIfaceDecl ps
1735
1736--------------------------
1737idToIfaceDecl :: Id -> IfaceDecl
1738-- The Id is already tidied, so that locally-bound names
1739-- (lambdas, for-alls) already have non-clashing OccNames
1740-- We can't tidy it here, locally, because it may have
1741-- free variables in its type or IdInfo
1742idToIfaceDecl id
1743  = IfaceId { ifName      = getName id,
1744              ifType      = toIfaceType (idType id),
1745              ifIdDetails = toIfaceIdDetails (idDetails id),
1746              ifIdInfo    = toIfaceIdInfo (idInfo id) }
1747
1748--------------------------
1749dataConToIfaceDecl :: DataCon -> IfaceDecl
1750dataConToIfaceDecl dataCon
1751  = IfaceId { ifName      = getName dataCon,
1752              ifType      = toIfaceType (dataConUserType dataCon),
1753              ifIdDetails = IfVanillaId,
1754              ifIdInfo    = NoInfo }
1755
1756--------------------------
1757coAxiomToIfaceDecl :: CoAxiom br -> IfaceDecl
1758-- We *do* tidy Axioms, because they are not (and cannot
1759-- conveniently be) built in tidy form
1760coAxiomToIfaceDecl ax@(CoAxiom { co_ax_tc = tycon, co_ax_branches = branches
1761                               , co_ax_role = role })
1762 = IfaceAxiom { ifName       = getName ax
1763              , ifTyCon      = toIfaceTyCon tycon
1764              , ifRole       = role
1765              , ifAxBranches = map (coAxBranchToIfaceBranch tycon
1766                                     (map coAxBranchLHS branch_list))
1767                                   branch_list }
1768 where
1769   branch_list = fromBranches branches
1770
1771-- 2nd parameter is the list of branch LHSs, in case of a closed type family,
1772-- for conversion from incompatible branches to incompatible indices.
1773-- For an open type family the list should be empty.
1774-- See Note [Storing compatibility] in CoAxiom
1775coAxBranchToIfaceBranch :: TyCon -> [[Type]] -> CoAxBranch -> IfaceAxBranch
1776coAxBranchToIfaceBranch tc lhs_s
1777                        (CoAxBranch { cab_tvs = tvs, cab_cvs = cvs
1778                                    , cab_eta_tvs = eta_tvs
1779                                    , cab_lhs = lhs, cab_roles = roles
1780                                    , cab_rhs = rhs, cab_incomps = incomps })
1781
1782  = IfaceAxBranch { ifaxbTyVars  = toIfaceTvBndrs tvs
1783                  , ifaxbCoVars  = map toIfaceIdBndr cvs
1784                  , ifaxbEtaTyVars = toIfaceTvBndrs eta_tvs
1785                  , ifaxbLHS     = toIfaceTcArgs tc lhs
1786                  , ifaxbRoles   = roles
1787                  , ifaxbRHS     = toIfaceType rhs
1788                  , ifaxbIncomps = iface_incomps }
1789  where
1790    iface_incomps = map (expectJust "iface_incomps"
1791                        . flip findIndex lhs_s
1792                        . eqTypes
1793                        . coAxBranchLHS) incomps
1794
1795-----------------
1796tyConToIfaceDecl :: TidyEnv -> TyCon -> (TidyEnv, IfaceDecl)
1797-- We *do* tidy TyCons, because they are not (and cannot
1798-- conveniently be) built in tidy form
1799-- The returned TidyEnv is the one after tidying the tyConTyVars
1800tyConToIfaceDecl env tycon
1801  | Just clas <- tyConClass_maybe tycon
1802  = classToIfaceDecl env clas
1803
1804  | Just syn_rhs <- synTyConRhs_maybe tycon
1805  = ( tc_env1
1806    , IfaceSynonym { ifName    = getName tycon,
1807                     ifRoles   = tyConRoles tycon,
1808                     ifSynRhs  = if_syn_type syn_rhs,
1809                     ifBinders = if_binders,
1810                     ifResKind = if_res_kind
1811                   })
1812
1813  | Just fam_flav <- famTyConFlav_maybe tycon
1814  = ( tc_env1
1815    , IfaceFamily { ifName    = getName tycon,
1816                    ifResVar  = if_res_var,
1817                    ifFamFlav = to_if_fam_flav fam_flav,
1818                    ifBinders = if_binders,
1819                    ifResKind = if_res_kind,
1820                    ifFamInj  = tyConInjectivityInfo tycon
1821                  })
1822
1823  | isAlgTyCon tycon
1824  = ( tc_env1
1825    , IfaceData { ifName    = getName tycon,
1826                  ifBinders = if_binders,
1827                  ifResKind = if_res_kind,
1828                  ifCType   = tyConCType tycon,
1829                  ifRoles   = tyConRoles tycon,
1830                  ifCtxt    = tidyToIfaceContext tc_env1 (tyConStupidTheta tycon),
1831                  ifCons    = ifaceConDecls (algTyConRhs tycon),
1832                  ifGadtSyntax = isGadtSyntaxTyCon tycon,
1833                  ifParent  = parent })
1834
1835  | otherwise  -- FunTyCon, PrimTyCon, promoted TyCon/DataCon
1836  -- We only convert these TyCons to IfaceTyCons when we are
1837  -- just about to pretty-print them, not because we are going
1838  -- to put them into interface files
1839  = ( env
1840    , IfaceData { ifName       = getName tycon,
1841                  ifBinders    = if_binders,
1842                  ifResKind    = if_res_kind,
1843                  ifCType      = Nothing,
1844                  ifRoles      = tyConRoles tycon,
1845                  ifCtxt       = [],
1846                  ifCons       = IfDataTyCon [],
1847                  ifGadtSyntax = False,
1848                  ifParent     = IfNoParent })
1849  where
1850    -- NOTE: Not all TyCons have `tyConTyVars` field. Forcing this when `tycon`
1851    -- is one of these TyCons (FunTyCon, PrimTyCon, PromotedDataCon) will cause
1852    -- an error.
1853    (tc_env1, tc_binders) = tidyTyConBinders env (tyConBinders tycon)
1854    tc_tyvars      = binderVars tc_binders
1855    if_binders     = toIfaceTyCoVarBinders tc_binders
1856                     -- No tidying of the binders; they are already tidy
1857    if_res_kind    = tidyToIfaceType tc_env1 (tyConResKind tycon)
1858    if_syn_type ty = tidyToIfaceType tc_env1 ty
1859    if_res_var     = getOccFS `fmap` tyConFamilyResVar_maybe tycon
1860
1861    parent = case tyConFamInstSig_maybe tycon of
1862               Just (tc, ty, ax) -> IfDataInstance (coAxiomName ax)
1863                                                   (toIfaceTyCon tc)
1864                                                   (tidyToIfaceTcArgs tc_env1 tc ty)
1865               Nothing           -> IfNoParent
1866
1867    to_if_fam_flav OpenSynFamilyTyCon             = IfaceOpenSynFamilyTyCon
1868    to_if_fam_flav AbstractClosedSynFamilyTyCon   = IfaceAbstractClosedSynFamilyTyCon
1869    to_if_fam_flav (DataFamilyTyCon {})           = IfaceDataFamilyTyCon
1870    to_if_fam_flav (BuiltInSynFamTyCon {})        = IfaceBuiltInSynFamTyCon
1871    to_if_fam_flav (ClosedSynFamilyTyCon Nothing) = IfaceClosedSynFamilyTyCon Nothing
1872    to_if_fam_flav (ClosedSynFamilyTyCon (Just ax))
1873      = IfaceClosedSynFamilyTyCon (Just (axn, ibr))
1874      where defs = fromBranches $ coAxiomBranches ax
1875            lhss = map coAxBranchLHS defs
1876            ibr  = map (coAxBranchToIfaceBranch tycon lhss) defs
1877            axn  = coAxiomName ax
1878
1879    ifaceConDecls (NewTyCon { data_con = con })    = IfNewTyCon  (ifaceConDecl con)
1880    ifaceConDecls (DataTyCon { data_cons = cons }) = IfDataTyCon (map ifaceConDecl cons)
1881    ifaceConDecls (TupleTyCon { data_con = con })  = IfDataTyCon [ifaceConDecl con]
1882    ifaceConDecls (SumTyCon { data_cons = cons })  = IfDataTyCon (map ifaceConDecl cons)
1883    ifaceConDecls AbstractTyCon                    = IfAbstractTyCon
1884        -- The AbstractTyCon case happens when a TyCon has been trimmed
1885        -- during tidying.
1886        -- Furthermore, tyThingToIfaceDecl is also used in TcRnDriver
1887        -- for GHCi, when browsing a module, in which case the
1888        -- AbstractTyCon and TupleTyCon cases are perfectly sensible.
1889        -- (Tuple declarations are not serialised into interface files.)
1890
1891    ifaceConDecl data_con
1892        = IfCon   { ifConName    = dataConName data_con,
1893                    ifConInfix   = dataConIsInfix data_con,
1894                    ifConWrapper = isJust (dataConWrapId_maybe data_con),
1895                    ifConExTCvs  = map toIfaceBndr ex_tvs',
1896                    ifConUserTvBinders = map toIfaceForAllBndr user_bndrs',
1897                    ifConEqSpec  = map (to_eq_spec . eqSpecPair) eq_spec,
1898                    ifConCtxt    = tidyToIfaceContext con_env2 theta,
1899                    ifConArgTys  = map (tidyToIfaceType con_env2) arg_tys,
1900                    ifConFields  = dataConFieldLabels data_con,
1901                    ifConStricts = map (toIfaceBang con_env2)
1902                                       (dataConImplBangs data_con),
1903                    ifConSrcStricts = map toIfaceSrcBang
1904                                          (dataConSrcBangs data_con)}
1905        where
1906          (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, _)
1907            = dataConFullSig data_con
1908          user_bndrs = dataConUserTyVarBinders data_con
1909
1910          -- Tidy the univ_tvs of the data constructor to be identical
1911          -- to the tyConTyVars of the type constructor.  This means
1912          -- (a) we don't need to redundantly put them into the interface file
1913          -- (b) when pretty-printing an Iface data declaration in H98-style syntax,
1914          --     we know that the type variables will line up
1915          -- The latter (b) is important because we pretty-print type constructors
1916          -- by converting to IfaceSyn and pretty-printing that
1917          con_env1 = (fst tc_env1, mkVarEnv (zipEqual "ifaceConDecl" univ_tvs tc_tyvars))
1918                     -- A bit grimy, perhaps, but it's simple!
1919
1920          (con_env2, ex_tvs') = tidyVarBndrs con_env1 ex_tvs
1921          user_bndrs' = map (tidyUserTyCoVarBinder con_env2) user_bndrs
1922          to_eq_spec (tv,ty) = (tidyTyVar con_env2 tv, tidyToIfaceType con_env2 ty)
1923
1924          -- By this point, we have tidied every universal and existential
1925          -- tyvar. Because of the dcUserTyCoVarBinders invariant
1926          -- (see Note [DataCon user type variable binders]), *every*
1927          -- user-written tyvar must be contained in the substitution that
1928          -- tidying produced. Therefore, tidying the user-written tyvars is a
1929          -- simple matter of looking up each variable in the substitution,
1930          -- which tidyTyCoVarOcc accomplishes.
1931          tidyUserTyCoVarBinder :: TidyEnv -> TyCoVarBinder -> TyCoVarBinder
1932          tidyUserTyCoVarBinder env (Bndr tv vis) =
1933            Bndr (tidyTyCoVarOcc env tv) vis
1934
1935classToIfaceDecl :: TidyEnv -> Class -> (TidyEnv, IfaceDecl)
1936classToIfaceDecl env clas
1937  = ( env1
1938    , IfaceClass { ifName   = getName tycon,
1939                   ifRoles  = tyConRoles (classTyCon clas),
1940                   ifBinders = toIfaceTyCoVarBinders tc_binders,
1941                   ifBody   = body,
1942                   ifFDs    = map toIfaceFD clas_fds })
1943  where
1944    (_, clas_fds, sc_theta, _, clas_ats, op_stuff)
1945      = classExtraBigSig clas
1946    tycon = classTyCon clas
1947
1948    body | isAbstractTyCon tycon = IfAbstractClass
1949         | otherwise
1950         = IfConcreteClass {
1951                ifClassCtxt   = tidyToIfaceContext env1 sc_theta,
1952                ifATs    = map toIfaceAT clas_ats,
1953                ifSigs   = map toIfaceClassOp op_stuff,
1954                ifMinDef = fmap getOccFS (classMinimalDef clas)
1955            }
1956
1957    (env1, tc_binders) = tidyTyConBinders env (tyConBinders tycon)
1958
1959    toIfaceAT :: ClassATItem -> IfaceAT
1960    toIfaceAT (ATI tc def)
1961      = IfaceAT if_decl (fmap (tidyToIfaceType env2 . fst) def)
1962      where
1963        (env2, if_decl) = tyConToIfaceDecl env1 tc
1964
1965    toIfaceClassOp (sel_id, def_meth)
1966        = ASSERT( sel_tyvars == binderVars tc_binders )
1967          IfaceClassOp (getName sel_id)
1968                       (tidyToIfaceType env1 op_ty)
1969                       (fmap toDmSpec def_meth)
1970        where
1971                -- Be careful when splitting the type, because of things
1972                -- like         class Foo a where
1973                --                op :: (?x :: String) => a -> a
1974                -- and          class Baz a where
1975                --                op :: (Ord a) => a -> a
1976          (sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
1977          op_ty                = funResultTy rho_ty
1978
1979    toDmSpec :: (Name, DefMethSpec Type) -> DefMethSpec IfaceType
1980    toDmSpec (_, VanillaDM)       = VanillaDM
1981    toDmSpec (_, GenericDM dm_ty) = GenericDM (tidyToIfaceType env1 dm_ty)
1982
1983    toIfaceFD (tvs1, tvs2) = (map (tidyTyVar env1) tvs1
1984                             ,map (tidyTyVar env1) tvs2)
1985
1986--------------------------
1987
1988tidyTyConBinder :: TidyEnv -> TyConBinder -> (TidyEnv, TyConBinder)
1989-- If the type variable "binder" is in scope, don't re-bind it
1990-- In a class decl, for example, the ATD binders mention
1991-- (amd must mention) the class tyvars
1992tidyTyConBinder env@(_, subst) tvb@(Bndr tv vis)
1993 = case lookupVarEnv subst tv of
1994     Just tv' -> (env,  Bndr tv' vis)
1995     Nothing  -> tidyTyCoVarBinder env tvb
1996
1997tidyTyConBinders :: TidyEnv -> [TyConBinder] -> (TidyEnv, [TyConBinder])
1998tidyTyConBinders = mapAccumL tidyTyConBinder
1999
2000tidyTyVar :: TidyEnv -> TyVar -> FastString
2001tidyTyVar (_, subst) tv = toIfaceTyVar (lookupVarEnv subst tv `orElse` tv)
2002
2003--------------------------
2004instanceToIfaceInst :: ClsInst -> IfaceClsInst
2005instanceToIfaceInst (ClsInst { is_dfun = dfun_id, is_flag = oflag
2006                             , is_cls_nm = cls_name, is_cls = cls
2007                             , is_tcs = mb_tcs
2008                             , is_orphan = orph })
2009  = ASSERT( cls_name == className cls )
2010    IfaceClsInst { ifDFun    = dfun_name,
2011                ifOFlag   = oflag,
2012                ifInstCls = cls_name,
2013                ifInstTys = map do_rough mb_tcs,
2014                ifInstOrph = orph }
2015  where
2016    do_rough Nothing  = Nothing
2017    do_rough (Just n) = Just (toIfaceTyCon_name n)
2018
2019    dfun_name = idName dfun_id
2020
2021
2022--------------------------
2023famInstToIfaceFamInst :: FamInst -> IfaceFamInst
2024famInstToIfaceFamInst (FamInst { fi_axiom    = axiom,
2025                                 fi_fam      = fam,
2026                                 fi_tcs      = roughs })
2027  = IfaceFamInst { ifFamInstAxiom    = coAxiomName axiom
2028                 , ifFamInstFam      = fam
2029                 , ifFamInstTys      = map do_rough roughs
2030                 , ifFamInstOrph     = orph }
2031  where
2032    do_rough Nothing  = Nothing
2033    do_rough (Just n) = Just (toIfaceTyCon_name n)
2034
2035    fam_decl = tyConName $ coAxiomTyCon axiom
2036    mod = ASSERT( isExternalName (coAxiomName axiom) )
2037          nameModule (coAxiomName axiom)
2038    is_local name = nameIsLocalOrFrom mod name
2039
2040    lhs_names = filterNameSet is_local (orphNamesOfCoCon axiom)
2041
2042    orph | is_local fam_decl
2043         = NotOrphan (nameOccName fam_decl)
2044         | otherwise
2045         = chooseOrphanAnchor lhs_names
2046
2047--------------------------
2048coreRuleToIfaceRule :: CoreRule -> IfaceRule
2049coreRuleToIfaceRule (BuiltinRule { ru_fn = fn})
2050  = pprTrace "toHsRule: builtin" (ppr fn) $
2051    bogusIfaceRule fn
2052
2053coreRuleToIfaceRule (Rule { ru_name = name, ru_fn = fn,
2054                            ru_act = act, ru_bndrs = bndrs,
2055                            ru_args = args, ru_rhs = rhs,
2056                            ru_orphan = orph, ru_auto = auto })
2057  = IfaceRule { ifRuleName  = name, ifActivation = act,
2058                ifRuleBndrs = map toIfaceBndr bndrs,
2059                ifRuleHead  = fn,
2060                ifRuleArgs  = map do_arg args,
2061                ifRuleRhs   = toIfaceExpr rhs,
2062                ifRuleAuto  = auto,
2063                ifRuleOrph  = orph }
2064  where
2065        -- For type args we must remove synonyms from the outermost
2066        -- level.  Reason: so that when we read it back in we'll
2067        -- construct the same ru_rough field as we have right now;
2068        -- see tcIfaceRule
2069    do_arg (Type ty)     = IfaceType (toIfaceType (deNoteType ty))
2070    do_arg (Coercion co) = IfaceCo   (toIfaceCoercion co)
2071    do_arg arg           = toIfaceExpr arg
2072
2073bogusIfaceRule :: Name -> IfaceRule
2074bogusIfaceRule id_name
2075  = IfaceRule { ifRuleName = fsLit "bogus", ifActivation = NeverActive,
2076        ifRuleBndrs = [], ifRuleHead = id_name, ifRuleArgs = [],
2077        ifRuleRhs = IfaceExt id_name, ifRuleOrph = IsOrphan,
2078        ifRuleAuto = True }
2079