Merge branch 'master' into ghc-8.10.4

Author: jneira

ghcide/bench/hist/Main.hs

@@ -55,6 +55,7 @@ import Development.Shake.Classes
 import System.Console.GetOpt
 import Data.Maybe
 import Control.Monad.Extra
+import System.FilePath
 
 
 configPath :: FilePath
@@ -84,7 +85,12 @@ main = shakeArgsWith shakeOpts [configOpt] $ \configs wants -> pure $ Just $ do
       _ -> want wants
 
 ghcideBuildRules :: MkBuildRules BuildSystem
-ghcideBuildRules = MkBuildRules findGhcForBuildSystem "ghcide" buildGhcide
+ghcideBuildRules = MkBuildRules findGhcForBuildSystem "ghcide" projectDepends buildGhcide
+  where
+      projectDepends = do
+        need . map ("src" </>) =<< getDirectoryFiles "src" ["//*.hs"]
+        need . map ("session-loader" </>) =<< getDirectoryFiles "session-loader" ["//*.hs"]
+        need =<< getDirectoryFiles "." ["*.cabal"]
 
 --------------------------------------------------------------------------------
 
@@ -116,7 +122,7 @@ createBuildSystem config = do
   let build = outputFolder configStatic
 
   buildRules build ghcideBuildRules
-  benchRules build (MkBenchRules (askOracle $ GetSamples ()) benchGhcide "ghcide")
+  benchRules build (MkBenchRules (askOracle $ GetSamples ()) benchGhcide warmupGhcide "ghcide")
   csvRules build
   svgRules build
   heapProfileRules build
@@ -141,6 +147,7 @@ buildGhcide Cabal args out = do
         ,"--install-method=copy"
         ,"--overwrite-policy=always"
         ,"--ghc-options=-rtsopts"
+        ,"--ghc-options=-eventlog"
         ]
 
 buildGhcide Stack args out =
@@ -150,6 +157,7 @@ buildGhcide Stack args out =
         ,"ghcide:ghcide"
         ,"--copy-bins"
         ,"--ghc-options=-rtsopts"
+        ,"--ghc-options=-eventlog"
         ]
 
 benchGhcide
@@ -170,3 +178,15 @@ benchGhcide samples buildSystem args BenchProject{..} = do
     [ "--stack" | Stack == buildSystem
     ]
 
+warmupGhcide :: BuildSystem -> FilePath -> [CmdOption] -> Example -> Action ()
+warmupGhcide buildSystem exePath args example = do
+  command args "ghcide-bench" $
+    [ "--no-clean",
+      "-v",
+      "--samples=1",
+      "--ghcide=" <> exePath,
+      "--select=hover"
+    ] ++
+    exampleToOptions example ++
+    [ "--stack" | Stack == buildSystem
+    ]

shake-bench/src/Development/Benchmark/Rules.hs

@@ -177,6 +177,8 @@ data MkBuildRules buildSystem = MkBuildRules
     findGhc            :: buildSystem -> FilePath -> IO FilePath
     -- | Name of the binary produced by 'buildProject'
   , executableName     :: String
+    -- | An action that captures the source dependencies, used for the HEAD build
+  , projectDepends     :: Action ()
     -- | Build the project found in the cwd and save the build artifacts in the output folder
   , buildProject       :: buildSystem
                        -> [CmdOption]
@@ -204,9 +206,8 @@ buildRules build MkBuildRules{..} = do
                 , build -/- "binaries/HEAD/ghc.path"
                 ]
     &%> \[out, ghcpath] -> do
+      projectDepends
       liftIO $ createDirectoryIfMissing True $ dropFileName out
-      -- TOOD more precise dependency tracking
-      need =<< getDirectoryFiles "." ["//*.hs", "*.cabal"]
       buildSystem <- askOracle $ GetBuildSystem ()
       buildProject buildSystem [Cwd "."] (takeDirectory out)
       ghcLoc <- liftIO $ findGhc buildSystem "."
