never executed always true always false
1 {-# LANGUAGE RecordWildCards #-}
2
3 -- | This module manages storing the various GHC option flags in a modules
4 -- interface file as part of the recompilation checking infrastructure.
5 module GHC.Iface.Recomp.Flags (
6 fingerprintDynFlags
7 , fingerprintOptFlags
8 , fingerprintHpcFlags
9 ) where
10
11 import GHC.Prelude
12
13 import GHC.Driver.Session
14 import GHC.Driver.Env
15
16 import GHC.Utils.Binary
17 import GHC.Unit.Module
18 import GHC.Types.Name
19 import GHC.Types.SafeHaskell
20 import GHC.Utils.Fingerprint
21 import GHC.Iface.Recomp.Binary
22 import GHC.Core.Opt.CallerCC () -- for Binary instances
23
24 import GHC.Data.EnumSet as EnumSet
25 import System.FilePath (normalise)
26
27 -- | Produce a fingerprint of a @DynFlags@ value. We only base
28 -- the finger print on important fields in @DynFlags@ so that
29 -- the recompilation checker can use this fingerprint.
30 --
31 -- NB: The 'Module' parameter is the 'Module' recorded by the
32 -- *interface* file, not the actual 'Module' according to our
33 -- 'DynFlags'.
34 fingerprintDynFlags :: HscEnv -> Module
35 -> (BinHandle -> Name -> IO ())
36 -> IO Fingerprint
37
38 fingerprintDynFlags hsc_env this_mod nameio =
39 let dflags@DynFlags{..} = hsc_dflags hsc_env
40 mainis = if mainModIs hsc_env == this_mod then Just mainFunIs else Nothing
41 -- see #5878
42 -- pkgopts = (homeUnit home_unit, sort $ packageFlags dflags)
43 safeHs = setSafeMode safeHaskell
44 -- oflags = sort $ filter filterOFlags $ flags dflags
45
46 -- *all* the extension flags and the language
47 lang = (fmap fromEnum language,
48 map fromEnum $ EnumSet.toList extensionFlags)
49
50 -- avoid fingerprinting the absolute path to the directory of the source file
51 -- see note [Implicit include paths]
52 includePathsMinusImplicit = includePaths { includePathsQuoteImplicit = [] }
53
54 -- -I, -D and -U flags affect CPP
55 cpp = ( map normalise $ flattenIncludes includePathsMinusImplicit
56 -- normalise: eliminate spurious differences due to "./foo" vs "foo"
57 , picPOpts dflags
58 , opt_P_signature dflags)
59 -- See Note [Repeated -optP hashing]
60
61 -- Note [path flags and recompilation]
62 paths = [ hcSuf ]
63
64 -- -fprof-auto etc.
65 prof = if sccProfilingEnabled dflags then fromEnum profAuto else 0
66
67 -- Ticky
68 ticky =
69 map (`gopt` dflags) [Opt_Ticky, Opt_Ticky_Allocd, Opt_Ticky_LNE, Opt_Ticky_Dyn_Thunk]
70
71 flags = ((mainis, safeHs, lang, cpp), (paths, prof, ticky, debugLevel, callerCcFilters))
72
73 in -- pprTrace "flags" (ppr flags) $
74 computeFingerprint nameio flags
75
76 -- Fingerprint the optimisation info. We keep this separate from the rest of
77 -- the flags because GHCi users (especially) may wish to ignore changes in
78 -- optimisation level or optimisation flags so as to use as many pre-existing
79 -- object files as they can.
80 -- See Note [Ignoring some flag changes]
81 fingerprintOptFlags :: DynFlags
82 -> (BinHandle -> Name -> IO ())
83 -> IO Fingerprint
84 fingerprintOptFlags DynFlags{..} nameio =
85 let
86 -- See https://gitlab.haskell.org/ghc/ghc/issues/10923
87 -- We used to fingerprint the optimisation level, but as Joachim
88 -- Breitner pointed out in comment 9 on that ticket, it's better
89 -- to ignore that and just look at the individual optimisation flags.
90 opt_flags = map fromEnum $ filter (`EnumSet.member` optimisationFlags)
91 (EnumSet.toList generalFlags)
92
93 in computeFingerprint nameio opt_flags
94
95 -- Fingerprint the HPC info. We keep this separate from the rest of
96 -- the flags because GHCi users (especially) may wish to use an object
97 -- file compiled for HPC when not actually using HPC.
98 -- See Note [Ignoring some flag changes]
99 fingerprintHpcFlags :: DynFlags
100 -> (BinHandle -> Name -> IO ())
101 -> IO Fingerprint
102 fingerprintHpcFlags dflags@DynFlags{..} nameio =
103 let
104 -- -fhpc, see https://gitlab.haskell.org/ghc/ghc/issues/11798
105 -- hpcDir is output-only, so we should recompile if it changes
106 hpc = if gopt Opt_Hpc dflags then Just hpcDir else Nothing
107
108 in computeFingerprint nameio hpc
109
110
111 {- Note [path flags and recompilation]
112
113 There are several flags that we deliberately omit from the
114 recompilation check; here we explain why.
115
116 -osuf, -odir, -hisuf, -hidir
117 If GHC decides that it does not need to recompile, then
118 it must have found an up-to-date .hi file and .o file.
119 There is no point recording these flags - the user must
120 have passed the correct ones. Indeed, the user may
121 have compiled the source file in one-shot mode using
122 -o to specify the .o file, and then loaded it in GHCi
123 using -odir.
124
125 -stubdir
126 We omit this one because it is automatically set by -outputdir, and
127 we don't want changes in -outputdir to automatically trigger
128 recompilation. This could be wrong, but only in very rare cases.
129
130 -i (importPaths)
131 For the same reason as -osuf etc. above: if GHC decides not to
132 recompile, then it must have already checked all the .hi files on
133 which the current module depends, so it must have found them
134 successfully. It is occasionally useful to be able to cd to a
135 different directory and use -i flags to enable GHC to find the .hi
136 files; we don't want this to force recompilation.
137
138 The only path-related flag left is -hcsuf.
139 -}
140
141 {- Note [Ignoring some flag changes]
142 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
143
144 Normally, --make tries to reuse only compilation products that are
145 the same as those that would have been produced compiling from
146 scratch. Sometimes, however, users would like to be more aggressive
147 about recompilation avoidance. This is particularly likely when
148 developing using GHCi (see #13604). Currently, we allow users to
149 ignore optimisation changes using -fignore-optim-changes, and to
150 ignore HPC option changes using -fignore-hpc-changes. If there's a
151 demand for it, we could also allow changes to -fprof-auto-* flags
152 (although we can't allow -prof flags to differ). The key thing about
153 these options is that we can still successfully link a library or
154 executable when some of its components differ in these ways.
155
156 The way we accomplish this is to leave the optimization and HPC
157 options out of the flag hash, hashing them separately.
158 -}
159
160 {- Note [Repeated -optP hashing]
161 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
162
163 We invoke fingerprintDynFlags for each compiled module to include
164 the hash of relevant DynFlags in the resulting interface file.
165 -optP (preprocessor) flags are part of that hash.
166 -optP flags can come from multiple places:
167
168 1. -optP flags directly passed on command line.
169 2. -optP flags implied by other flags. Eg. -DPROFILING implied by -prof.
170 3. -optP flags added with {-# OPTIONS -optP-D__F__ #-} in a file.
171
172 When compiling many modules at once with many -optP command line arguments
173 the work of hashing -optP flags would be repeated. This can get expensive
174 and as noted on #14697 it can take 7% of time and 14% of allocations on
175 a real codebase.
176
177 The obvious solution is to cache the hash of -optP flags per GHC invocation.
178 However, one has to be careful there, as the flags that were added in 3. way
179 have to be accounted for.
180
181 The current strategy is as follows:
182
183 1. Lazily compute the hash of sOpt_p in sOpt_P_fingerprint whenever sOpt_p
184 is modified. This serves dual purpose. It ensures correctness for when
185 we add per file -optP flags and lets us save work for when we don't.
186 2. When computing the fingerprint in fingerprintDynFlags use the cached
187 value *and* fingerprint the additional implied (see 2. above) -optP flags.
188 This is relatively cheap and saves the headache of fingerprinting all
189 the -optP flags and tracking all the places that could invalidate the
190 cache.
191 -}