Commit 327b06e5 authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Avoid using interpretDiff, use simpler interpret instead.

parent 5f8abc4b
......@@ -8,7 +8,7 @@ module Expression (
Args, Ways, Packages,
apply, append, appendM, remove,
appendSub, appendSubD, filterSub, removeSub,
interpret, interpretExpr,
interpret, interpretDiff,
getStage, getPackage, getBuilder, getFiles, getFile,
getDependencies, getDependency, getWay,
stage, package, builder, stagedBuilder, file, way
......@@ -141,16 +141,16 @@ removeSub :: String -> [String] -> Args
removeSub prefix xs = filterSub prefix (`notElem` xs)
-- Interpret a given expression in a given environment
interpretExpr :: Target -> Expr a -> Action a
interpretExpr = flip runReaderT
interpret :: Target -> Expr a -> Action a
interpret = flip runReaderT
-- Extract an expression from a difference expression
fromDiffExpr :: Monoid a => DiffExpr a -> Expr a
fromDiffExpr = fmap (($ mempty) . fromDiff)
-- Interpret a given difference expression in a given environment
interpret :: Monoid a => Target -> DiffExpr a -> Action a
interpret target = interpretExpr target . fromDiffExpr
interpretDiff :: Monoid a => Target -> DiffExpr a -> Action a
interpretDiff target = interpret target . fromDiffExpr
-- Convenient getters for target parameters
getStage :: Expr Stage
......
......@@ -22,5 +22,5 @@ askArgsHash = askOracle . ArgsHashKey
-- Oracle for storing per-target argument list hashes
argsHashOracle :: Rules ()
argsHashOracle = do
addOracle $ \(ArgsHashKey target) -> hash <$> interpret target args
addOracle $ \(ArgsHashKey target) -> hash <$> interpret target getArgs
return ()
......@@ -15,11 +15,10 @@ import Settings.Packages
import Settings.TargetDirectory
-- generateTargets needs package-data.mk files of all target packages
-- TODO: make interpretDiff total
generateTargets :: Rules ()
generateTargets = action $ do
targets <- fmap concat . forM [Stage0 ..] $ \stage -> do
pkgs <- interpret (stageTarget stage) packages
pkgs <- interpret (stageTarget stage) getPackages
fmap concat . forM pkgs $ \pkg -> return
[ targetPath stage pkg -/- "build/haskell.deps"
, targetPath stage pkg -/- "build/c.deps" ]
......
......@@ -21,7 +21,7 @@ buildWithResources rs target = do
needBuilder builder
need deps
path <- builderPath builder
argList <- interpret target args
argList <- interpret target getArgs
-- The line below forces the rule to be rerun if the args hash has changed
argsHash <- askArgsHash target
withResources rs $ do
......
......@@ -16,7 +16,7 @@ cabalRules :: Rules ()
cabalRules = do
-- Cache boot package constraints (to be used in cabalArgs)
bootPackageConstraints %> \file -> do
pkgs <- interpret (stageTarget Stage0) packages
pkgs <- interpret (stageTarget Stage0) getPackages
constraints <- forM (sort pkgs) $ \pkg -> do
let cabal = pkgCabalPath pkg
need [cabal]
......@@ -29,7 +29,7 @@ cabalRules = do
-- Cache package dependencies
packageDependencies %> \file -> do
pkgs <- interpret (stageTarget Stage1) packages
pkgs <- interpret (stageTarget Stage1) getPackages
pkgDeps <- forM (sort pkgs) $ \pkg -> do
let cabal = pkgCabalPath pkg
need [cabal]
......
......@@ -40,16 +40,16 @@ buildPackageData (Resources ghcCabal ghcPkg) target = do
-- We configure packages in the order of their dependencies
deps <- packageDeps pkg
pkgs <- interpret target packages
let cmp pkg = compare (pkgName pkg)
depPkgs = intersectOrd cmp (sort pkgs) deps
pkgs <- interpret target getPackages
let cmp pkg name = compare (pkgName pkg) name
depPkgs = intersectOrd cmp (sort pkgs) deps
need [ targetPath stage p -/- "package-data.mk" | p <- depPkgs ]
buildWithResources [(ghcCabal, 1)] $
fullTarget target [cabal] GhcCabal files
-- TODO: find out of ghc-cabal can be concurrent with ghc-pkg
whenM (interpretExpr target registerPackage) .
whenM (interpret target registerPackage) .
buildWithResources [(ghcPkg, 1)] $
fullTarget target [cabal] (GhcPkg stage) files
......
......@@ -32,5 +32,5 @@ buildPackageDependencies _ target =
writeFileChanged file (concat deps)
(buildPath -/- "haskell.deps") %> \file -> do
srcs <- interpretExpr target getHsSources
srcs <- interpret target getHsSources
build $ fullTarget target srcs (GhcM stage) [file]
module Settings.Args (
args
) where
module Settings.Args (args, getArgs) where
import Expression
import Settings.User
......@@ -12,6 +10,9 @@ import Settings.GhcCabal
args :: Args
args = defaultArgs <> userArgs
getArgs :: Expr [String]
getArgs = fromDiffExpr args
-- TODO: add all other settings
-- TODO: add src-hc-args = -H32m -O
-- TODO: GhcStage2HcOpts=-O2 unless GhcUnregisterised
......
......@@ -85,7 +85,7 @@ getHsSources = do
(foundSources, missingSources) <- findModuleFiles dirs "*hs"
-- Generated source files live in buildPath and have extension "hs"
let generatedSources = map (\f -> buildPath -/- f <.> "hs") missingSources
let generatedSources = [ buildPath -/- s <.> "hs" | s <- missingSources ]
return $ foundSources ++ generatedSources
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment