Skip to content

GitLab

Commit badd5513 authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files
Options

Refactor paths using Context. 

See #207.
parent 13ad0500
Hide whitespace changes
Inline Side-by-side
Showing with 177 additions and 161 deletions
src/Builder.hs
View file @ badd5513
......@@ -6,12 +6,12 @@ module Builder (
import Control.Monad.Trans.Reader
import Base
import Context
import GHC
import GHC.Generics (Generic)
import Oracles.Config
import Oracles.LookupInPath
import Oracles.WindowsPath
import Package
import Stage
-- | A 'Builder' is an external command invoked in separate process using 'Shake.cmd'
......@@ -54,22 +54,25 @@ data Builder = Alex
deriving (Show, Eq, Generic)
-- | Some builders are built by this very build system, in which case
-- 'builderProvenance' returns the corresponding 'Stage' and GHC 'Package'.
builderProvenance :: Builder -> Maybe (Stage, Package)
-- 'builderProvenance' returns the corresponding build 'Context' (which includes
-- 'Stage' and GHC 'Package').
builderProvenance :: Builder -> Maybe Context
builderProvenance = \case
DeriveConstants -> Just (Stage0, deriveConstants)
GenApply -> Just (Stage0, genapply)
GenPrimopCode -> Just (Stage0, genprimopcode)
Ghc stage -> if stage == Stage0 then Nothing else Just (pred stage, ghc)
DeriveConstants -> context Stage0 deriveConstants
GenApply -> context Stage0 genapply
GenPrimopCode -> context Stage0 genprimopcode
Ghc stage -> if stage == Stage0 then Nothing else context (pred stage) ghc
GhcM stage -> builderProvenance $ Ghc stage
GhcCabal -> Just (Stage0, ghcCabal)
GhcCabal -> context Stage0 ghcCabal
GhcCabalHsColour -> builderProvenance $ GhcCabal
GhcPkg stage -> if stage > Stage0 then Just (Stage0, ghcPkg) else Nothing
Haddock -> Just (Stage2, haddock)
Hpc -> Just (Stage1, hpcBin)
Hsc2Hs -> Just (Stage0, hsc2hs)
Unlit -> Just (Stage0, unlit)
GhcPkg stage -> if stage > Stage0 then context Stage0 ghcPkg else Nothing
Haddock -> context Stage2 haddock
Hpc -> context Stage1 hpcBin
Hsc2Hs -> context Stage0 hsc2hs
Unlit -> context Stage0 unlit
_ -> Nothing
where
context s p = Just $ vanillaContext s p
isInternal :: Builder -> Bool
isInternal = isJust . builderProvenance
......@@ -87,7 +90,7 @@ isStaged = \case
-- | Determine the location of a 'Builder'
builderPath :: Builder -> Action FilePath
builderPath builder = case builderProvenance builder of
Just (stage, pkg) -> return . fromJust $ programPath stage pkg
Just context -> return . fromJust $ programPath context
Nothing -> do
let builderKey = case builder of
Alex -> "alex"
......
src/Expression.hs
View file @ badd5513
......@@ -15,7 +15,7 @@ module Expression (
Context, vanillaContext, stageContext, Target, dummyTarget,
-- * Convenient accessors
getStage, getPackage, getBuilder, getOutputs, getInputs, getWay,
getContext, getStage, getPackage, getBuilder, getOutputs, getInputs, getWay,
getInput, getOutput,
-- * Re-exports
......@@ -163,22 +163,26 @@ fromDiffExpr = fmap (($ mempty) . fromDiff)
interpretDiff :: Monoid a => Target -> DiffExpr a -> Action a
interpretDiff target = interpret target . fromDiffExpr
-- | Convenient getters for target parameters.
-- | Get the current build 'Context'.
getContext :: Expr Context
getContext = asks context
-- | Get the 'Stage' of the current 'Context'.
getStage :: Expr Stage
getStage = stage <$> asks context
-- | Get the 'Package' of the current 'Target'.
-- | Get the 'Package' of the current 'Context'.
getPackage :: Expr Package
getPackage = package <$> asks context
-- | Get the 'Way' of the current 'Context'.
getWay :: Expr Way
getWay = way <$> asks context
-- | Get the 'Builder' for the current 'Target'.
getBuilder :: Expr Builder
getBuilder = asks builder
-- | Get the 'Way' of the current 'Target'.
getWay :: Expr Way
getWay = way <$> asks context
-- | Get the input files of the current 'Target'.
getInputs :: Expr [FilePath]
getInputs = asks inputs
......
src/GHC.hs
View file @ badd5513
......@@ -8,10 +8,11 @@ module GHC (
primitive, process, rts, runGhc, stm, templateHaskell, terminfo, time,
touchy, transformers, unlit, unix, win32, xhtml,
defaultKnownPackages, programPath, targetDirectory
defaultKnownPackages, programPath, contextDirectory, rtsContext
) where
import Base
import Context
import Package
import Stage
......@@ -103,26 +104,29 @@ ghcSplit = "inplace/lib/bin/ghc-split"
-- TODO: move to buildRootPath, see #113
-- TODO: simplify, add programInplaceLibPath
-- | The relative path to the program executable
programPath :: Stage -> Package -> Maybe FilePath
programPath stage pkg
| pkg == ghc = Just . inplaceProgram $ "ghc-stage" ++ show (fromEnum stage + 1)
| pkg `elem` [ghcTags, haddock, mkUserGuidePart] = case stage of
Stage2 -> Just . inplaceProgram $ pkgNameString pkg
programPath :: Context -> Maybe FilePath
programPath context @ (Context {..})
| package == ghc = Just . inplaceProgram $ "ghc-stage" ++ show (fromEnum stage + 1)
| package `elem` [ghcTags, haddock, mkUserGuidePart] = case stage of
Stage2 -> Just . inplaceProgram $ pkgNameString package
_ -> Nothing
| pkg `elem` [touchy, unlit] = case stage of
Stage0 -> Just $ "inplace/lib/bin" -/- pkgNameString pkg <.> exe
| package `elem` [touchy, unlit] = case stage of
Stage0 -> Just $ "inplace/lib/bin" -/- pkgNameString package <.> exe
_ -> Nothing
| pkg == hpcBin = case stage of
| package == hpcBin = case stage of
Stage1 -> Just $ inplaceProgram "hpc"
_ -> Nothing
| isProgram pkg = case stage of
Stage0 -> Just . inplaceProgram $ pkgNameString pkg
_ -> Just . installProgram $ pkgNameString pkg
| isProgram package = case stage of
Stage0 -> Just . inplaceProgram $ pkgNameString package
_ -> Just . installProgram $ pkgNameString package
| otherwise = Nothing
where
inplaceProgram name = programInplacePath -/- name <.> exe
installProgram name = pkgPath pkg -/- targetDirectory stage pkg
-/- "build/tmp" -/- name <.> exe
installProgram name = pkgPath package -/- contextDirectory context
-/- "build/tmp" -/- name <.> exe
rtsContext :: Context
rtsContext = vanillaContext Stage1 rts
-- | GHC build results will be placed into target directories with the
-- following typical structure:
......@@ -130,6 +134,6 @@ programPath stage pkg
-- * @build/@ contains compiled object code
-- * @doc/@ is produced by haddock
-- * @package-data.mk@ contains output of ghc-cabal applied to pkgCabal
targetDirectory :: Stage -> Package -> FilePath
targetDirectory stage _ = stageString stage
contextDirectory :: Context -> FilePath
contextDirectory (Context {..}) = stageString stage
src/Oracles/ModuleFiles.hs
View file @ badd5513
......@@ -2,31 +2,31 @@
module Oracles.ModuleFiles (moduleFiles, haskellModuleFiles, moduleFilesOracle) where
import Base
import Context
import Oracles.PackageData
import Package
import Stage
import Settings.Paths
newtype ModuleFilesKey = ModuleFilesKey ([String], [FilePath])
deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
moduleFiles :: Stage -> Package -> Action [FilePath]
moduleFiles stage pkg = do
let path = targetPath stage pkg
moduleFiles :: Context -> Action [FilePath]
moduleFiles context @ (Context {..}) = do
let path = contextPath context
srcDirs <- fmap sort . pkgDataList $ SrcDirs path
modules <- fmap sort . pkgDataList $ Modules path
let dirs = [ pkgPath pkg -/- dir | dir <- srcDirs ]
let dirs = [ pkgPath package -/- dir | dir <- srcDirs ]
found :: [(String, FilePath)] <- askOracle $ ModuleFilesKey (modules, dirs)
return $ map snd found
haskellModuleFiles :: Stage -> Package -> Action ([FilePath], [String])
haskellModuleFiles stage pkg = do
let path = targetPath stage pkg
haskellModuleFiles :: Context -> Action ([FilePath], [String])
haskellModuleFiles context @ (Context {..}) = do
let path = contextPath context
autogen = path -/- "build/autogen"
dropPkgPath = drop $ length (pkgPath pkg) + 1
dropPkgPath = drop $ length (pkgPath package) + 1
srcDirs <- fmap sort . pkgDataList $ SrcDirs path
modules <- fmap sort . pkgDataList $ Modules path
let dirs = [ pkgPath pkg -/- dir | dir <- srcDirs ]
let dirs = [ pkgPath package -/- dir | dir <- srcDirs ]
foundSrcDirs <- askOracle $ ModuleFilesKey (modules, dirs )
foundAutogen <- askOracle $ ModuleFilesKey (modules, [autogen])
......
src/Rules.hs
View file @ badd5513
......@@ -3,7 +3,7 @@ module Rules (topLevelTargets, buildRules) where
import Data.Foldable
import Base
import Context hiding (stage, package, way)
import Context
import Expression
import GHC
import Rules.Compile
......@@ -33,8 +33,8 @@ topLevelTargets = do
-- TODO: do we want libffiLibrary to be a top-level target?
action $ do -- TODO: Add support for all rtsWays
rtsLib <- pkgLibraryFile Stage1 rts vanilla
rtsThrLib <- pkgLibraryFile Stage1 rts threaded
rtsLib <- pkgLibraryFile $ rtsContext { way = vanilla }
rtsThrLib <- pkgLibraryFile $ rtsContext { way = threaded }
need [ rtsLib, rtsThrLib ]
for_ allStages $ \stage ->
......@@ -45,11 +45,11 @@ topLevelTargets = do
if isLibrary pkg
then do -- build a library
ways <- interpretInContext context getLibraryWays
libs <- traverse (pkgLibraryFile stage pkg) ways
libs <- traverse (pkgLibraryFile . Context stage pkg) ways
docs <- interpretInContext context buildHaddock
need $ libs ++ [ pkgHaddockFile pkg | docs && stage == Stage1 ]
need $ libs ++ [ pkgHaddockFile context | docs && stage == Stage1 ]
else do -- otherwise build a program
need [ fromJust $ programPath stage pkg ] -- TODO: drop fromJust
need [ fromJust $ programPath context ] -- TODO: drop fromJust
packageRules :: Rules ()
packageRules = do
......
src/Rules/Clean.hs
View file @ badd5513
module Rules.Clean (cleanRules) where
import Base
import Context
import Package
import Rules.Generate
import Settings.Packages
......@@ -25,7 +26,7 @@ cleanRules = do
putBuild $ "| Remove files generated by ghc-cabal..."
forM_ knownPackages $ \pkg ->
forM_ [Stage0 ..] $ \stage -> do
let dir = pkgPath pkg -/- targetDirectory stage pkg
let dir = pkgPath pkg -/- contextDirectory (vanillaContext stage pkg)
removeDirectoryIfExists dir
putBuild $ "| Remove the Shake database " ++ shakeFilesPath ++ "..."
removeFilesAfter shakeFilesPath ["//*"]
......
src/Rules/Compile.hs
View file @ badd5513
......@@ -10,7 +10,7 @@ import Target
compilePackage :: [(Resource, Int)] -> Context -> Rules ()
compilePackage rs context @ (Context {..}) = do
let buildPath = targetPath stage package -/- "build"
let buildPath = contextPath context -/- "build"
buildPath <//> "*" <.> hisuf way %> \hi ->
if compileInterfaceFilesSeparately
......
src/Rules/Data.hs
View file @ badd5513
......@@ -20,8 +20,8 @@ buildPackageData :: Context -> Rules ()
buildPackageData context @ (Context {..}) = do
let cabalFile = pkgCabalFile package
configure = pkgPath package -/- "configure"
dataFile = pkgDataFile stage package
oldPath = pkgPath package -/- targetDirectory stage package -- TODO: remove, #113
dataFile = pkgDataFile context
oldPath = pkgPath package -/- contextDirectory context -- TODO: remove, #113
[dataFile, oldPath -/- "package-data.mk"] &%> \_ -> do
-- The first thing we do with any package is make sure all generated
......@@ -35,7 +35,7 @@ buildPackageData context @ (Context {..}) = do
deps <- packageDeps package
pkgs <- interpretInContext context getPackages
let depPkgs = matchPackageNames (sort pkgs) deps
need =<< traverse (pkgConfFile stage) depPkgs
need =<< traverse (pkgConfFile . vanillaContext stage) depPkgs
-- TODO: get rid of this, see #113
let inTreeMk = oldPath -/- takeFileName dataFile
......@@ -46,19 +46,19 @@ buildPackageData context @ (Context {..}) = do
-- TODO: get rid of this, see #113
liftIO $ IO.copyFile inTreeMk dataFile
autogenFiles <- getDirectoryFiles oldPath ["build/autogen/*"]
createDirectory $ targetPath stage package -/- "build/autogen"
createDirectory $ contextPath context -/- "build/autogen"
forM_ autogenFiles $ \file -> do
copyFile (oldPath -/- file) (targetPath stage package -/- file)
copyFile (oldPath -/- file) (contextPath context -/- file)
let haddockPrologue = "haddock-prologue.txt"
copyFile (oldPath -/- haddockPrologue) (targetPath stage package -/- haddockPrologue)
copyFile (oldPath -/- haddockPrologue) (contextPath context -/- haddockPrologue)
postProcessPackageData stage package dataFile
postProcessPackageData context dataFile
-- TODO: PROGNAME was $(CrossCompilePrefix)hp2ps
priority 2.0 $ do
when (package == hp2ps) $ dataFile %> \mk -> do
includes <- interpretInContext context $ fromDiffExpr includesArgs
let prefix = fixKey (targetPath stage package) ++ "_"
let prefix = fixKey (contextPath context) ++ "_"
cSrcs = [ "AreaBelow.c", "Curves.c", "Error.c", "Main.c"
, "Reorder.c", "TopTwenty.c", "AuxFile.c"
, "Deviation.c", "HpFile.c", "Marks.c", "Scale.c"
......@@ -73,7 +73,7 @@ buildPackageData context @ (Context {..}) = do
putSuccess $ "| Successfully generated '" ++ mk ++ "'."
when (package == unlit) $ dataFile %> \mk -> do
let prefix = fixKey (targetPath stage package) ++ "_"
let prefix = fixKey (contextPath context) ++ "_"
contents = unlines $ map (prefix++)
[ "PROGNAME = unlit"
, "C_SRCS = unlit.c"
......@@ -82,7 +82,7 @@ buildPackageData context @ (Context {..}) = do
putSuccess $ "| Successfully generated '" ++ mk ++ "'."
when (package == touchy) $ dataFile %> \mk -> do
let prefix = fixKey (targetPath stage package) ++ "_"
let prefix = fixKey (contextPath context) ++ "_"
contents = unlines $ map (prefix++)
[ "PROGNAME = touchy"
, "C_SRCS = touchy.c" ]
......@@ -93,7 +93,7 @@ buildPackageData context @ (Context {..}) = do
-- package, we cannot generate the corresponding `package-data.mk` file
-- by running by running `ghcCabal`, because it has not yet been built.
when (package == ghcCabal && stage == Stage0) $ dataFile %> \mk -> do
let prefix = fixKey (targetPath stage package) ++ "_"
let prefix = fixKey (contextPath context) ++ "_"
contents = unlines $ map (prefix++)
[ "PROGNAME = ghc-cabal"
, "MODULES = Main"
......@@ -106,7 +106,7 @@ buildPackageData context @ (Context {..}) = do
dataFile %> \mk -> do
orderOnly $ generatedDependencies stage package
windows <- windowsHost
let prefix = fixKey (targetPath stage package) ++ "_"
let prefix = fixKey (contextPath context) ++ "_"
dirs = [ ".", "hooks", "sm", "eventlog" ]
++ [ "posix" | not windows ]
++ [ "win32" | windows ]
......@@ -137,8 +137,8 @@ buildPackageData context @ (Context {..}) = do
-- For example libraries/deepseq/dist-install_VERSION = 1.4.0.0
-- is replaced by libraries_deepseq_dist-install_VERSION = 1.4.0.0
-- Reason: Shake's built-in makefile parser doesn't recognise slashes
postProcessPackageData :: Stage -> Package -> FilePath -> Action ()
postProcessPackageData stage package file = fixFile file fixPackageData
postProcessPackageData :: Context -> FilePath -> Action ()
postProcessPackageData context @ (Context {..}) file = fixFile file fixPackageData
where
fixPackageData = unlines . map processLine . filter (not . null) . filter ('$' `notElem`) . lines
processLine line = fixKey fixedPrefix ++ suffix
......@@ -147,7 +147,7 @@ postProcessPackageData stage package file = fixFile file fixPackageData
-- Change package/path/targetDir to takeDirectory file
-- This is a temporary hack until we get rid of ghc-cabal
fixedPrefix = takeDirectory file ++ drop len prefix
len = length (pkgPath package -/- targetDirectory stage package)
len = length (pkgPath package -/- contextDirectory context)
-- TODO: remove, see #113
fixKey :: String -> String
......
src/Rules/Dependencies.hs
View file @ badd5513
......@@ -13,7 +13,7 @@ import Target
-- TODO: simplify handling of AutoApply.cmm
buildPackageDependencies :: [(Resource, Int)] -> Context -> Rules ()
buildPackageDependencies rs context @ (Context {..}) =
let path = targetPath stage package
let path = contextPath context
buildPath = path -/- "build"
dropBuild = (pkgPath package ++) . drop (length buildPath)
hDepFile = buildPath -/- ".hs-dependencies"
......
src/Rules/Documentation.hs
View file @ badd5513
......@@ -18,12 +18,12 @@ haddockHtmlLib = "inplace/lib/html/haddock-util.js"
buildPackageDocumentation :: Context -> Rules ()
buildPackageDocumentation context @ (Context {..}) =
let cabalFile = pkgCabalFile package
haddockFile = pkgHaddockFile package
haddockFile = pkgHaddockFile context
in when (stage == Stage1) $ do
haddockFile %> \file -> do
srcs <- interpretInContext context getPackageSources
deps <- map PackageName <$> interpretInContext context (getPkgDataList DepNames)
let haddocks = [ pkgHaddockFile depPkg
let haddocks = [ pkgHaddockFile $ vanillaContext Stage1 depPkg
| Just depPkg <- map findKnownPackage deps
, depPkg /= rts ]
need $ srcs ++ haddocks ++ [haddockHtmlLib]
......@@ -31,7 +31,7 @@ buildPackageDocumentation context @ (Context {..}) =
-- HsColour sources
-- TODO: what is the output of GhcCabalHsColour?
whenM (specified HsColour) $ do
pkgConf <- pkgConfFile stage package
pkgConf <- pkgConfFile context
need [ cabalFile, pkgConf ] -- TODO: check if need pkgConf
build $ Target context GhcCabalHsColour [cabalFile] []
......
src/Rules/Generate.hs
View file @ badd5513
......@@ -34,10 +34,12 @@ primopsSource :: FilePath
primopsSource = "compiler/prelude/primops.txt.pp"
primopsTxt :: Stage -> FilePath
primopsTxt stage = targetPath stage compiler -/- "build/primops.txt"
primopsTxt stage =
contextPath (vanillaContext stage compiler) -/- "build/primops.txt"
platformH :: Stage -> FilePath
platformH stage = targetPath stage compiler -/- "ghc_boot_platform.h"
platformH stage =
contextPath (vanillaContext stage compiler) -/- "ghc_boot_platform.h"
-- TODO: move generated files to buildRootPath, see #113
includesDependencies :: [FilePath]
......@@ -47,7 +49,8 @@ includesDependencies = ("includes" -/-) <$>
, "ghcversion.h" ]
ghcPrimDependencies :: Stage -> [FilePath]
ghcPrimDependencies stage = ((targetPath stage ghcPrim -/- "build") -/-) <$>
ghcPrimDependencies stage =
((contextPath (vanillaContext stage ghcPrim) -/- "build") -/-) <$>
[ "autogen/GHC/Prim.hs"
, "GHC/PrimopWrappers.hs" ]
......@@ -68,7 +71,7 @@ compilerDependencies stage =
++ [ gmpLibraryH | stage > Stage0 ]
++ filter (const $ stage > Stage0) libffiDependencies
++ derivedConstantsDependencies
++ fmap ((targetPath stage compiler -/- "build") -/-)
++ fmap ((contextPath (vanillaContext stage compiler) -/- "build") -/-)
[ "primop-can-fail.hs-incl"
, "primop-code-size.hs-incl"
, "primop-commutable.hs-incl"
......@@ -115,7 +118,7 @@ generate file context expr = do
generatePackageCode :: Context -> Rules ()
generatePackageCode context @ (Context stage pkg _) =
let buildPath = targetPath stage pkg -/- "build"
let buildPath = contextPath context -/- "build"
dropBuild = drop (length buildPath + 1)
generated f = (buildPath ++ "//*.hs") ?== f && not ("//autogen/*" ?== f)
file <~ gen = generate file context gen
......@@ -123,7 +126,7 @@ generatePackageCode context @ (Context stage pkg _) =
generated ?> \file -> do
let srcFile = dropBuild file
pattern = "//" ++ srcFile -<.> "*"
files <- fmap (filter (pattern ?==)) $ moduleFiles stage pkg
files <- fmap (filter (pattern ?==)) $ moduleFiles context
let gens = [ (f, b) | f <- files, Just b <- [determineBuilder f] ]
when (length gens /= 1) . putError $
"Exactly one generator expected for " ++ file
......@@ -148,7 +151,7 @@ generatePackageCode context @ (Context stage pkg _) =
need [primopsTxt stage]
build $ Target context GenPrimopCode [primopsTxt stage] [file]
-- TODO: this is temporary hack, get rid of this (#113)
let oldPath = pkgPath pkg -/- targetDirectory stage pkg -/- "build"
let oldPath = pkgPath pkg -/- contextDirectory context -/- "build"
newFile = oldPath ++ (drop (length buildPath) file)
createDirectory $ takeDirectory newFile
liftIO $ IO.copyFile file newFile
......@@ -159,8 +162,8 @@ generatePackageCode context @ (Context stage pkg _) =
priority 2.0 $ do
-- TODO: this is temporary hack, get rid of this (#113)
let oldPath = pkgPath pkg -/- targetDirectory stage pkg
olden f = oldPath ++ (drop (length (targetPath stage pkg)) f)
let oldPath = pkgPath pkg -/- contextDirectory context
olden f = oldPath ++ (drop (length (contextPath context)) f)
when (pkg == compiler) $ buildPath -/- "Config.hs" %> \file -> do
file <~ generateConfigHs
......@@ -200,7 +203,7 @@ generateRules = do
-- TODO: simplify, get rid of fake rts context
derivedConstantsPath ++ "//*" %> \file -> do
withTempDir $ \dir -> build $
Target (vanillaContext Stage1 rts) DeriveConstants [] [file, dir]
Target rtsContext DeriveConstants [] [file, dir]
where
file <~ gen = file %> \out -> generate out emptyTarget gen
......
src/Rules/Gmp.hs
View file @ badd5513
......@@ -122,4 +122,4 @@ gmpRules = do
-- This causes integerGmp package to be configured, hence creating the files
[gmpBase -/- "config.mk", gmpBuildInfoPath] &%> \_ ->
need [pkgDataFile Stage1 integerGmp]
need [pkgDataFile gmpContext]
src/Rules/Libffi.hs
View file @ badd5513
......@@ -15,7 +15,7 @@ import Target
-- TODO: this should be moved elsewhere
rtsBuildPath :: FilePath
rtsBuildPath = targetPath Stage1 rts -/- "build"
rtsBuildPath = contextPath rtsContext -/- "build"
-- TODO: Why copy these include files into rts? Keep in libffi!
libffiDependencies :: [FilePath]
......
src/Rules/Library.hs
View file @ badd5513
......@@ -17,7 +17,7 @@ import Target
buildPackageLibrary :: Context -> Rules ()
buildPackageLibrary context @ (Context {..}) = do
let buildPath = targetPath stage package -/- "build"
let buildPath = contextPath context -/- "build"
libPrefix = buildPath -/- "libHS" ++ pkgNameString package
-- TODO: handle dynamic libraries
......@@ -61,7 +61,7 @@ buildPackageLibrary context @ (Context {..}) = do
buildPackageGhciLibrary :: Context -> Rules ()
buildPackageGhciLibrary context @ (Context {..}) = priority 2 $ do
let buildPath = targetPath stage package -/- "build"
let buildPath = contextPath context -/- "build"
libPrefix = buildPath -/- "HS" ++ pkgNameString package
-- TODO: simplify handling of AutoApply.cmm
......
src/Rules/Program.hs
View file @ badd5513
......@@ -32,10 +32,10 @@ wrappers = [ (vanillaContext Stage0 ghc , ghcWrapper )
buildProgram :: [(Resource, Int)] -> Context -> Rules ()
buildProgram rs context @ (Context {..}) = do
let match file = case programPath stage package of
let match file = case programPath context of
Nothing -> False
Just program -> program == file
matchWrapped file = case programPath stage package of
matchWrapped file = case programPath context of
Nothing -> False
Just program -> case computeWrappedPath program of
Nothing -> False
......@@ -71,7 +71,7 @@ buildWrapper context @ (Context stage package _) wrapper wrapperPath binPath = d
-- TODO: Do we need to consider other ways when building programs?
buildBinary :: [(Resource, Int)] -> Context -> FilePath -> Action ()
buildBinary rs context @ (Context stage package _) bin = do
let buildPath = targetPath stage package -/- "build"
let buildPath = contextPath context -/- "build"
cSrcs <- cSources context -- TODO: remove code duplication (Library.hs)
hSrcs <- hSources context
let cObjs = [ buildPath -/- src -<.> osuf vanilla | src <- cSrcs ]
......@@ -89,11 +89,11 @@ buildBinary rs context @ (Context stage package _) bin = do
let depContext = vanillaContext libStage dep
ghciFlag <- interpretInContext depContext $ getPkgData BuildGhciLib
libFiles <- fmap concat . forM ways $ \way -> do
libFile <- pkgLibraryFile libStage dep way
lib0File <- pkgLibraryFile0 libStage dep way
libFile <- pkgLibraryFile $ Context libStage dep way
lib0File <- pkgLibraryFile0 $ Context libStage dep way
dll0 <- needDll0 libStage dep
return $ libFile : [ lib0File | dll0 ]
ghciLib <- pkgGhciLibraryFile libStage dep
ghciLib <- pkgGhciLibraryFile $ vanillaContext libStage dep
return $ libFiles ++ [ ghciLib | ghciFlag == "YES" && stage == Stage1 ]
let binDeps = if package == ghcCabal && stage == Stage0
then [ pkgPath package -/- src <.> "hs" | src <- hSrcs ]
......
src/Rules/Register.hs
View file @ badd5513
......@@ -13,19 +13,19 @@ import Target
-- Build package-data.mk by using GhcCabal to process pkgCabal file
registerPackage :: [(Resource, Int)] -> Context -> Rules ()
registerPackage rs context @ (Context {..}) = do
let oldPath = pkgPath package -/- targetDirectory stage package -- TODO: remove, #113
let oldPath = pkgPath package -/- contextDirectory context -- TODO: remove, #113
pkgConf = packageDbDirectory stage -/- pkgNameString package
when (stage <= Stage1) $ matchVersionedFilePath pkgConf "conf" ?> \conf -> do
-- This produces inplace-pkg-config. TODO: Add explicit tracking
need [pkgDataFile stage package]
need [pkgDataFile context]
-- Post-process inplace-pkg-config. TODO: remove, see #113, #148
let pkgConfig = oldPath -/- "inplace-pkg-config"
fixPkgConf = unlines
. map (replace oldPath (targetPath stage package)
. map (replace oldPath (contextPath context)
. replace (replaceSeparators '\\' $ oldPath)
(targetPath stage package) )
(contextPath context) )
. lines
fixFile pkgConfig fixPkgConf
......@@ -40,7 +40,7 @@ registerPackage rs context @ (Context {..}) = do
Target context (GhcPkg stage) [rtsConf] [conf]
rtsConf %> \_ -> do
need [ pkgDataFile Stage1 rts, rtsConfIn ]
need [ pkgDataFile rtsContext, rtsConfIn ]
build $ Target context HsCpp [rtsConfIn] [rtsConf]
let fixRtsConf = unlines
......
src/Settings.hs
View file @ badd5513
......@@ -4,7 +4,7 @@ module Settings (
module Settings.User,
module Settings.Ways,
getPkgData, getPkgDataList, getTopDirectory, isLibrary,
getPackagePath, getTargetDirectory, getTargetPath, getPackageSources
getPackagePath, getContextDirectory, getContextPath, getPackageSources
) where
import Base
......@@ -20,17 +20,17 @@ import Settings.Ways