diff options
| -rw-r--r-- | hadrian/hadrian.cabal | 1 | ||||
| -rw-r--r-- | hadrian/src/Context.hs | 8 | ||||
| -rw-r--r-- | hadrian/src/Rules/Library.hs | 83 | ||||
| -rw-r--r-- | hadrian/src/Rules/Register.hs | 2 | ||||
| -rw-r--r-- | hadrian/src/Settings/Builders/Haddock.hs | 2 |
5 files changed, 92 insertions, 4 deletions
diff --git a/hadrian/hadrian.cabal b/hadrian/hadrian.cabal index c37974914a..6e277094e5 100644 --- a/hadrian/hadrian.cabal +++ b/hadrian/hadrian.cabal @@ -154,6 +154,7 @@ executable hadrian , directory >= 1.3.1.0 && < 1.4 , extra >= 1.4.7 , filepath + , time , mtl == 2.2.* , parsec >= 3.1 && < 3.2 , shake >= 0.18.3 && < 0.20 diff --git a/hadrian/src/Context.hs b/hadrian/src/Context.hs index eb9d7caf81..2b8f1948c3 100644 --- a/hadrian/src/Context.hs +++ b/hadrian/src/Context.hs @@ -9,7 +9,7 @@ module Context ( contextDir, buildPath, buildDir, pkgInplaceConfig, pkgSetupConfigFile, pkgHaddockFile, pkgRegisteredLibraryFile, pkgRegisteredLibraryFileName, pkgLibraryFile, pkgGhciLibraryFile, - pkgConfFile, objectPath, contextPath, getContextPath, libPath, distDir, + pkgConfFile, pkgStampFile, objectPath, contextPath, getContextPath, libPath, distDir, haddockStatsFilesDir ) where @@ -132,6 +132,12 @@ pkgConfFile Context {..} = do dbPath <- packageDbPath stage return $ dbPath -/- pid <.> "conf" +pkgStampFile :: Context -> Action FilePath +pkgStampFile c@Context{..} = do + let extension = waySuffix way + pkgFile c "stamp-" extension + + -- | Given a 'Context' and a 'FilePath' to a source file, compute the 'FilePath' -- to its object file. For example: -- * "Task.c" -> "_build/stage1/rts/Task.thr_o" diff --git a/hadrian/src/Rules/Library.hs b/hadrian/src/Rules/Library.hs index bb502f9875..46747f9d35 100644 --- a/hadrian/src/Rules/Library.hs +++ b/hadrian/src/Rules/Library.hs @@ -15,6 +15,11 @@ import Rules.Register import Settings import Target import Utilities +import Data.Time.Clock +import Rules.Generate (generatedDependencies) +import Hadrian.Oracles.Cabal (readPackageData) +import Oracles.Flag + -- * Library 'Rules' @@ -25,6 +30,7 @@ libraryRules = do root -/- "**/libHS*-*.so" %> buildDynamicLib root "so" root -/- "**/libHS*-*.dll" %> buildDynamicLib root "dll" root -/- "**/*.a" %> buildStaticLib root + root -/- "**/stamp-*" %> buildPackage root priority 2 $ do root -/- "stage*/lib/**/libHS*-*.dylib" %> registerDynamicLib root "dylib" root -/- "stage*/lib/**/libHS*-*.so" %> registerDynamicLib root "so" @@ -105,6 +111,60 @@ buildGhciLibO root ghcilibPath = do need objs build $ target context (MergeObjects stage) objs [ghcilibPath] + +{- +Note [Stamp Files] +~~~~~~~~~~~~~~~~~~ + +A package stamp file exists to communicate that all the objects for a certain +package are built. + +If you need a stamp file, then it needs all the library dependencies + +The format for a stamp file is defined in `pkgStampFile`. The stamp file is named +"stamp-<way>" so if you want to build base in dynamic way then need `_build/stage1/libraries/base/stamp-dyn` + +By using stamp files you can easily say you want to build a library in a certain +way by needing the stamp file for that context. + +Before these stamp files existed the way to declare that all objects in a certain way +were build was by needing the .conf file for the package. Stamp files decouple this +decision from creating the .conf file which does extra stuff such as linking, copying +files etc. + +-} + + +buildPackage :: FilePath -> FilePath -> Action () +buildPackage root fp = do + l@(BuildPath _ stage _ (PkgStamp _ _ way)) <- parsePath (parseStampPath root) "<.stamp parser>" fp + let ctx = stampContext l + srcs <- hsSources ctx + gens <- interpretInContext ctx generatedDependencies + + depPkgs <- packageDependencies <$> readPackageData (package ctx) + -- Stage packages are those we have in this stage. + stagePkgs <- stagePackages stage + -- We'll need those packages in our package database. + deps <- sequence [ pkgConfFile (ctx { package = pkg }) + | pkg <- depPkgs, pkg `elem` stagePkgs ] + need deps + need (srcs ++ gens) + + need =<< libraryTargets True ctx + time <- liftIO $ getCurrentTime + liftIO $ writeFile fp (show time) + ways <- interpretInContext ctx getLibraryWays + let hasVanilla = elem vanilla ways + hasDynamic = elem dynamic ways + support <- platformSupportsSharedLibs + when ((hasVanilla && hasDynamic) && + support && way == vanilla) $ do + stamp <- (pkgStampFile (ctx { way = dynamic })) + liftIO $ writeFile stamp (show time) + + + -- * Helpers -- | Return all Haskell and non-Haskell object files for the given 'Context'. @@ -199,6 +259,22 @@ libDynContext (BuildPath _ stage pkgpath (LibDyn pkgname _ way _)) = where pkg = library pkgname pkgpath +-- | Get the 'Context' corresponding to the build path for a given static library. +stampContext :: BuildPath PkgStamp -> Context +stampContext (BuildPath _ stage _ (PkgStamp pkgname _ way)) = + Context stage pkg way + where + pkg = unsafeFindPackageByName pkgname + +data PkgStamp = PkgStamp String [Integer] Way deriving (Eq, Show) + + +-- | Parse a path to a ghci library to be built, making sure the path starts +-- with the given build root. +parseStampPath :: FilePath -> Parsec.Parsec String () (BuildPath PkgStamp) +parseStampPath root = parseBuildPath root parseStamp + + -- | Parse a path to a registered ghc-pkg static library to be built, making -- sure the path starts with the given build root. parseGhcPkgLibA :: FilePath -> Parsec.Parsec String () (GhcPkgPath LibA) @@ -262,6 +338,13 @@ parseLibDynFilename ext = do _ <- Parsec.string ("." ++ ext) return (LibDyn pkgname pkgver way $ if ext == "so" then So else Dylib) +parseStamp :: Parsec.Parsec String () PkgStamp +parseStamp = do + _ <- Parsec.string "stamp-" + (pkgname, pkgver) <- parsePkgId + way <- parseWaySuffix vanilla + return (PkgStamp pkgname pkgver way) + -- | Get the package identifier given the package name and version. pkgId :: String -> [Integer] -> String pkgId name version = name ++ "-" ++ intercalate "." (map show version) diff --git a/hadrian/src/Rules/Register.hs b/hadrian/src/Rules/Register.hs index 64b32283cb..dcd05e240c 100644 --- a/hadrian/src/Rules/Register.hs +++ b/hadrian/src/Rules/Register.hs @@ -124,7 +124,7 @@ buildConf _ context@Context {..} _conf = do need =<< mapM (\pkgId -> packageDbPath stage <&> (-/- pkgId <.> "conf")) depPkgIds ways <- interpretInContext context (getLibraryWays <> if package == rts then getRtsWays else mempty) - need =<< concatMapM (libraryTargets True) [ context { way = w } | w <- Set.toList ways ] + need =<< mapM pkgStampFile [ context { way = w } | w <- Set.toList ways ] -- We might need some package-db resource to limit read/write, see packageRules. path <- buildPath context diff --git a/hadrian/src/Settings/Builders/Haddock.hs b/hadrian/src/Settings/Builders/Haddock.hs index 38c786de43..9ecdabfec7 100644 --- a/hadrian/src/Settings/Builders/Haddock.hs +++ b/hadrian/src/Settings/Builders/Haddock.hs @@ -9,8 +9,6 @@ import Packages import Rules.Documentation import Settings.Builders.Common import Settings.Builders.Ghc -import Utilities -import Context.Type as C import CommandLine import qualified Data.Text as T |