Commit fcb25e6e authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Implement expression for GhcM builder.

parent 86b0a17a
......@@ -3,6 +3,7 @@ module Settings.Args (
) where
import Settings.User
import Settings.GhcM
import Settings.GhcPkg
import Settings.GhcCabal
import Expression
......@@ -16,4 +17,5 @@ defaultArgs :: Args
defaultArgs = mconcat
[ cabalArgs
, ghcPkgArgs
, ghcMArgs
, customPackageArgs ]
module Settings.GhcM (ghcMArgs) where
import Way
import Util
import Stage
import Builder
import Package
import Switches
import Expression
import Oracles.Flag
import Oracles.PackageData
import Settings.Util
import Settings.Ways
import Settings.TargetDirectory
import Development.Shake
ghcMArgs :: Args
ghcMArgs = do
stage <- asks getStage
builder (GhcM stage) ? do
pkg <- asks getPackage
cppArgs <- askPkgDataList CppArgs
hsArgs <- askPkgDataList HsArgs
hsSrcs <- askHsSources
ways <- fromDiffExpr Settings.Ways.ways
let buildPath = unifyPath $ targetPath stage pkg </> "build"
mconcat
[ arg "-M"
, packageGhcArgs
, includeGhcArgs
, append . map ("-optP" ++) $ cppArgs
, arg $ "-odir " ++ buildPath
, arg $ "-stubdir " ++ buildPath
, arg $ "-hidir " ++ buildPath
, arg $ "-dep-makefile " ++ buildPath </> "haskell.deps"
, append . map (\way -> "-dep-suffix " ++ wayPrefix way) $ ways
, append hsArgs
, append hsSrcs ]
packageGhcArgs :: Args
packageGhcArgs = do
stage <- asks getStage
supportsPackageKey <- lift . flag $ SupportsPackageKey
pkgKey <- askPkgData PackageKey
pkgDepKeys <- askPkgDataList DepKeys
pkgDeps <- askPkgDataList Deps
mconcat
[ arg "-hide-all-packages"
, arg "-no-user-package-db"
, arg "-include-pkg-deps"
, stage0 ? arg "-package-db libraries/bootstrapping.conf"
, if supportsPackageKey || stage /= Stage0
then mconcat [ arg $ "-this-package-key " ++ pkgKey
, append . map ("-package-key " ++) $ pkgDepKeys ]
else mconcat [ arg $ "-package-name" ++ pkgKey
, append . map ("-package " ++) $ pkgDeps ]]
includeGhcArgs :: Args
includeGhcArgs = do
stage <- asks getStage
pkg <- asks getPackage
srcDirs <- askPkgDataList SrcDirs
includeDirs <- askPkgDataList IncludeDirs
let buildPath = unifyPath $ targetPath stage pkg </> "build"
autogenPath = unifyPath $ buildPath </> "autogen"
mconcat
[ arg "-i"
, append . map (\dir -> "-i" ++ pkgPath pkg </> dir) $ srcDirs
, arg $ "-i" ++ buildPath
, arg $ "-i" ++ autogenPath
, arg $ "-I" ++ buildPath
, arg $ "-I" ++ autogenPath
, append . map (\dir -> "-I" ++ pkgPath pkg </> dir) $ includeDirs
, arg "-optP-include" -- TODO: Shall we also add -cpp?
, arg $ "-optP" ++ autogenPath </> "cabal_macros.h" ]
askHsSources :: Expr [FilePath]
askHsSources = do
stage <- asks getStage
pkg <- asks getPackage
srcDirs <- askPkgDataList SrcDirs
let autogenPath = unifyPath $ targetPath stage pkg </> "build/autogen"
dirs = autogenPath : map (pkgPath pkg </>) srcDirs
askModuleFiles dirs [".hs", ".lhs"]
askModuleFiles :: [FilePath] -> [String] -> Expr [FilePath]
askModuleFiles directories suffixes = do
modules <- askPkgDataList Modules
let modPaths = map (replaceEq '.' pathSeparator) modules
files <- lift $ forM [ dir </> modPath ++ suffix
| dir <- directories
, modPath <- modPaths
, suffix <- suffixes
] $ \file -> do
let dir = takeDirectory file
dirExists <- doesDirectoryExist dir
return [ unifyPath file | dirExists ]
result <- lift $ getDirectoryFiles "" (concat files)
return $ map unifyPath result
-- $1_$2_$3_ALL_CC_OPTS = \
-- $$(WAY_$3_CC_OPTS) \
-- $$($1_$2_DIST_GCC_CC_OPTS) \
-- $$($1_$2_$3_CC_OPTS) \
-- $$($$(basename $$<)_CC_OPTS) \
-- $$($1_$2_EXTRA_CC_OPTS) \
-- $$(EXTRA_CC_OPTS)
--
-- $1_$2_DIST_CC_OPTS = \
-- $$(SRC_CC_OPTS) \
-- $$($1_CC_OPTS) \
-- -I$1/$2/build/autogen \
-- $$(foreach dir,$$(filter-out /%,$$($1_$2_INCLUDE_DIRS)),-I$1/$$(dir)) \
-- $$(foreach dir,$$(filter /%,$$($1_$2_INCLUDE_DIRS)),-I$$(dir)) \
-- $$($1_$2_CC_OPTS) \
-- $$($1_$2_CPP_OPTS) \
-- $$($1_$2_CC_INC_FLAGS) \
-- $$($1_$2_DEP_CC_OPTS) \
-- $$(SRC_CC_WARNING_OPTS)
-- TODO: handle custom $1_$2_MKDEPENDC_OPTS and
-- gccArgs :: FilePath -> Package -> TodoItem -> Args
-- gccArgs sourceFile (Package _ path _ _) (stage, dist, settings) =
-- let pathDist = path </> dist
-- buildDir = pathDist </> "build"
-- depFile = buildDir </> takeFileName sourceFile <.> "deps"
-- in args [ args ["-E", "-MM"] -- TODO: add a Cpp Builder instead
-- , args $ CcArgs pathDist
-- , commonCcArgs -- TODO: remove?
-- , customCcArgs settings -- TODO: Replace by customCppArgs?
-- , commonCcWarninigArgs -- TODO: remove?
-- , includeGccArgs path dist
-- , args ["-MF", unifyPath depFile]
-- , args ["-x", "c"]
-- , arg $ unifyPath sourceFile ]
-- buildRule :: Package -> TodoItem -> Rules ()
-- buildRule pkg @ (Package name path _ _) todo @ (stage, dist, settings) = do
-- let pathDist = path </> dist
-- buildDir = pathDist </> "build"
-- (buildDir </> "haskell.deps") %> \_ -> do
-- run (Ghc stage) $ ghcArgs pkg todo
-- -- Finally, record the argument list
-- need [argListPath argListDir pkg stage]
-- (buildDir </> "c.deps") %> \out -> do
-- srcs <- args $ CSrcs pathDist
-- deps <- fmap concat $ forM srcs $ \src -> do
-- let srcPath = path </> src
-- depFile = buildDir </> takeFileName src <.> "deps"
-- run (Gcc stage) $ gccArgs srcPath pkg todo
-- liftIO $ readFile depFile
-- writeFileChanged out deps
-- liftIO $ removeFiles buildDir ["*.c.deps"]
-- -- Finally, record the argument list
-- need [argListPath argListDir pkg stage]
......@@ -2,6 +2,7 @@ module Settings.Util (
-- Primitive settings elements
arg, argPath, argM,
argSetting, argSettingList,
askPkgData, askPkgDataList,
appendCcArgs,
needBuilder
-- argBuilderPath, argStagedBuilderPath,
......@@ -17,7 +18,9 @@ import Builder
import Expression
import Oracles.Base
import Oracles.Setting
import Oracles.PackageData
import Settings.User
import Settings.TargetDirectory
-- A single argument.
arg :: String -> Args
......@@ -36,6 +39,20 @@ argSetting = argM . setting
argSettingList :: SettingList -> Args
argSettingList = appendM . settingList
askPkgData :: (FilePath -> PackageData) -> Expr String
askPkgData key = do
stage <- asks getStage
pkg <- asks getPackage
let path = targetPath stage pkg
lift . pkgData . key $ path
askPkgDataList :: (FilePath -> PackageDataList) -> Expr [String]
askPkgDataList key = do
stage <- asks getStage
pkg <- asks getPackage
let path = targetPath stage pkg
lift . pkgDataList . key $ path
-- Pass arguments to Gcc and corresponding lists of sub-arguments of GhcCabal
appendCcArgs :: [String] -> Args
appendCcArgs xs = do
......
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