Commit 3dff9574 authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Refactor generators, add makeExecutable action.

parent 9ba5daa8
......@@ -3,7 +3,7 @@ module GHC (
array, base, binary, bytestring, cabal, compiler, containers, compareSizes,
deepseq, deriveConstants, directory, dllSplit, filepath, genapply,
genprimopcode, ghc, ghcBoot, ghcCabal, ghci, ghcPkg, ghcPrim, ghcTags,
haddock, haskeline, hsc2hs, hoopl, hp2ps, hpc, hpcBin, integerGmp,
ghcSplit, haddock, haskeline, hsc2hs, hoopl, hp2ps, hpc, hpcBin, integerGmp,
integerSimple, iservBin, libffi, mkUserGuidePart, parallel, pretty,
primitive, process, rts, runGhc, stm, templateHaskell, terminfo, time,
touchy, transformers, unlit, unix, win32, xhtml,
......@@ -90,7 +90,11 @@ unix = library "unix"
win32 = library "Win32"
xhtml = library "xhtml"
-- TODO: The following utils are not implemented yet: driver/ghc-split
-- | ghc-split is a perl script used by GHC with @-split-objs@ flag. It is
-- generated in "Rules.Generators.GhcSplit".
ghcSplit :: FilePath
ghcSplit = "inplace/lib/bin/ghc-split"
-- TODO: The following utils are not included into the build system because
-- they seem to be unused or unrelated to the build process: checkUniques,
-- completion, count_lines, coverity, debugNGC, describe-unexpected, genargs,
......
{-# LANGUAGE RecordWildCards #-}
module Rules.Actions (
build, buildWithResources, copyFile, createDirectory, moveDirectory,
fixFile, runConfigure, runMake, runBuilder
fixFile, runConfigure, runMake, runBuilder, makeExecutable
) where
import qualified System.Directory as IO
......@@ -115,6 +115,11 @@ runBuilder builder args = do
putBuild $ "| Run " ++ show builder ++ note
quietly $ cmd [path] args
makeExecutable :: FilePath -> Action ()
makeExecutable file = do
putBuild $ "| Make '" ++ file ++ "' executable."
quietly $ cmd "chmod +x " [file]
-- Print out key information about the command being executed
putInfo :: Target.Target -> Action ()
putInfo (Target.Target {..}) = putBuild $ renderBox
......
module Rules.Generate (
generate, generateExec, generatePackageCode, generateRules,
derivedConstantsPath, emptyTarget, generatedDependencies,
installTargets, copyRules
generatePackageCode, generateRules, installTargets, copyRules,
derivedConstantsPath, generatedDependencies
) where
import Base
......@@ -11,6 +10,7 @@ import Rules.Generators.ConfigHs
import Rules.Generators.GhcAutoconfH
import Rules.Generators.GhcBootPlatformH
import Rules.Generators.GhcPlatformH
import Rules.Generators.GhcSplit
import Rules.Generators.GhcVersionH
import Rules.Generators.VersionHs
import Oracles.ModuleFiles
......@@ -106,13 +106,6 @@ generate file target expr = do
writeFileChanged file contents
putSuccess $ "| Successfully generated '" ++ file ++ "'."
-- | Generates @file@ for @target@ and marks it as executable.
generateExec :: FilePath -> PartialTarget -> Expr String -> Action ()
generateExec file target expr = do
generate file target expr
unit $ cmd "chmod +x " [file]
putSuccess $ "| Made '" ++ file ++ "' executable."
generatePackageCode :: Resources -> PartialTarget -> Rules ()
generatePackageCode _ target @ (PartialTarget stage pkg) =
let buildPath = targetPath stage pkg -/- "build"
......@@ -179,6 +172,10 @@ generateRules = do
"includes/ghcplatform.h" <~ generateGhcPlatformH
"includes/ghcversion.h" <~ generateGhcVersionH
ghcSplit %> \_ -> do
generate ghcSplit emptyTarget generateGhcSplit
makeExecutable ghcSplit
-- TODO: simplify
derivedConstantsPath ++ "//*" %> \file -> do
build $ fullTarget (PartialTarget Stage1 rts) DeriveConstants [] [file]
......
module Rules.Generators.Common (trackSource, yesNo, cppify) where
import Base
import Expression
import Settings.User
-- | Track a given source file when constructing an expression if the user
-- enabled 'trackBuildSystem' in "Settings.User".
trackSource :: FilePath -> Expr ()
trackSource file = lift $ when trackBuildSystem $ need [ sourcePath -/- file ]
-- | Turn a 'Bool' computed by an 'Action' into a 'String' expression returning
-- "YES" (when the Boolean is 'True') or "NO" (when the Boolean is 'False').
yesNo :: Action Bool -> Expr String
yesNo = lift . fmap (\x -> if x then "YES" else "NO")
-- | Given a 'String' replace charaters '.' and '-' by underscores ('_') so that
-- the resulting 'String' becomes a valid C identifier.
cppify :: String -> String
cppify = replaceEq '-' '_' . replaceEq '.' '_'
......@@ -5,13 +5,11 @@ import Expression
import GHC
import Oracles
import Settings
import Rules.Generators.Common
-- TODO: do we need ghc-split? Always or is it platform specific?
-- TODO: add tracking by moving these functions to separate tracked files
generateConfigHs :: Expr String
generateConfigHs = do
when trackBuildSystem . lift $
need [sourcePath -/- "Rules/Generators/ConfigHs.hs"]
trackSource "Rules/Generators/ConfigHs.hs"
cProjectName <- getSetting ProjectName
cProjectGitCommitId <- getSetting ProjectGitCommitId
cProjectVersion <- getSetting ProjectVersion
......@@ -24,7 +22,6 @@ generateConfigHs = do
| integerLibrary == integerSimple = "IntegerSimple"
| otherwise = error $ "Unknown integer library: "
++ show integerLibrary ++ "."
yesNo = lift . fmap (\x -> if x then "YES" else "NO")
cSupportsSplitObjs <- yesNo supportsSplitObjects
cGhcWithInterpreter <- yesNo ghcWithInterpreter
cGhcWithNativeCodeGen <- yesNo ghcWithNativeCodeGen
......@@ -32,7 +29,6 @@ generateConfigHs = do
cGhcEnableTablesNextToCode <- yesNo ghcEnableTablesNextToCode
cLeadingUnderscore <- yesNo $ flag LeadingUnderscore
cGHC_UNLIT_PGM <- fmap takeFileName $ getBuilderPath Unlit
let cGHC_SPLIT_PGM = "ghc-split"
cLibFFI <- lift useLibFFIForAdjustors
rtsWays <- getRtsWays
cGhcRtsWithLibdw <- getFlag WithLibdw
......@@ -93,7 +89,7 @@ generateConfigHs = do
, "cGHC_UNLIT_PGM :: String"
, "cGHC_UNLIT_PGM = " ++ quote cGHC_UNLIT_PGM
, "cGHC_SPLIT_PGM :: String"
, "cGHC_SPLIT_PGM = " ++ quote cGHC_SPLIT_PGM
, "cGHC_SPLIT_PGM = " ++ quote "ghc-split"
, "cLibFFI :: Bool"
, "cLibFFI = " ++ show cLibFFI
, "cGhcThreaded :: Bool"
......
......@@ -3,7 +3,7 @@ module Rules.Generators.GhcAutoconfH (generateGhcAutoconfH) where
import Base
import Expression
import Oracles
import Settings.User
import Rules.Generators.Common
-- TODO: change `mk/config.h` to `shake-build/cfg/config.h`
configH :: FilePath
......@@ -17,8 +17,7 @@ undefinePackage s
generateGhcAutoconfH :: Expr String
generateGhcAutoconfH = do
when trackBuildSystem . lift $
need [sourcePath -/- "Rules/Generators/GhcAutoconfH.hs"]
trackSource "Rules/Generators/GhcAutoconfH.hs"
configHContents <- lift $ map undefinePackage <$> readFileLines configH
tablesNextToCode <- lift $ ghcEnableTablesNextToCode
ghcUnreg <- getFlag GhcUnregisterised
......
......@@ -3,15 +3,13 @@ module Rules.Generators.GhcBootPlatformH (generateGhcBootPlatformH) where
import Base
import Expression
import Oracles
import Settings.User
import Rules.Generators.Common
generateGhcBootPlatformH :: Expr String
generateGhcBootPlatformH = do
when trackBuildSystem . lift $
need [sourcePath -/- "Rules/Generators/GhcBootPlatformH.hs"]
trackSource "Rules/Generators/GhcBootPlatformH.hs"
stage <- getStage
let cppify = replaceEq '-' '_' . replaceEq '.' '_'
chooseSetting x y = getSetting $ if stage == Stage0 then x else y
let chooseSetting x y = getSetting $ if stage == Stage0 then x else y
buildPlatform <- chooseSetting BuildPlatform HostPlatform
buildArch <- chooseSetting BuildArch HostArch
buildOs <- chooseSetting BuildOs HostOs
......
......@@ -3,13 +3,11 @@ module Rules.Generators.GhcPlatformH (generateGhcPlatformH) where
import Base
import Expression
import Oracles
import Settings.User
import Rules.Generators.Common
generateGhcPlatformH :: Expr String
generateGhcPlatformH = do
when trackBuildSystem . lift $
need [sourcePath -/- "Rules/Generators/GhcPlatformH.hs"]
let cppify = replaceEq '-' '_' . replaceEq '.' '_'
trackSource "Rules/Generators/GhcPlatformH.hs"
hostPlatform <- getSetting HostPlatform
hostArch <- getSetting HostArch
hostOs <- getSetting HostOs
......
......@@ -3,23 +3,22 @@ module Rules.Generators.GhcSplit (generateGhcSplit) where
import Base
import Expression
import Oracles
import Settings.User
import Rules.Generators.Common
ghcSplitSource :: FilePath
ghcSplitSource = "driver/split/ghc-split.prl"
generateGhcSplit :: Expr String
generateGhcSplit = do
let yesNo = lift . fmap (\x -> if x then "YES" else "NO")
perl <- getBuilderPath Perl
let script = "driver/split/ghc-split.prl"
when trackBuildSystem . lift $
need [sourcePath -/- "Rules" -/- "Generators" -/- "GhcSplit.hs"]
lift $ need [script]
trackSource "Rules/Generators/GhcSplit.hs"
targetPlatform <- getSetting TargetPlatform
ghcEnableTNC <- yesNo ghcEnableTablesNextToCode
contents <- lift $ readFileLines script
perlPath <- getBuilderPath Perl
contents <- lift $ readFileLines ghcSplitSource
return . unlines $
[ "#!" ++ perl
, "$TARGETPLATFORM = \"" ++ targetPlatform ++ "\";"
[ "#!" ++ perlPath
, "$TARGETPLATFORM = " ++ quote targetPlatform ++ ";"
-- I don't see where the ghc-split tool uses TNC, but
-- it's in the build-perl macro.
, "$TABLES_NEXT_TO_CODE = \"" ++ ghcEnableTNC ++ "\";"
, "$TABLES_NEXT_TO_CODE = " ++ quote ghcEnableTNC ++ ";"
] ++ contents
module Rules.Generators.GhcVersionH (generateGhcVersionH) where
import Base
import Expression
import Oracles
import Settings.User
import Rules.Generators.Common
generateGhcVersionH :: Expr String
generateGhcVersionH = do
when trackBuildSystem . lift $
need [sourcePath -/- "Rules/Generators/GhcVersionH.hs"]
trackSource "Rules/Generators/GhcVersionH.hs"
version <- getSetting ProjectVersionInt
patchLevel1 <- getSetting ProjectPatchLevel1
patchLevel2 <- getSetting ProjectPatchLevel2
......
......@@ -3,12 +3,11 @@ module Rules.Generators.VersionHs (generateVersionHs) where
import Base
import Expression
import Oracles
import Settings.User
import Rules.Generators.Common
generateVersionHs :: Expr String
generateVersionHs = do
when trackBuildSystem . lift $
need [sourcePath -/- "Rules/Generators/VersionHs.hs"]
trackSource "Rules/Generators/VersionHs.hs"
projectVersion <- getSetting ProjectVersion
targetOs <- getSetting TargetOs
targetArch <- getSetting TargetArch
......
......@@ -3,23 +3,12 @@ module Rules.Perl (perlScriptRules) where
import Base
import Expression
import Rules.Actions (runBuilder)
import Rules.Generate (generateExec, emptyTarget)
import Rules.Generators.GhcSplit (generateGhcSplit)
-- | Generate scripts the build system requires. For now we generate the
-- @ghc-split@ script from it's literate perl source.
-- TODO: get rid of perl scripts
-- | Generate perl scripts the build system requires, such as @ghc-split@,
-- from the corresponding literate perl source.
perlScriptRules :: Rules ()
perlScriptRules = do
-- how to translate literate perl to perl.
-- this is a hack :-/
"//*.prl" %> \out -> do
let src = out -<.> "lprl"
runBuilder Unlit [src, out]
-- ghc-split is only a perl script.
let ghcSplit = "inplace/lib/bin/ghc-split"
ghcSplit <~ generateGhcSplit
where
file <~ gen = file %> \out -> generateExec out emptyTarget gen
......@@ -60,7 +60,7 @@ buildWrapper :: PartialTarget -> Wrapper -> FilePath -> FilePath -> Action ()
buildWrapper target @ (PartialTarget stage pkg) wrapper wrapperPath binPath = do
contents <- interpretPartial target $ wrapper binPath
writeFileChanged wrapperPath contents
unit $ cmd "chmod +x " [wrapperPath]
makeExecutable wrapperPath
putSuccess $ "| Successfully created wrapper for '" ++ pkgNameString pkg
++ "' (" ++ show stage ++ ")."
......
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