[commit: ghc] wip/nfs-locking: Implement Stage1 GHC freezing (837675c)

git at git.haskell.org git at git.haskell.org
Fri Oct 27 00:44:05 UTC 2017


Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/nfs-locking
Link       : http://ghc.haskell.org/trac/ghc/changeset/837675cdf374040b554dd04491b7e59aa631abd4/ghc

>---------------------------------------------------------------

commit 837675cdf374040b554dd04491b7e59aa631abd4
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Mon Oct 9 01:14:54 2017 +0100

    Implement Stage1 GHC freezing
    
    See #250


>---------------------------------------------------------------

837675cdf374040b554dd04491b7e59aa631abd4
 src/CommandLine.hs | 19 ++++++++++++++++---
 src/Main.hs        |  4 ++++
 2 files changed, 20 insertions(+), 3 deletions(-)

diff --git a/src/CommandLine.hs b/src/CommandLine.hs
index cc6f944..a069c0e 100644
--- a/src/CommandLine.hs
+++ b/src/CommandLine.hs
@@ -1,10 +1,11 @@
 module CommandLine (
-    optDescrs, cmdLineArgsMap, cmdBuildHaddock, cmdFlavour, cmdIntegerSimple,
-    cmdProgressColour, cmdProgressInfo, cmdSkipConfigure, cmdSplitObjects,
-    cmdInstallDestDir
+    optDescrs, cmdLineArgsMap, cmdBuildHaddock, cmdFlavour, lookupFreeze1,
+    cmdIntegerSimple, cmdProgressColour, cmdProgressInfo, cmdSkipConfigure,
+    cmdSplitObjects, cmdInstallDestDir
     ) where
 
 import Data.Either
+import Data.Maybe
 import qualified Data.HashMap.Strict as Map
 import Data.List.Extra
 import Development.Shake hiding (Normal)
@@ -16,6 +17,7 @@ import System.Environment
 data CommandLineArgs = CommandLineArgs
     { buildHaddock   :: Bool
     , flavour        :: Maybe String
+    , freeze1        :: Bool
     , installDestDir :: Maybe String
     , integerSimple  :: Bool
     , progressColour :: UseColour
@@ -29,6 +31,7 @@ defaultCommandLineArgs :: CommandLineArgs
 defaultCommandLineArgs = CommandLineArgs
     { buildHaddock   = False
     , flavour        = Nothing
+    , freeze1        = False
     , installDestDir = Nothing
     , integerSimple  = False
     , progressColour = Auto
@@ -36,6 +39,9 @@ defaultCommandLineArgs = CommandLineArgs
     , skipConfigure  = False
     , splitObjects   = False }
 
+readFreeze1 :: Either String (CommandLineArgs -> CommandLineArgs)
+readFreeze1 = Right $ \flags -> flags { freeze1 = True }
+
 readBuildHaddock :: Either String (CommandLineArgs -> CommandLineArgs)
 readBuildHaddock = Right $ \flags -> flags { buildHaddock = True }
 
@@ -84,6 +90,8 @@ optDescrs :: [OptDescr (Either String (CommandLineArgs -> CommandLineArgs))]
 optDescrs =
     [ Option [] ["flavour"] (OptArg readFlavour "FLAVOUR")
       "Build flavour (Default, Devel1, Devel2, Perf, Prof, Quick or Quickest)."
+    , Option [] ["freeze1"] (NoArg readFreeze1)
+      "Freeze Stage1 GHC."
     , Option [] ["haddock"] (NoArg readBuildHaddock)
       "Generate Haddock documentation."
     , Option [] ["install-destdir"] (OptArg readInstallDestDir "DESTDIR")
@@ -118,6 +126,11 @@ cmdBuildHaddock = buildHaddock <$> cmdLineArgs
 cmdFlavour :: Action (Maybe String)
 cmdFlavour = flavour <$> cmdLineArgs
 
+lookupFreeze1 :: Map.HashMap TypeRep Dynamic -> Bool
+lookupFreeze1 m = fromMaybe (freeze1 defaultCommandLineArgs) (freeze1 <$> maybeValue)
+  where
+    maybeValue = fromDynamic =<< Map.lookup (typeOf defaultCommandLineArgs) m
+
 cmdInstallDestDir :: Action (Maybe String)
 cmdInstallDestDir = installDestDir <$> cmdLineArgs
 
diff --git a/src/Main.hs b/src/Main.hs
index 91580dd..52af0ad 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -28,11 +28,15 @@ main = do
 
         BuildRoot buildRoot = UserSettings.userBuildRoot
 
+        rebuild = [ (RebuildLater, buildRoot -/- "stage0//*")
+                  | CommandLine.lookupFreeze1 argsMap ]
+
         options :: ShakeOptions
         options = shakeOptions
             { shakeChange   = ChangeModtimeAndDigest
             , shakeFiles    = buildRoot -/- Base.shakeFilesDir
             , shakeProgress = progressSimple
+            , shakeRebuild  = rebuild
             , shakeTimings  = True
             , shakeExtra    = extra }
 



More information about the ghc-commits mailing list