Refactor paths using Context.

See #207.

src/Builder.hs

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

 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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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
 getPackagePath :: Expr FilePath
 getPackagePath = pkgPath <$> getPackage
 
-getTargetDirectory :: Expr FilePath