Cache the fingerprint of sOpt_P

Before this change we would compute a hash of
all the command line -optP flags once per file.
With a lot of files and many -optP flags, that's a lot
of repeated work.

I added a new Note that explains the approach and rationale.

Test Plan: new test

Reviewers: simonmar, simonpj, bgamari

Reviewed By: simonpj

Subscribers: rwbarton, thomie, carter

GHC Trac Issues: #14697

Differential Revision: https://phabricator.haskell.org/D4445

5 files changed, 86 insertions, 2 deletions

diff --git a/compiler/iface/FlagChecker.hs b/compiler/iface/FlagChecker.hs
index 1fc597bdfe..2ef369a5e9 100644
--- a/compiler/iface/FlagChecker.hs
+++ b/compiler/iface/FlagChecker.hs
@@ -47,8 +47,10 @@ fingerprintDynFlags dflags@DynFlags{..} this_mod nameio =
 
         -- -I, -D and -U flags affect CPP
         cpp = ( map normalise $ flattenIncludes includePaths
-              , opt_P dflags ++ picPOpts dflags)
             -- normalise: eliminate spurious differences due to "./foo" vs "foo"
+              , picPOpts dflags
+              , opt_P_signature dflags)
+            -- See Note [Repeated -optP hashing]
 
         -- Note [path flags and recompilation]
         paths = [ hcSuf ]
@@ -144,3 +146,36 @@ executable when some of its components differ in these ways.
 The way we accomplish this is to leave the optimization and HPC
 options out of the flag hash, hashing them separately.
 -}
+
+{- Note [Repeated -optP hashing]
+   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+We invoke fingerprintDynFlags for each compiled module to include
+the hash of relevant DynFlags in the resulting interface file.
+-optP (preprocessor) flags are part of that hash.
+-optP flags can come from multiple places:
+
+  1. -optP flags directly passed on command line.
+  2. -optP flags implied by other flags. Eg. -DPROFILING implied by -prof.
+  3. -optP flags added with {-# OPTIONS -optP-D__F__ #-} in a file.
+
+When compiling many modules at once with many -optP command line arguments
+the work of hashing -optP flags would be repeated. This can get expensive
+and as noted on #14697 it can take 7% of time and 14% of allocations on
+a real codebase.
+
+The obvious solution is to cache the hash of -optP flags per GHC invocation.
+However, one has to be careful there, as the flags that were added in 3. way
+have to be accounted for.
+
+The current strategy is as follows:
+
+  1. Lazily compute the hash of sOpt_p in sOpt_P_fingerprint whenever sOpt_p
+     is modified. This serves dual purpose. It ensures correctness for when
+     we add per file -optP flags and lets us save work for when we don't.
+  2. When computing the fingerprint in fingerprintDynFlags use the cached
+     value *and* fingerprint the additional implied (see 2. above) -optP flags.
+     This is relatively cheap and saves the headache of fingerprinting all
+     the -optP flags and tracking all the places that could invalidate the
+     cache.
+-}
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index b7720dde53..074b7e3933 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -89,6 +89,7 @@ module DynFlags (
         pgm_L, pgm_P, pgm_F, pgm_c, pgm_s, pgm_a, pgm_l, pgm_dll, pgm_T,
         pgm_windres, pgm_libtool, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc,
         pgm_lcc, pgm_i, opt_L, opt_P, opt_F, opt_c, opt_a, opt_l, opt_i,
+        opt_P_signature,
         opt_windres, opt_lo, opt_lc, opt_lcc,
 
         -- ** Manipulating DynFlags
@@ -195,6 +196,7 @@ import qualified Pretty
 import SrcLoc
 import BasicTypes       ( IntWithInf, treatZeroAsInf )
 import FastString
+import Fingerprint
 import Outputable
 import Foreign.C        ( CInt(..) )
 import System.IO.Unsafe ( unsafeDupablePerformIO )
@@ -1169,6 +1171,8 @@ data Settings = Settings {
   -- options for particular phases
   sOpt_L                 :: [String],
   sOpt_P                 :: [String],
+  sOpt_P_fingerprint     :: Fingerprint, -- cached Fingerprint of sOpt_P
+                                         -- See Note [Repeated -optP hashing]
   sOpt_F                 :: [String],
   sOpt_c                 :: [String],
   sOpt_a                 :: [String],
@@ -1241,6 +1245,14 @@ opt_L dflags = sOpt_L (settings dflags)
 opt_P                 :: DynFlags -> [String]
 opt_P dflags = concatMap (wayOptP (targetPlatform dflags)) (ways dflags)
             ++ sOpt_P (settings dflags)
+
+-- This function packages everything that's needed to fingerprint opt_P
+-- flags. See Note [Repeated -optP hashing].
+opt_P_signature       :: DynFlags -> ([String], Fingerprint)
+opt_P_signature dflags =
+  ( concatMap (wayOptP (targetPlatform dflags)) (ways dflags)
+  , sOpt_P_fingerprint (settings dflags))
+
 opt_F                 :: DynFlags -> [String]
 opt_F dflags = sOpt_F (settings dflags)
 opt_c                 :: DynFlags -> [String]
@@ -2434,7 +2446,12 @@ setDumpPrefixForce f d = d { dumpPrefixForce = f}
 setPgmP   f = let (pgm:args) = words f in alterSettings (\s -> s { sPgm_P   = (pgm, map Option args)})
 addOptl   f = alterSettings (\s -> s { sOpt_l   = f : sOpt_l s})
 addOptc   f = alterSettings (\s -> s { sOpt_c   = f : sOpt_c s})
-addOptP   f = alterSettings (\s -> s { sOpt_P   = f : sOpt_P s})
+addOptP   f = alterSettings (\s -> s { sOpt_P   = f : sOpt_P s
+                                     , sOpt_P_fingerprint = fingerprintStrings (f : sOpt_P s)
+                                     })
+                                     -- See Note [Repeated -optP hashing]
+  where
+  fingerprintStrings ss = fingerprintFingerprints $ map fingerprintString ss
 
 
 setDepMakefile :: FilePath -> DynFlags -> DynFlags
diff --git a/compiler/main/SysTools.hs b/compiler/main/SysTools.hs
index 4c162865ec..35935cacb0 100644
--- a/compiler/main/SysTools.hs
+++ b/compiler/main/SysTools.hs
@@ -48,6 +48,7 @@ import ErrUtils
 import Platform
 import Util
 import DynFlags
+import Fingerprint
 
 import System.FilePath
 import System.IO
@@ -302,6 +303,7 @@ initSysTools mbMinusB
                     sPgm_i   = iserv_prog,
                     sOpt_L       = [],
                     sOpt_P       = [],
+                    sOpt_P_fingerprint = fingerprint0,
                     sOpt_F       = [],
                     sOpt_c       = [],
                     sOpt_a       = [],
diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T
index 1a2413aeab..2afa595d25 100644
--- a/testsuite/tests/perf/compiler/all.T
+++ b/testsuite/tests/perf/compiler/all.T
@@ -1212,6 +1212,19 @@ test('T13719',
      multimod_compile,
      ['T13719', '-v0'])
 
+test('T14697',
+     [ compiler_stats_num_field('bytes allocated',
+          [(wordsize(64), 337290376, 10),
+          # initial:    635573784
+          # 2018-02-23: 337290376 Cache the fingerprint of sOpt_P
+          ]),
+       pre_cmd('./genT14697'),
+       extra_files(['genT14697']),
+       extra_hc_opts('$(cat T14697-flags)'), # 10k -optP arguments
+     ],
+     multimod_compile,
+     ['T14697', '-v0'])
+
 test('Naperian',
      [ reqlib('vector'),
        only_ways(['optasm']),
diff --git a/testsuite/tests/perf/compiler/genT14697 b/testsuite/tests/perf/compiler/genT14697
new file mode 100755
index 0000000000..e3fe4f4ce7
--- /dev/null
+++ b/testsuite/tests/perf/compiler/genT14697
@@ -0,0 +1,17 @@
+#!/bin/bash
+SIZE=100
+ROOT=T14697
+# Generates 100 empty modules and T14697 that imports them all
+# It (along with the command line arguments) reproduces a problem where
+# -optP command line flags would be hashed once per file
+for i in $(seq -w 1 $SIZE); do
+  echo "module A$i where" > A$i.hs
+done
+
+echo "module ${ROOT} where" > $ROOT.hs
+for i in $(seq -w 1 $SIZE); do
+  echo "import A$i" >> $ROOT.hs;
+done
+
+# generate flags
+echo -optP-D__F{1..10000}__ > T14697-flags