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 -}