Commit 5a162b2a authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Rename Target fields: sources -> inputs, files -> outputs.

parent 5e0734bc
......@@ -19,3 +19,5 @@
* There are no generated *.y/*.ly files, hence they can never be in the build directory
* hsc2hs gets multuple "--cflag=-I$1/$2/build/autogen" flags in one invokation
* No generated Haskell files actually require copying of *.(l)hs-boot files
* Postprocessing primops.txt to remove lines starting with '#pragma GCC'
* Use of IRIX_MAJOR variable that is never set while generating ghc_platform_boot.h
\ No newline at end of file
......@@ -10,8 +10,8 @@ module Expression (
Target, PartialTarget (..), fromPartial, fullTarget, fullTargetWithWay,
apply, append, arg, remove, appendSub, appendSubD, filterSub, removeSub,
interpret, interpretPartial, interpretWithStage, interpretDiff,
getStage, getPackage, getBuilder, getFiles, getSources, getWay,
getSource, getFile
getStage, getPackage, getBuilder, getOutputs, getInputs, getWay,
getInput, getOutput
) where
import Base
......@@ -152,25 +152,25 @@ getBuilder = asks builder
getWay :: Expr Way
getWay = asks way
getSources :: Expr [FilePath]
getSources = asks sources
getInputs :: Expr [FilePath]
getInputs = asks inputs
-- Run getSources and check that the result contains a single file only
getSource :: Expr FilePath
getSource = do
-- Run getInputs and check that the result contains a single input file only
getInput :: Expr FilePath
getInput = do
target <- ask
getSingleton getSources $
"getSource: exactly one source expected in target " ++ show target
getSingleton getInputs $
"getInput: exactly one input file expected in target " ++ show target
getFiles :: Expr [FilePath]
getFiles = asks files
getOutputs :: Expr [FilePath]
getOutputs = asks outputs
-- Run getFiles and check that the result contains a single file only
getFile :: Expr FilePath
getFile = do
-- Run getOutputs and check that the result contains a output file only
getOutput :: Expr FilePath
getOutput = do
target <- ask
getSingleton getFiles $
"getFile: exactly one file expected in target " ++ show target
getSingleton getOutputs $
"getOutput: exactly one output file expected in target " ++ show target
getSingleton :: Expr [a] -> String -> Expr a
getSingleton expr msg = do
......
......@@ -22,7 +22,7 @@ newtype ArgsHashKey = ArgsHashKey Target
-- TODO: Hash Target to improve accuracy and performance.
checkArgsHash :: Target -> Action ()
checkArgsHash target = when trackBuildSystem $ do
_ <- askOracle . ArgsHashKey $ target { sources = ["src"] } :: Action Int
_ <- askOracle . ArgsHashKey $ target { inputs = ["src"] } :: Action Int
return ()
-- Oracle for storing per-target argument list hashes
......
......@@ -27,7 +27,7 @@ stagedBuilder :: (Stage -> Builder) -> Predicate
stagedBuilder sb = (builder . sb) =<< getStage
file :: FilePattern -> Predicate
file f = fmap (any (f ?==)) getFiles
file f = fmap (any (f ?==)) getOutputs
way :: Way -> Predicate
way w = fmap (w ==) getWay
......
......@@ -26,13 +26,13 @@ buildWithResources rs target = do
Ar -> arCmd path argList
HsCpp -> do
let file = head $ Target.files target -- TODO: ugly
let file = head $ Target.outputs target -- TODO: ugly
Stdout output <- cmd [path] argList
writeFileChanged file output
GenPrimopCode -> do
let src = head $ Target.sources target -- TODO: ugly
file = head $ Target.files target
let src = head $ Target.inputs target -- TODO: ugly
file = head $ Target.outputs target
input <- readFile' src
Stdout output <- cmd (Stdin input) [path] argList
writeFileChanged file output
......
......@@ -5,15 +5,12 @@ import GHC (compiler)
import Predicates (builder, package)
alexArgs :: Args
alexArgs = builder Alex ? do
src <- getSource
file <- getFile
mconcat [ arg "-g"
alexArgs = builder Alex ? mconcat [ arg "-g"
, package compiler ? arg "--latin1"
, arg src
, arg "-o", arg file ]
, arg =<< getInput
, arg "-o", arg =<< getOutput ]
-- TODO:
-- TODO: separate arguments into builder-specific and package-specific
-- compilierArgs = package compiler ? builder Alex ? arg "awe"
-- args = mconcat
......
......@@ -5,12 +5,9 @@ import Oracles
import Predicates (builder)
arArgs :: Args
arArgs = builder Ar ? do
file <- getFile
objs <- getSources
mconcat [ arg "q"
, arg file
, append objs ]
arArgs = builder Ar ? mconcat [ arg "q"
, arg =<< getOutput
, append =<< getInputs ]
-- This count includes arg "q" and arg file parameters in arArgs (see above).
-- Update this value appropriately when changing arArgs.
......
......@@ -6,30 +6,24 @@ import Predicates (stagedBuilder)
import Settings
gccArgs :: Args
gccArgs = stagedBuilder Gcc ? do
file <- getFile
src <- getSource
mconcat [ commonGccArgs
, arg "-c"
, arg src
, arg "-o"
, arg file ]
gccArgs = stagedBuilder Gcc ? mconcat [ commonGccArgs
, arg "-c", arg =<< getInput
, arg "-o", arg =<< getOutput ]
-- TODO: handle custom $1_$2_MKDEPENDC_OPTS and
gccMArgs :: Args
gccMArgs = stagedBuilder GccM ? do
file <- getFile
src <- getSource
output <- getOutput
mconcat [ arg "-E"
, arg "-MM"
, commonGccArgs
, arg "-MF"
, arg file
, arg output
, arg "-MT"
, arg $ dropExtension file -<.> "o"
, arg $ dropExtension output -<.> "o"
, arg "-x"
, arg "c"
, arg src ]
, arg =<< getInput ]
commonGccArgs :: Args
commonGccArgs = do
......
......@@ -11,30 +11,25 @@ import Settings
-- $$(if $$(findstring YES,$$($1_$2_DYNAMIC_TOO)),-dyno
-- $$(addsuffix .$$(dyn_osuf)-boot,$$(basename $$@)))
ghcArgs :: Args
ghcArgs = stagedBuilder Ghc ? do
file <- getFile
srcs <- getSources
mconcat [ commonGhcArgs
ghcArgs = stagedBuilder Ghc ? mconcat [ commonGhcArgs
, arg "-H32m"
, stage0 ? arg "-O"
, notStage0 ? arg "-O2"
, arg "-Wall"
, arg "-fwarn-tabs"
, splitObjects ? arg "-split-objs"
, arg "-c", append srcs
, arg "-o", arg file ]
, arg "-c", append =<< getInputs
, arg "-o", arg =<< getOutput ]
ghcMArgs :: Args
ghcMArgs = stagedBuilder GhcM ? do
ways <- getWays
file <- getFile
srcs <- getSources
mconcat [ arg "-M"
, commonGhcArgs
, arg "-include-pkg-deps"
, arg "-dep-makefile", arg file
, arg "-dep-makefile", arg =<< getOutput
, append $ concat [ ["-dep-suffix", wayPrefix w] | w <- ways ]
, append srcs ]
, append =<< getInputs ]
-- This is included into ghcArgs, ghcMArgs and haddockArgs.
commonGhcArgs :: Args
......
......@@ -8,8 +8,7 @@ import Settings.Builders.Ghc
haddockArgs :: Args
haddockArgs = builder Haddock ? do
file <- getFile
srcs <- getSources
output <- getOutput
pkg <- getPackage
path <- getTargetPath
version <- getPkgData Version
......@@ -19,10 +18,10 @@ haddockArgs = builder Haddock ? do
depNames <- getPkgDataList DepNames
ghcOpts <- fromDiffExpr commonGhcArgs
mconcat
[ arg $ "--odir=" ++ takeDirectory file
[ arg $ "--odir=" ++ takeDirectory output
, arg "--verbosity=0"
, arg "--no-tmp-comp-dir"
, arg $ "--dump-interface=" ++ file
, arg $ "--dump-interface=" ++ output
, arg "--html"
, arg "--hoogle"
, arg $ "--title=" ++ pkgName pkg ++ "-" ++ version ++ ": " ++ synopsis
......@@ -39,7 +38,7 @@ haddockArgs = builder Haddock ? do
, specified HsColour ?
arg "--source-entity=src/%{MODULE/./-}.html\\#%{NAME}"
, customPackageArgs
, append srcs
, append =<< getInputs
, arg "+RTS"
, arg $ "-t" ++ path </> "haddock.t"
, arg "--machine-readable" ]
......
......@@ -4,10 +4,7 @@ import Expression
import Predicates (builder)
happyArgs :: Args
happyArgs = builder Happy ? do
src <- getSource
file <- getFile
mconcat [ arg "-agc"
happyArgs = builder Happy ? mconcat [ arg "-agc"
, arg "--strict"
, arg src
, arg "-o", arg file ]
, arg =<< getInput
, arg "-o", arg =<< getOutput ]
......@@ -5,16 +5,13 @@ import Oracles
import Predicates (builder)
import Settings.Builders.GhcCabal
-- TODO: why process the result with grep -v '^#pragma GCC'? No such lines!
hsCppArgs :: Args
hsCppArgs = builder HsCpp ? do
stage <- getStage
src <- getSource
args <- getSettingList HsCppArgs
mconcat [ append args
mconcat [ append =<< getSettingList HsCppArgs
, arg "-P"
, cppArgs
, arg $ "-Icompiler/stage" ++ show (succ stage)
, arg "-x"
, arg "c"
, arg src ]
, arg =<< getInput ]
......@@ -9,8 +9,6 @@ import Settings.Builders.GhcCabal hiding (cppArgs)
hsc2HsArgs :: Args
hsc2HsArgs = builder Hsc2Hs ? do
stage <- getStage
src <- getSource
file <- getFile
ccPath <- lift . builderPath $ Gcc stage
gmpDirs <- getSettingList GmpIncludeDirs
cFlags <- getCFlags
......@@ -34,8 +32,8 @@ hsc2HsArgs = builder Hsc2Hs ? do
, notStage0 ? arg ("--cflag=-D" ++ tArch ++ "_HOST_ARCH=1")
, notStage0 ? arg ("--cflag=-D" ++ tOs ++ "_HOST_OS=1" )
, arg ("--cflag=-D__GLASGOW_HASKELL__=" ++ version)
, arg src
, arg "-o", arg file ]
, arg =<< getInput
, arg "-o", arg =<< getOutput ]
getCFlags :: Expr [String]
getCFlags = fromDiffExpr $ do
......
......@@ -6,10 +6,8 @@ import Predicates (builder)
ldArgs :: Args
ldArgs = builder Ld ? do
file <- getFile
objs <- getSources
args <- getSettingList . ConfLdLinkerArgs =<< getStage
mconcat [ append args
, arg "-r"
, arg "-o", arg file
, append objs ]
, arg "-o", arg =<< getOutput
, append =<< getInputs ]
......@@ -4,7 +4,6 @@ module Stage (Stage (..)) where
import Base
import GHC.Generics (Generic)
-- TODO: rename to something more meaningful, e.g. 'Stage0' -> 'Boot'.
-- TODO: explain stages
data Stage = Stage0 | Stage1 | Stage2 | Stage3 deriving (Eq, Enum, Generic)
......
......@@ -22,8 +22,8 @@ data Target = Target
package :: Package,
builder :: Builder,
way :: Way,
sources :: [FilePath], -- input
files :: [FilePath] -- output
inputs :: [FilePath],
outputs :: [FilePath]
}
deriving (Show, Eq, Generic)
......@@ -47,8 +47,8 @@ fromPartial (PartialTarget s p) = Target
package = p,
builder = error "fromPartial: builder not set",
way = error "fromPartial: way not set",
sources = error "fromPartial: sources not set",
files = error "fromPartial: files not set"
inputs = error "fromPartial: inputs not set",
outputs = error "fromPartial: outputs not set"
}
-- Construct a full target by augmenting a PartialTarget with missing fields.
......@@ -60,8 +60,8 @@ fullTarget (PartialTarget s p) b srcs fs = Target
package = p,
builder = b,
way = vanilla,
sources = map unifyPath srcs,
files = map unifyPath fs
inputs = map unifyPath srcs,
outputs = map unifyPath fs
}
-- Use this function to be explicit about the build way.
......
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