Ask LH to tell ghc to collect timings

Author: facundominguez

liquidhaskell-boot/src-ghc/Liquid/GHC/API.hs

@@ -478,6 +478,10 @@ import GHC.Core.Opt.OccurAnal         as Ghc
     ( occurAnalysePgm )
 import GHC.Core.TyCo.FVs              as Ghc (tyCoVarsOfCo, tyCoVarsOfType)
 import GHC.Driver.Backend             as Ghc (interpreterBackend)
+import GHC.Driver.DynFlags            as Ghc
+    ( DumpFlag(Opt_D_dump_timings)
+    , dopt_set
+    )
 import GHC.Driver.Env                 as Ghc
     ( HscEnv(hsc_NC, hsc_unit_env, hsc_dflags, hsc_plugins)
     , Hsc
@@ -827,7 +831,13 @@ import GHC.Utils.Binary               as Ghc
     , withBinBuffer
     )
 import GHC.Utils.Error                as Ghc (pprLocMsgEnvelope, withTiming)
-import GHC.Utils.Logger               as Ghc (Logger(logFlags), putLogMsg)
+import GHC.Utils.Logger               as Ghc
+    ( LogFlags
+    , Logger(logFlags)
+    , putLogMsg
+    , log_set_dopt
+    , updateLogFlags
+    )
 import GHC.Utils.Outputable           as Ghc hiding ((<>))
 import GHC.Utils.Panic                as Ghc (panic, throwGhcException, throwGhcExceptionIO)
 import GHC.Utils.Misc                 as Ghc (lengthAtLeast)

liquidhaskell-boot/src/Language/Haskell/Liquid/GHC/Plugin.hs

@@ -110,7 +110,7 @@ plugin = GHC.defaultPlugin {
   , pluginRecompile       = purePlugin
   }
   where
-    liquidPlugin :: (MonadIO m) => [CommandLineOption] -> a -> (Config -> m a) -> m a
+    liquidPlugin :: MonadIO m => [CommandLineOption] -> a -> (Config -> m a) -> m a
     liquidPlugin opts def go = do
         cfg <- liftIO $ LH.getOpts opts
         if skipModule cfg then return def else go cfg
@@ -130,12 +130,13 @@ plugin = GHC.defaultPlugin {
     -- See also: https://github.com/ucsd-progsys/liquidhaskell/issues/1727
     -- for a post-mortem.
     typecheckPluginGo cfg summary gblEnv = do
-      logger <- getLogger
-      dynFlags <- getDynFlags
+      logger0 <- getLogger
+      let logger = updateLogFlags logger0 (maybeDDumpTimings cfg)
       GHC.withTiming
-          logger (text "LiquidHaskellCPU" <+> brackets (ppr $ ms_mod_name summary)) (const ()) $
+        logger (text "LiquidHaskellCPU" <+> brackets (ppr $ ms_mod_name summary)) (const ()) $
         GHC.withTimingWallClock
           logger (text "LiquidHaskell" <+> brackets (ppr $ ms_mod_name summary)) (const ()) $ do
+        dynFlags <- getDynFlags
         if gopt Opt_Haddock dynFlags
           then do
             -- Warn the user
@@ -158,6 +159,13 @@ plugin = GHC.defaultPlugin {
               Right newGblEnv' ->
                 pure newGblEnv'
 
+    -- We instruct LH to collect timings instead of doing it directly to GHC
+    -- This helps work around https://github.com/haskell/cabal/issues/11116
+    maybeDDumpTimings :: Config -> LogFlags -> LogFlags
+    maybeDDumpTimings cfg =
+      if ddumpTimings cfg then log_set_dopt Opt_D_dump_timings
+      else id
+
 --------------------------------------------------------------------------------
 -- | Inter-phase communication -------------------------------------------------
 --------------------------------------------------------------------------------

liquidhaskell-boot/src/Language/Haskell/Liquid/UX/CmdLine.hs

@@ -443,6 +443,10 @@ defConfig = Config {
     = False &= help "Allow refining constructors with unsafe refinements"
           &= name "allow-unsafe-constructors"
           &= explicit
+  , ddumpTimings
+    = False &= help "Dump time measures of the Liquid Haskell plugin"
+          &= name "ddump-timings"
+          &= explicit
   } &= program "liquidhaskell"
     &= help    "Refinement Types for Haskell"
     &= summary copyright

liquidhaskell-boot/src/Language/Haskell/Liquid/UX/Config.hs

@@ -118,6 +118,8 @@ data Config = Config
   , dumpOpaqueReflections    :: Bool       -- Dumps all opaque reflections to the stdout
   , dumpPreNormalizedCore    :: Bool       -- Dumps the prenormalized core (before a-normalization)
   , allowUnsafeConstructors  :: Bool       -- ^ Allow refining constructors with unsafe refinements
+  , ddumpTimings             :: Bool       -- ^ Dump time measures of the Liquid Haskell plugin
+                                           -- Only needed to work around https://github.com/haskell/cabal/issues/11116
   } deriving (Generic, Data, Show, Eq)
 
 allowPLE :: Config -> Bool

tests/tests.cabal

@@ -20,9 +20,7 @@ flag stack
 flag measure-timings
   default:     False
   manual:      True
-  description: Enable when collecting timing information. It also enables
-               -fforce-recomp since cabal sometimes tries to compile files more
-               than once, and the second run discards the timings of the first.
+  description: Enable when collecting timing information.
 
 executable test-driver
     main-is:        driver.hs
@@ -53,7 +51,10 @@ common common-ghc-options
                       -O0
                       -no-link
     if flag(measure-timings)
-      ghc-options:    -fforce-recomp -ddump-timings -ddump-to-file
+      -- We collect timing measures from GHC whenever the plugin runs
+      -- Doesn't run when linking in particular. See
+      -- https://github.com/haskell/cabal/issues/11116
+      ghc-options:    -fplugin-opt=LiquidHaskell:--ddump-timings -ddump-to-file
     default-language: Haskell2010
 
 flag benchmark-stitch-lh
@@ -851,8 +852,6 @@ executable reflect-pos
                     , ReflString1
                     , T2405
 
-    if flag(measure-timings)
-      ghc-options:    -fforce-recomp -ddump-timings -ddump-to-file
     build-depends:    base
                     , liquid-prelude
                     , liquidhaskell