[commit: ghc] wip/nfs-locking: Distringuish partial Targets using type synonyms. (c319fbb)
git at git.haskell.org
git at git.haskell.org
Thu Oct 26 23:29:53 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/nfs-locking
Link : http://ghc.haskell.org/trac/ghc/changeset/c319fbbf892b9a8a231676b3ecf9550d4b56a01b/ghc
>---------------------------------------------------------------
commit c319fbbf892b9a8a231676b3ecf9550d4b56a01b
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date: Tue Jul 14 16:07:42 2015 +0100
Distringuish partial Targets using type synonyms.
>---------------------------------------------------------------
c319fbbf892b9a8a231676b3ecf9550d4b56a01b
src/Oracles/ArgsHash.hs | 4 ++--
src/Rules/Data.hs | 10 ++++-----
src/Rules/Package.hs | 2 +-
src/Rules/Util.hs | 2 +-
src/Settings/Packages.hs | 5 ++++-
src/Target.hs | 55 ++++++++++++++++++++++++++++++++----------------
6 files changed, 49 insertions(+), 29 deletions(-)
diff --git a/src/Oracles/ArgsHash.hs b/src/Oracles/ArgsHash.hs
index 1586b97..acb3e98 100644
--- a/src/Oracles/ArgsHash.hs
+++ b/src/Oracles/ArgsHash.hs
@@ -9,10 +9,10 @@ import Base
import Settings
import Expression
-newtype ArgsHashKey = ArgsHashKey Target
+newtype ArgsHashKey = ArgsHashKey FullTarget
deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
-askArgsHash :: Target -> Action Int
+askArgsHash :: FullTarget -> Action Int
askArgsHash = askOracle . ArgsHashKey
-- Oracle for storing per-target argument list hashes
diff --git a/src/Rules/Data.hs b/src/Rules/Data.hs
index 684cde6..2a40519 100644
--- a/src/Rules/Data.hs
+++ b/src/Rules/Data.hs
@@ -17,7 +17,7 @@ import Util
import Ways
-- Build package-data.mk by using GhcCabal to process pkgCabal file
-buildPackageData :: Target -> Rules ()
+buildPackageData :: StagePackageTarget -> Rules ()
buildPackageData target =
let stage = getStage target
pkg = getPackage target
@@ -33,16 +33,14 @@ buildPackageData target =
-- , "build" </> "autogen" </> ("Paths_" ++ name) <.> "hs"
] &%> \_ -> do
let configure = pkgPath pkg </> "configure"
- -- TODO: 1) how to automate this? 2) handle multiple files?
- newTarget = target { getFile = path </> "package-data.mk"
- , getWay = vanilla } -- TODO: think
-- GhcCabal will run the configure script, so we depend on it
need [pkgPath pkg </> pkgCabal pkg]
-- We still don't know who built the configure script from configure.ac
whenM (doesFileExist $ configure <.> "ac") $ need [configure]
- build $ newTarget { getBuilder = GhcCabal }
+ -- TODO: 1) automate? 2) mutliple files 3) vanilla?
+ build $ fullTarget target (path </> "package-data.mk") GhcCabal vanilla
-- TODO: when (registerPackage settings) $
- build $ newTarget { getBuilder = GhcPkg stage }
+ build $ fullTarget target (path </> "package-data.mk") (GhcPkg stage) vanilla
postProcessPackageData $ path </> "package-data.mk"
-- Prepare a given 'packaga-data.mk' file for parsing by readConfigFile:
diff --git a/src/Rules/Package.hs b/src/Rules/Package.hs
index a5a09dd..e316805 100644
--- a/src/Rules/Package.hs
+++ b/src/Rules/Package.hs
@@ -6,5 +6,5 @@ import Base
import Rules.Data
import Expression
-buildPackage :: Target -> Rules ()
+buildPackage :: StagePackageTarget -> Rules ()
buildPackage = buildPackageData
diff --git a/src/Rules/Util.hs b/src/Rules/Util.hs
index a18e25e..6e1296e 100644
--- a/src/Rules/Util.hs
+++ b/src/Rules/Util.hs
@@ -9,7 +9,7 @@ import Expression
import Oracles.Builder
import Oracles.ArgsHash
-build :: Target -> Action ()
+build :: FullTarget -> Action ()
build target = do
argList <- interpret target args
putColoured Green (show target)
diff --git a/src/Settings/Packages.hs b/src/Settings/Packages.hs
index 7eaa5d5..b1d98de 100644
--- a/src/Settings/Packages.hs
+++ b/src/Settings/Packages.hs
@@ -1,4 +1,5 @@
module Settings.Packages (
+ module Settings.Default,
packages, knownPackages
) where
@@ -6,6 +7,7 @@ import Base
import Package
import Switches
import Expression
+import Settings.Default
import Settings.User
-- Combining default list of packages with user modifications
@@ -25,7 +27,8 @@ packagesStage0 = mconcat
packagesStage1 :: Packages
packagesStage1 = mconcat
- [ append [ array, base, bytestring, containers, deepseq, directory
+ [ packagesStage0
+ , append [ array, base, bytestring, containers, deepseq, directory
, filepath, ghcPrim, haskeline, integerLibrary, parallel
, pretty, primitive, process, stm, templateHaskell, time ]
, windowsHost ? append [win32]
diff --git a/src/Target.hs b/src/Target.hs
index 6161db7..0a0ed00 100644
--- a/src/Target.hs
+++ b/src/Target.hs
@@ -1,6 +1,7 @@
-{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveGeneric, TypeSynonymInstances #-}
module Target (
- Target (..), stageTarget, stagePackageTarget
+ Target (..), StageTarget (..), StagePackageTarget (..), FullTarget (..),
+ stageTarget, stagePackageTarget, fullTarget
) where
import Base
@@ -17,41 +18,59 @@ data Target = Target
{
getStage :: Stage,
getPackage :: Package,
- getBuilder :: Builder,
getFile :: FilePath, -- TODO: handle multple files?
+ getBuilder :: Builder,
getWay :: Way
}
deriving (Eq, Generic)
--- Shows a target as "package:file at stage (builder, way)"
-instance Show Target where
- show target = show (getPackage target)
- ++ ":" ++ show (getFile target)
- ++ "@" ++ show (getStage target)
- ++ " (" ++ show (getBuilder target)
- ++ ", " ++ show (getWay target) ++ ")"
+-- StageTarget is a Target whose field getStage is already assigned
+type StageTarget = Target
-stageTarget :: Stage -> Target
+stageTarget :: Stage -> StageTarget
stageTarget stage = Target
{
getStage = stage,
getPackage = error "stageTarget: Package not set",
- getBuilder = error "stageTarget: Builder not set",
getFile = error "stageTarget: File not set",
+ getBuilder = error "stageTarget: Builder not set",
getWay = error "stageTarget: Way not set"
}
-stagePackageTarget :: Stage -> Package -> Target
+-- StagePackageTarget is a Target whose fields getStage and getPackage are
+-- already assigned
+type StagePackageTarget = Target
+
+stagePackageTarget :: Stage -> Package -> StagePackageTarget
stagePackageTarget stage package = Target
{
getStage = stage,
getPackage = package,
- getBuilder = error "stagePackageTarget: Builder not set",
getFile = error "stagePackageTarget: File not set",
+ getBuilder = error "stagePackageTarget: Builder not set",
getWay = error "stagePackageTarget: Way not set"
}
--- Instances for storing Target in the Shake database
-instance Binary Target
-instance NFData Target
-instance Hashable Target
+-- FullTarget is a Target whose fields are all assigned
+type FullTarget = Target
+
+fullTarget :: StagePackageTarget -> FilePath -> Builder -> Way -> FullTarget
+fullTarget target file builder way = target
+ {
+ getFile = file,
+ getBuilder = builder,
+ getWay = way
+ }
+
+-- Shows a (full) target as "package:file at stage (builder, way)"
+instance Show FullTarget where
+ show target = show (getPackage target)
+ ++ ":" ++ getFile target
+ ++ "@" ++ show (getStage target)
+ ++ " (" ++ show (getBuilder target)
+ ++ ", " ++ show (getWay target) ++ ")"
+
+-- Instances for storing FullTarget in the Shake database
+instance Binary FullTarget
+instance NFData FullTarget
+instance Hashable FullTarget
More information about the ghc-commits
mailing list