[commit: ghc] wip/nfs-locking: Minor revision, drop old TODO (cbee74b)

git at git.haskell.org git at git.haskell.org
Fri Oct 27 01:01:24 UTC 2017


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

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

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

commit cbee74bfe89e6b2b552c6ae560265ce2d9f5fb17
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Tue Oct 10 00:37:42 2017 +0100

    Minor revision, drop old TODO
    
    See #250


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

cbee74bfe89e6b2b552c6ae560265ce2d9f5fb17
 src/CommandLine.hs                   |  5 +----
 src/Hadrian/Utilities.hs             | 11 ++++++++---
 src/Settings/Flavours/Development.hs |  1 -
 3 files changed, 9 insertions(+), 8 deletions(-)

diff --git a/src/CommandLine.hs b/src/CommandLine.hs
index a069c0e..ed6441c 100644
--- a/src/CommandLine.hs
+++ b/src/CommandLine.hs
@@ -5,7 +5,6 @@ module CommandLine (
     ) where
 
 import Data.Either
-import Data.Maybe
 import qualified Data.HashMap.Strict as Map
 import Data.List.Extra
 import Development.Shake hiding (Normal)
@@ -127,9 +126,7 @@ 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
+lookupFreeze1 = freeze1 . lookupExtra defaultCommandLineArgs
 
 cmdInstallDestDir :: Action (Maybe String)
 cmdInstallDestDir = installDestDir <$> cmdLineArgs
diff --git a/src/Hadrian/Utilities.hs b/src/Hadrian/Utilities.hs
index 06ee663..4d2ae48 100644
--- a/src/Hadrian/Utilities.hs
+++ b/src/Hadrian/Utilities.hs
@@ -10,7 +10,7 @@ module Hadrian.Utilities (
     unifyPath, (-/-),
 
     -- * Accessing Shake's type-indexed map
-    insertExtra, userSetting,
+    insertExtra, lookupExtra, userSetting,
 
     -- * Paths
     BuildRoot (..), buildRoot, isGeneratedSource,
@@ -153,13 +153,18 @@ cmdLineLengthLimit | isWindows = 31000
 insertExtra :: Typeable a => a -> HashMap TypeRep Dynamic -> HashMap TypeRep Dynamic
 insertExtra value = Map.insert (typeOf value) (toDyn value)
 
+-- | Lookup a value in Shake's type-indexed map.
+lookupExtra :: Typeable a => a -> Map.HashMap TypeRep Dynamic -> a
+lookupExtra defaultValue extra = fromMaybe defaultValue maybeValue
+  where
+    maybeValue = fromDynamic =<< Map.lookup (typeOf defaultValue) extra
+
 -- | Lookup a user setting in Shake's type-indexed map 'shakeExtra'. If the
 -- setting is not found, return the provided default value instead.
 userSetting :: Typeable a => a -> Action a
 userSetting defaultValue = do
     extra <- shakeExtra <$> getShakeOptions
-    let maybeValue = fromDynamic =<< Map.lookup (typeOf defaultValue) extra
-    return $ fromMaybe defaultValue maybeValue
+    return $ lookupExtra defaultValue extra
 
 newtype BuildRoot = BuildRoot FilePath deriving Typeable
 
diff --git a/src/Settings/Flavours/Development.hs b/src/Settings/Flavours/Development.hs
index a6a2892..713e409 100644
--- a/src/Settings/Flavours/Development.hs
+++ b/src/Settings/Flavours/Development.hs
@@ -4,7 +4,6 @@ import Flavour
 import Expression
 import {-# SOURCE #-} Settings.Default
 
--- TODO: Implement an equivalent of LAX_DEPENDENCIES = YES setting, see #250.
 developmentFlavour :: Stage -> Flavour
 developmentFlavour ghcStage = defaultFlavour
     { name = "devel" ++ show (fromEnum ghcStage)



More information about the ghc-commits mailing list