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