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

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

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