Factor out Context from Target.

See #207.

shaking-up-ghc.cabal

@@ -20,6 +20,7 @@ executable ghc-shake
     other-modules:       Base
                        , Builder
                        , CmdLineFlag
+                       , Context
                        , Environment
                        , Expression
                        , GHC

src/Context.hs

+{-# LANGUAGE DeriveGeneric #-}
+module Context (Context (..), vanillaContext, stageContext) where
+
+import GHC.Generics (Generic)
+
+import Base
+import Package
+import Stage
+import Way
+
+-- | Build context for a currently built 'Target'. We generate potentially
+-- different build rules for each 'Context'.
+data Context = Context
+    { stage   :: Stage   -- ^ Currently build Stage
+    , package :: Package -- ^ Currently build Package
+    , way     :: Way     -- ^ Currently build Way (usually 'vanilla')
+    } deriving (Show, Eq, Generic)
+
+-- | Most targets are built only one way, hence the notion of 'vanillaContext'.
+vanillaContext :: Stage -> Package -> Context
+vanillaContext s p = Context s p vanilla
+
+stageContext :: Stage -> Context
+stageContext s = vanillaContext s $ error "stageContext: package not set"
+
+instance Binary Context
+instance NFData Context
+instance Hashable Context

src/Expression.hs

@@ -6,13 +6,13 @@ module Expression (
     apply, append, arg, remove, removePair,
     appendSub, appendSubD, filterSub, removeSub,
     -- ** Evaluation
-    interpret, interpretPartial, interpretWithStage, interpretDiff,
+    interpret, interpretInContext, interpretDiff,
     -- ** Predicates
     Predicate, (?), applyPredicate,
     -- ** Common expressions
     Args, Ways, Packages,
-    -- ** Targets
-    Target, PartialTarget (..), unsafeFromPartial, fullTarget, fullTargetWithWay,
+    -- ** Context and Target
+    Context, vanillaContext, stageContext, Target, dummyTarget,
 
     -- * Convenient accessors
     getStage, getPackage, getBuilder, getOutputs, getInputs, getWay,
@@ -30,6 +30,7 @@ import Control.Monad.Trans.Reader
 import Data.Monoid
 
 import Base
+import Context
 import Package
 import Builder
 import Stage
@@ -146,16 +147,13 @@ filterSub prefix p = apply $ map filterSubstr
 removeSub :: String -> [String] -> Args
 removeSub prefix xs = filterSub prefix (`notElem` xs)
 
--- | Interpret a given expression in a given environment.
+-- | Interpret a given expression according to the given 'Target'.
 interpret :: Target -> Expr a -> Action a
 interpret = flip runReaderT
 
-interpretPartial :: PartialTarget -> Expr a -> Action a
-interpretPartial = interpret . unsafeFromPartial
-
-interpretWithStage :: Stage -> Expr a -> Action a
-interpretWithStage s = interpretPartial $
-    PartialTarget s (error "interpretWithStage: package not set")
+-- | Interpret a given expression by looking only at the given 'Context'.
+interpretInContext :: Context -> Expr a -> Action a
+interpretInContext = interpret . dummyTarget
 
 -- | Extract an expression from a difference expression.
 fromDiffExpr :: Monoid a => DiffExpr a -> Expr a
@@ -167,11 +165,11 @@ interpretDiff target = interpret target . fromDiffExpr
 
 -- | Convenient getters for target parameters.
 getStage :: Expr Stage
-getStage = asks stage
+getStage = stage <$> asks context
 
 -- | Get the 'Package' of the current 'Target'.
 getPackage :: Expr Package
-getPackage = asks package
+getPackage = package <$> asks context
 
 -- | Get the 'Builder' for the current 'Target'.
 getBuilder :: Expr Builder
@@ -179,7 +177,7 @@ getBuilder = asks builder
 
 -- | Get the 'Way' of the current 'Target'.
 getWay :: Expr Way
-getWay = asks way
+getWay = way <$> asks context
 
 -- | Get the input files of the current 'Target'.
 getInputs :: Expr [FilePath]

src/Oracles/PackageDb.hs

@@ -3,6 +3,7 @@ module Oracles.PackageDb (packageDbOracle) where
 import qualified System.Directory as IO
 
 import Base
+import Context hiding (stage)
 import Builder
 import GHC
 import Rules.Actions
@@ -16,8 +17,7 @@ packageDbOracle = do
         let dir  = packageDbDirectory stage
             file = dir -/- "package.cache"
         unlessM (liftIO $ IO.doesFileExist file) $ do
-            let target  = PartialTarget stage ghcPkg
             removeDirectoryIfExists dir
-            build $ fullTarget target (GhcPkg stage) [] [dir]
+            build $ Target (vanillaContext stage ghcPkg) (GhcPkg stage) [] [dir]
             putSuccess $ "| Successfully initialised " ++ dir
     return ()

src/Rules.hs

@@ -3,7 +3,7 @@ module Rules (topLevelTargets, packageRules) where
 import Base
 import Data.Foldable
 import Expression
-import GHC
+import GHC hiding (haddock)
 import qualified Rules.Generate
 import Rules.Package
 import Rules.Resources
@@ -27,14 +27,14 @@ topLevelTargets = do
 
     for_ allStages $ \stage ->
         for_ (knownPackages \\ [rts, libffi]) $ \pkg -> action $ do
-            let target = PartialTarget stage pkg
-            activePackages <- interpretPartial target getPackages
+            let context = vanillaContext stage pkg
+            activePackages <- interpretInContext context getPackages
             when (pkg `elem` activePackages) $
                 if isLibrary pkg
                 then do -- build a library
-                    ways    <- interpretPartial target getLibraryWays
+                    ways    <- interpretInContext context getLibraryWays
                     libs    <- traverse (pkgLibraryFile stage pkg) ways
-                    haddock <- interpretPartial target buildHaddock
+                    haddock <- interpretInContext context buildHaddock
                     need $ libs ++ [ pkgHaddockFile pkg | haddock && stage == Stage1 ]
                 else do -- otherwise build a program
                     need [ fromJust $ programPath stage pkg ] -- TODO: drop fromJust
@@ -44,4 +44,4 @@ packageRules = do
     resources <- resourceRules
     for_ allStages $ \stage ->
         for_ knownPackages $ \pkg ->
-            buildPackage resources $ PartialTarget stage pkg
+            buildPackage resources $ vanillaContext stage pkg

src/Rules/Actions.hs

@@ -11,20 +11,20 @@ import qualified Control.Exception.Base as IO
 
 import Base
 import CmdLineFlag
+import Context
 import Expression
 import Oracles.ArgsHash
 import Oracles.WindowsPath
 import Settings
 import Settings.Args
 import Settings.Builders.Ar
-import qualified Target
+import Target
 
 -- Build a given target using an appropriate builder and acquiring necessary
 -- resources. Force a rebuilt if the argument list has changed since the last
 -- built (that is, track changes in the build system).
 buildWithResources :: [(Resource, Int)] -> Target -> Action ()
-buildWithResources rs target = do
-    let builder = Target.builder target
+buildWithResources rs target @ Target {..} = do
     needBuilder laxDependencies builder
     path    <- builderPath builder
     argList <- interpret target getArgs
@@ -160,15 +160,15 @@ makeExecutable file = do
     quietly $ cmd "chmod +x " [file]
 
 -- Print out key information about the command being executed
-putInfo :: Target.Target -> Action ()
-putInfo Target.Target {..} = putProgressInfo $ renderAction
-    ("Run " ++ show builder ++ " (" ++ stageInfo
-    ++ "package = " ++ pkgNameString package ++ wayInfo ++ ")")
-    (digest inputs)
-    (digest outputs)
+putInfo :: Target -> Action ()
+putInfo Target {..} = putProgressInfo $ renderAction
+    ("Run " ++ show builder ++ contextInfo) (digest inputs) (digest outputs)
   where
-    stageInfo = if isStaged builder then "" else "stage = " ++ show stage ++ ", "
-    wayInfo   = if way == vanilla   then "" else ", way = " ++ show way
+    contextInfo = concat $ [ " (" ]
+        ++ [ "stage = "     ++ show (stage context) ]
+        ++ [ ", package = " ++ pkgNameString (package context) ]
+        ++ [ ", way = "     ++ show (way context) | way context /= vanilla ]
+        ++ [ ")" ]
     digest [] = "none"
     digest [x] = x
     digest (x:xs) = x ++ " (and " ++ show (length xs) ++ " more)"

src/Rules/Cabal.hs

@@ -14,7 +14,7 @@ cabalRules :: Rules ()
 cabalRules = do
     -- Cache boot package constraints (to be used in cabalArgs)
     bootPackageConstraints %> \out -> do
-        bootPkgs <- interpretWithStage Stage0 getPackages
+        bootPkgs <- interpretInContext (stageContext Stage0) getPackages
         let pkgs = filter (\p -> p /= compiler && isLibrary p) bootPkgs
         constraints <- forM (sort pkgs) $ \pkg -> do
             need [pkgCabalFile pkg]
@@ -27,7 +27,7 @@ cabalRules = do
 
     -- Cache package dependencies
     packageDependencies %> \out -> do
-        pkgs <- interpretWithStage Stage1 getPackages
+        pkgs <- interpretInContext (stageContext Stage1) getPackages
         pkgDeps <- forM (sort pkgs) $ \pkg ->
             if pkg == rts
             then return $ pkgNameString pkg

src/Rules/Compile.hs

+{-# LANGUAGE RecordWildCards #-}
 module Rules.Compile (compilePackage) where
 
 import Base
+import Context
 import Expression
 import Oracles.Dependencies
 import Rules.Actions
 import Rules.Resources
 import Settings
+import Target hiding (context)
 
-compilePackage :: Resources -> PartialTarget -> Rules ()
-compilePackage rs target @ (PartialTarget stage pkg) = do
-    let buildPath = targetPath stage pkg -/- "build"
+-- TODO: Use way from Context, #207
+compilePackage :: Resources -> Context -> Rules ()
+compilePackage rs context @ (Context {..}) = do
+    let buildPath = targetPath stage package -/- "build"
 
     matchBuildResult buildPath "hi" ?> \hi ->
         if compileInterfaceFilesSeparately && not ("//HpcParser.*" ?== hi)
         then do
-            let way = detectWay hi
-            (src, deps) <- dependencies buildPath $ hi -<.> osuf way
+            let w = detectWay hi
+            (src, deps) <- dependencies buildPath $ hi -<.> osuf w
             need $ src : deps
             buildWithResources [(resPackageDb rs, 1)] $
-                fullTargetWithWay target (Ghc stage) way [src] [hi]
+                Target (context { way = w }) (Ghc stage) [src] [hi]
         else need [ hi -<.> osuf (detectWay hi) ]
 
     matchBuildResult buildPath "hi-boot" ?> \hiboot ->
         if compileInterfaceFilesSeparately
         then do
-            let way = detectWay hiboot
-            (src, deps) <- dependencies buildPath $ hiboot -<.> obootsuf way
+            let w = detectWay hiboot
+            (src, deps) <- dependencies buildPath $ hiboot -<.> obootsuf w
             need $ src : deps
             buildWithResources [(resPackageDb rs, 1)] $
-                fullTargetWithWay target (Ghc stage) way [src] [hiboot]
+                Target (context { way = w }) (Ghc stage) [src] [hiboot]
         else need [ hiboot -<.> obootsuf (detectWay hiboot) ]
 
     -- TODO: add dependencies for #include of .h and .hs-incl files (gcc -MM?)
@@ -37,21 +41,21 @@ compilePackage rs target @ (PartialTarget stage pkg) = do
         if ("//*.c" ?== src)
         then do
             need $ src : deps
-            build $ fullTarget target (Gcc stage) [src] [obj]
+            build $ Target context (Gcc stage) [src] [obj]
         else do
-            let way = detectWay obj
+            let w = detectWay obj
             if compileInterfaceFilesSeparately && "//*.hs" ?== src && not ("//HpcParser.*" ?== src)
             then need $ (obj -<.> hisuf (detectWay obj)) : src : deps
             else need $ src : deps
             buildWithResources [(resPackageDb rs, 1)] $
-                fullTargetWithWay target (Ghc stage) way [src] [obj]
+                Target (context { way = w }) (Ghc stage) [src] [obj]
 
     -- TODO: get rid of these special cases
     matchBuildResult buildPath "o-boot" ?> \obj -> do
         (src, deps) <- dependencies buildPath obj
-        let way = detectWay obj
+        let w = detectWay obj
         if compileInterfaceFilesSeparately
         then need $ (obj -<.> hibootsuf (detectWay obj)) : src : deps
         else need $ src : deps
         buildWithResources [(resPackageDb rs, 1)] $
-            fullTargetWithWay target (Ghc stage) way [src] [obj]
+            Target (context { way = w }) (Ghc stage) [src] [obj]

src/Rules/Data.hs

+{-# LANGUAGE RecordWildCards #-}
 module Rules.Data (buildPackageData) where
 
 import qualified System.Directory as IO
 
 import Base
+import Context
 import Expression
 import GHC
 import Oracles.Config.Setting
@@ -13,26 +15,27 @@ import Rules.Libffi
 import Rules.Resources
 import Settings
 import Settings.Builders.Common
+import Target
 
 -- Build package-data.mk by using GhcCabal to process pkgCabal file
-buildPackageData :: Resources -> PartialTarget -> Rules ()
-buildPackageData _ target @ (PartialTarget stage pkg) = do
-    let cabalFile = pkgCabalFile pkg
-        configure = pkgPath pkg -/- "configure"
-        dataFile  = pkgDataFile stage pkg
-        oldPath   = pkgPath pkg -/- targetDirectory stage pkg -- TODO: remove, #113
+buildPackageData :: Resources -> 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, oldPath -/- "package-data.mk"] &%> \_ -> do
         -- The first thing we do with any package is make sure all generated
         -- dependencies are in place before proceeding.
-        orderOnly $ generatedDependencies stage pkg
+        orderOnly $ generatedDependencies stage package
 
         -- GhcCabal may run the configure script, so we depend on it
         whenM (doesFileExist $ configure <.> "ac") $ need [configure]
 
         -- Before we configure a package its dependencies need to be registered
-        deps <- packageDeps pkg
-        pkgs <- interpretPartial target getPackages
+        deps <- packageDeps package
+        pkgs <- interpretInContext context getPackages
         let depPkgs = matchPackageNames (sort pkgs) deps
         need =<< traverse (pkgConfFile stage) depPkgs
 
@@ -40,24 +43,24 @@ buildPackageData _ target @ (PartialTarget stage pkg) = do
         let inTreeMk = oldPath -/- takeFileName dataFile
 
         need [cabalFile]
-        build $ fullTarget target GhcCabal [cabalFile] [inTreeMk]
+        build $ Target context GhcCabal [cabalFile] [inTreeMk]
 
         -- TODO: get rid of this, see #113
         liftIO $ IO.copyFile inTreeMk dataFile
         autogenFiles <- getDirectoryFiles oldPath ["build/autogen/*"]
-        createDirectory $ targetPath stage pkg -/- "build/autogen"
+        createDirectory $ targetPath stage package -/- "build/autogen"
         forM_ autogenFiles $ \file -> do
-            copyFile (oldPath -/- file) (targetPath stage pkg -/- file)
+            copyFile (oldPath -/- file) (targetPath stage package -/- file)
         let haddockPrologue = "haddock-prologue.txt"
-        copyFile (oldPath -/- haddockPrologue) (targetPath stage pkg -/- haddockPrologue)
+        copyFile (oldPath -/- haddockPrologue) (targetPath stage package -/- haddockPrologue)
 
-        postProcessPackageData stage pkg dataFile
+        postProcessPackageData stage package dataFile
 
     -- TODO: PROGNAME was $(CrossCompilePrefix)hp2ps
     priority 2.0 $ do
-        when (pkg == hp2ps) $ dataFile %> \mk -> do
-            includes <- interpretPartial target $ fromDiffExpr includesArgs
-            let prefix = fixKey (targetPath stage pkg) ++ "_"
+        when (package == hp2ps) $ dataFile %> \mk -> do
+            includes <- interpretInContext context $ fromDiffExpr includesArgs
+            let prefix = fixKey (targetPath stage package) ++ "_"
                 cSrcs  = [ "AreaBelow.c", "Curves.c", "Error.c", "Main.c"
                          , "Reorder.c", "TopTwenty.c", "AuxFile.c"
                          , "Deviation.c", "HpFile.c", "Marks.c", "Scale.c"
@@ -71,8 +74,8 @@ buildPackageData _ target @ (PartialTarget stage pkg) = do
             writeFileChanged mk contents
             putSuccess $ "| Successfully generated '" ++ mk ++ "'."
 
-        when (pkg == unlit) $ dataFile %> \mk -> do
-            let prefix   = fixKey (targetPath stage pkg) ++ "_"
+        when (package == unlit) $ dataFile %> \mk -> do
+            let prefix   = fixKey (targetPath stage package) ++ "_"
                 contents = unlines $ map (prefix++)
                     [ "PROGNAME = unlit"
                     , "C_SRCS = unlit.c"
@@ -80,8 +83,8 @@ buildPackageData _ target @ (PartialTarget stage pkg) = do
             writeFileChanged mk contents
             putSuccess $ "| Successfully generated '" ++ mk ++ "'."
 
-        when (pkg == touchy) $ dataFile %> \mk -> do
-            let prefix   = fixKey (targetPath stage pkg) ++ "_"
+        when (package == touchy) $ dataFile %> \mk -> do
+            let prefix   = fixKey (targetPath stage package) ++ "_"
                 contents = unlines $ map (prefix++)
                     [ "PROGNAME = touchy"
                     , "C_SRCS = touchy.c" ]
@@ -91,8 +94,8 @@ buildPackageData _ target @ (PartialTarget stage pkg) = do
         -- Bootstrapping `ghcCabal`: although `ghcCabal` is a proper cabal
         -- package, we cannot generate the corresponding `package-data.mk` file
         -- by running by running `ghcCabal`, because it has not yet been built.
-        when (pkg == ghcCabal && stage == Stage0) $ dataFile %> \mk -> do
-            let prefix   = fixKey (targetPath stage pkg) ++ "_"
+        when (package == ghcCabal && stage == Stage0) $ dataFile %> \mk -> do
+            let prefix   = fixKey (targetPath stage package) ++ "_"
                 contents = unlines $ map (prefix++)
                     [ "PROGNAME = ghc-cabal"
                     , "MODULES = Main"
@@ -101,24 +104,24 @@ buildPackageData _ target @ (PartialTarget stage pkg) = do
             writeFileChanged mk contents
             putSuccess $ "| Successfully generated '" ++ mk ++ "'."
 
-        when (pkg == rts && stage == Stage1) $ do
+        when (package == rts && stage == Stage1) $ do
             dataFile %> \mk -> do
-                orderOnly $ generatedDependencies stage pkg
+                orderOnly $ generatedDependencies stage package
                 windows <- windowsHost
-                let prefix = fixKey (targetPath stage pkg) ++ "_"
+                let prefix = fixKey (targetPath stage package) ++ "_"
                     dirs   = [ ".", "hooks", "sm", "eventlog" ]
                           ++ [ "posix" | not windows ]
                           ++ [ "win32" |     windows ]
                 -- TODO: rts/dist/build/sm/Evac_thr.c, rts/dist/build/sm/Scav_thr.c
                 -- TODO: adding cmm/S sources to C_SRCS is a hack; rethink after #18
-                cSrcs    <- getDirectoryFiles (pkgPath pkg) (map (-/- "*.c") dirs)
-                cmmSrcs  <- getDirectoryFiles (pkgPath pkg) ["*.cmm"]
+                cSrcs    <- getDirectoryFiles (pkgPath package) (map (-/- "*.c") dirs)
+                cmmSrcs  <- getDirectoryFiles (pkgPath package) ["*.cmm"]
                 buildAdjustor   <- anyTargetArch ["i386", "powerpc", "powerpc64"]
                 buildStgCRunAsm <- anyTargetArch ["powerpc64le"]
                 let sSrcs = [ "AdjustorAsm.S" | buildAdjustor   ]
                          ++ [ "StgCRunAsm.S"  | buildStgCRunAsm ]
                     extraSrcs = [ rtsBuildPath -/- "AutoApply.cmm" ]
-                includes <- interpretPartial target $ fromDiffExpr includesArgs
+                includes <- interpretInContext context $ fromDiffExpr includesArgs
                 let contents = unlines $ map (prefix++)
                         [ "C_SRCS = "
                           ++ unwords (cSrcs ++ cmmSrcs ++ sSrcs ++ extraSrcs)
@@ -137,16 +140,16 @@ buildPackageData _ target @ (PartialTarget stage pkg) = do
 -- 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 pkg file = fixFile file fixPackageData
+postProcessPackageData stage package file = fixFile file fixPackageData
   where
     fixPackageData = unlines . map processLine . filter (not . null) . filter ('$' `notElem`) . lines
     processLine line = fixKey fixedPrefix ++ suffix
       where
         (prefix, suffix) = break (== '=') line
-        -- Change pkg/path/targetDir to takeDirectory file
+        -- 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 pkg -/- targetDirectory stage pkg)
+        len         = length (pkgPath package -/- targetDirectory stage package)
 
 -- TODO: remove, see #113
 fixKey :: String -> String

src/Rules/Dependencies.hs

+{-# LANGUAGE RecordWildCards #-}
 module Rules.Dependencies (buildPackageDependencies) where
 
+import Development.Shake.Util (parseMakefile)
+
 import Base
+import Context
 import Expression
 import Oracles.PackageData
 import Rules.Actions
 import Rules.Resources
 import Settings
-import Development.Shake.Util (parseMakefile)
+import Target
 
 -- TODO: simplify handling of AutoApply.cmm
-buildPackageDependencies :: Resources -> PartialTarget -> Rules ()
-buildPackageDependencies rs target @ (PartialTarget stage pkg) =
-    let path      = targetPath stage pkg
+buildPackageDependencies :: Resources -> Context -> Rules ()
+buildPackageDependencies rs context @ (Context {..}) =
+    let path      = targetPath stage package
         buildPath = path -/- "build"
-        dropBuild = (pkgPath pkg ++) . drop (length buildPath)
+        dropBuild = (pkgPath package ++) . drop (length buildPath)
         hDepFile  = buildPath -/- ".hs-dependencies"
     in do
         fmap (buildPath++)
@@ -22,15 +26,15 @@ buildPackageDependencies rs target @ (PartialTarget stage pkg) =
                               then dropExtension out
                               else dropBuild . dropExtension $ out
                 need [srcFile]
-                build $ fullTarget target (GccM stage) [srcFile] [out]
+                build $ Target context (GccM stage) [srcFile] [out]
 
         hDepFile %> \out -> do
-            srcs <- interpretPartial target getPackageSources
+            srcs <- interpretInContext context getPackageSources
             need srcs
             if srcs == []
             then writeFileChanged out ""
             else buildWithResources [(resPackageDb rs, 1)] $
-                fullTarget target (GhcM stage) srcs [out]
+                Target context (GhcM stage) srcs [out]
             removeFileIfExists $ out <.> "bak"
 
         -- TODO: don't accumulate *.deps into .dependencies

src/Rules/Documentation.hs

+{-# LANGUAGE RecordWildCards #-}
 module Rules.Documentation (buildPackageDocumentation) where
 
 import Base
+import Context
 import Expression
 import GHC
 import Oracles.PackageData
 import Rules.Actions
 import Rules.Resources
 import Settings
+import Target
 
 haddockHtmlLib :: FilePath
 haddockHtmlLib = "inplace/lib/html/haddock-util.js"
@@ -14,14 +17,14 @@ haddockHtmlLib = "inplace/lib/html/haddock-util.js"
 -- Note: this build rule creates plenty of files, not just the .haddock one.
 -- All of them go into the 'doc' subdirectory. Pedantically tracking all built
 -- files in the Shake databases seems fragile and unnecesarry.
-buildPackageDocumentation :: Resources -> PartialTarget -> Rules ()
-buildPackageDocumentation _ target @ (PartialTarget stage pkg) =
-    let cabalFile   = pkgCabalFile pkg
-        haddockFile = pkgHaddockFile pkg
+buildPackageDocumentation :: Resources -> Context -> Rules ()
+buildPackageDocumentation _ context @ (Context {..}) =
+    let cabalFile   = pkgCabalFile package
+        haddockFile = pkgHaddockFile package
     in when (stage == Stage1) $ do
         haddockFile %> \file -> do
-            srcs <- interpretPartial target getPackageSources
-            deps <- map PackageName <$> interpretPartial target (getPkgDataList DepNames)
+            srcs <- interpretInContext context getPackageSources
+            deps <- map PackageName <$> interpretInContext context (getPkgDataList DepNames)
             let haddocks = [ pkgHaddockFile depPkg
                            | Just depPkg <- map findKnownPackage deps
                            , depPkg /= rts ]
@@ -30,15 +33,15 @@ buildPackageDocumentation _ target @ (PartialTarget stage pkg) =
             -- HsColour sources
             -- TODO: what is the output of GhcCabalHsColour?
             whenM (specified HsColour) $ do
-                pkgConf <- pkgConfFile stage pkg
+                pkgConf <- pkgConfFile stage package
                 need [ cabalFile, pkgConf ] -- TODO: check if need pkgConf
-                build $ fullTarget target GhcCabalHsColour [cabalFile] []
+                build $ Target context GhcCabalHsColour [cabalFile] []
 
             -- Build Haddock documentation
             let haddockWay = if dynamicGhcPrograms then dynamic else vanilla
-            build $ fullTargetWithWay target Haddock haddockWay srcs [file]
+            build $ Target (context {way = haddockWay}) Haddock srcs [file]
 
-        when (pkg == haddock) $ haddockHtmlLib %> \_ -> do
+        when (package == haddock) $ haddockHtmlLib %> \_ -> do
             let dir = takeDirectory haddockHtmlLib
             liftIO $ removeFiles dir ["//*"]
             copyDirectory "utils/haddock/haddock-api/resources/html" dir

src/Rules/Generate.hs

@@ -6,6 +6,7 @@ module Rules.Generate (
 import qualified System.Directory as IO
 
 import Base
+import Context hiding (stage)
 import Expression
 import GHC
 import Rules.Generators.ConfigHs
@@ -21,6 +22,7 @@ import Rules.Gmp
 import Rules.Libffi
 import Rules.Resources (Resources)
 import Settings
+import Target hiding (builder, context)
 
 installTargets :: [FilePath]
 installTargets = [ "inplace/lib/ghc-usage.txt"
@@ -106,18 +108,18 @@ determineBuilder file = fmap fst $ find (\(_, e) -> e == ext) knownGenerators
   where
     ext = takeExtension file
 
-generate :: FilePath -> PartialTarget -> Expr String -> Action ()
-generate file target expr = do
-    contents <- interpretPartial target expr
+generate :: FilePath -> Context -> Expr String -> Action ()
+generate file context expr = do
+    contents <- interpretInContext context expr
     writeFileChanged file contents
     putSuccess $ "| Successfully generated '" ++ file ++ "'."
 
-generatePackageCode :: Resources -> PartialTarget -> Rules ()
-generatePackageCode _ target @ (PartialTarget stage pkg) =
+generatePackageCode :: Resources -> Context -> Rules ()
+generatePackageCode _ context @ (Context stage pkg _) =
     let buildPath   = targetPath stage pkg -/- "build"
         dropBuild   = drop (length buildPath + 1)
         generated f = (buildPath ++ "//*.hs") ?== f && not ("//autogen/*" ?== f)
-        file <~ gen = generate file target gen
+        file <~ gen = generate file context gen
     in do
         generated ?> \file -> do