@@ -233,6 +234,8 @@ data MkBenchRules buildSystem example =  forall setup. MkBenchRules
     setupProject :: Action setup
   -- | An action that invokes the executable to run the benchmark
   , benchProject :: setup -> buildSystem -> [CmdOption] -> BenchProject example -> Action ()
+  -- | An action that performs any necessary warmup. Will only be invoked once
+  , warmupProject :: buildSystem -> FilePath -> [CmdOption] -> example -> Action ()
   -- | Name of the executable to benchmark. Should match the one used to 'MkBuildRules'
   , executableName :: String
   }
@@ -262,13 +265,34 @@ benchRules :: RuleResultForExample example => FilePattern -> MkBenchRules BuildS
 benchRules build MkBenchRules{..} = do
 
   benchResource <- newResource "ghcide-bench" 1
+  -- warmup an example
+  build -/- "binaries/*/*.warmup" %> \out -> do
+        let [_, _, ver, exampleName] = splitDirectories (dropExtension out)
+        let exePath = build </> "binaries" </> ver </> executableName
+            ghcPath = build </> "binaries" </> ver </> "ghc.path"
+        need [exePath, ghcPath]
+        buildSystem <- askOracle  $ GetBuildSystem ()
+        example <- fromMaybe (error $ "Unknown example " <> exampleName)
+                    <$> askOracle (GetExample exampleName)
+        let exeExtraArgs = []
+            outcsv = ""
+            experiment = Escaped "hover"
+        withResource benchResource 1 $ warmupProject buildSystem exePath
+              [ EchoStdout False,
+                FileStdout out,
+                RemEnv "NIX_GHC_LIBDIR",
+                RemEnv "GHC_PACKAGE_PATH",
+                AddPath [takeDirectory ghcPath, "."] []
+              ]
+              example
   -- run an experiment
   priority 0 $
     [ build -/- "*/*/*/*.csv",
       build -/- "*/*/*/*.gcStats.log",
       build -/- "*/*/*/*.output.log",
+      build -/- "*/*/*/*.eventlog",
       build -/- "*/*/*/*.hp"
-    ] &%> \[outcsv, outGc, outLog, outHp] -> do
+    ] &%> \[outcsv, outGc, outLog, outEventlog, outHp] -> do
         let [_, flavour, exampleName, ver, exp] = splitDirectories outcsv
             prof = fromMaybe (error $ "Not a valid profiling mode: " <> flavour) $ profilingP flavour
         example <- fromMaybe (error $ "Unknown example " <> exampleName)
@@ -279,6 +303,7 @@ benchRules build MkBenchRules{..} = do
         let exePath    = build </> "binaries" </> ver </> executableName
             exeExtraArgs =
                 [ "+RTS"
+                , "-l-au"
                 , "-S" <> outGc]
              ++ concat
                 [[ "-h"
@@ -287,8 +312,9 @@ benchRules build MkBenchRules{..} = do
                  | CheapHeapProfiling i <- [prof]]
              ++ ["-RTS"]
             ghcPath    = build </> "binaries" </> ver </> "ghc.path"
+            warmupPath = build </> "binaries" </> ver </> exampleName <.> "warmup"
             experiment = Escaped $ dropExtension exp
-        need [exePath, ghcPath]
+        need [exePath, ghcPath, warmupPath]
         ghcPath <- readFile' ghcPath
         withResource benchResource 1 $ do
           benchProject setupRes buildSystem
@@ -299,6 +325,7 @@ benchRules build MkBenchRules{..} = do
                 AddPath [takeDirectory ghcPath, "."] []
               ]
               BenchProject {..}
+        liftIO $ renameFile "ghcide.eventlog" outEventlog
         liftIO $ case prof of
             CheapHeapProfiling{} -> renameFile "ghcide.hp" outHp
             NoProfiling -> writeFile outHp dummyHp