Add support for runtime dependencies
authorAndrey Mokhov <andrey.mokhov@gmail.com>
Fri, 9 Feb 2018 01:32:55 +0000 (01:32 +0000)
committerAndrey Mokhov <andrey.mokhov@gmail.com>
Fri, 9 Feb 2018 01:32:55 +0000 (01:32 +0000)
src/Base.hs
src/Builder.hs
src/GHC.hs
src/Hadrian/Builder.hs
src/Rules/Documentation.hs
src/Rules/Install.hs
src/Rules/Test.hs
src/Settings/Builders/Ghc.hs

index 38c8792..6bfa460 100644 (file)
@@ -21,8 +21,9 @@ module Base (
     -- * Paths
     hadrianPath, configPath, configFile, sourcePath, configH, shakeFilesDir,
     generatedDir, inplaceBinPath, inplaceLibBinPath, inplaceLibPath,
-    inplaceLibCopyTargets, templateHscPath, stage0PackageDbDir,
-    inplacePackageDbPath, packageDbPath, packageDbStamp
+    inplaceLibCopyTargets, haddockHtmlResourcesStamp, templateHscPath,
+    stage0PackageDbDir, inplacePackageDbPath, packageDbPath, packageDbStamp,
+    ghcSplitPath
     ) where
 
 import Control.Applicative
@@ -101,11 +102,12 @@ inplaceLibPath = "inplace/lib"
 
 -- | Directory for binary wrappers, and auxiliary binaries such as @touchy@.
 inplaceLibBinPath :: FilePath
-inplaceLibBinPath = "inplace/lib/bin"
+inplaceLibBinPath = inplaceLibPath -/- "bin"
 
 -- ref: ghc/ghc.mk:142
 -- ref: driver/ghc.mk
 -- ref: utils/hsc2hs/ghc.mk:35
+-- TODO: Derive this from Builder.runtimeDependencies
 -- | Files that need to be copied over to 'inplaceLibPath'.
 inplaceLibCopyTargets :: [FilePath]
 inplaceLibCopyTargets = map (inplaceLibPath -/-)
@@ -116,6 +118,18 @@ inplaceLibCopyTargets = map (inplaceLibPath -/-)
     , "settings"
     , "template-hsc.h" ]
 
--- | Path to hsc2hs template.
+-- TODO: This is fragile and will break if @README.md@ is removed. We need to
+-- improve the story of program runtime dependencies on directories.
+-- See: https://github.com/snowleopard/hadrian/issues/492.
+-- | Path to a file in Haddock's HTML resource library.
+haddockHtmlResourcesStamp :: FilePath
+haddockHtmlResourcesStamp = inplaceLibPath -/- "html/README.md"
+
+-- | Path to 'hsc2hs' template.
 templateHscPath :: FilePath
-templateHscPath = "inplace/lib/template-hsc.h"
+templateHscPath = inplaceLibPath -/- "template-hsc.h"
+
+-- | @ghc-split@ is a Perl script used by GHC when run with @-split-objs@ flag.
+-- It is generated in "Rules.Generate".
+ghcSplitPath :: FilePath
+ghcSplitPath = inplaceLibBinPath -/- "ghc-split"
index 4adeeef..ae967ab 100644 (file)
@@ -137,14 +137,26 @@ instance H.Builder Builder where
         Nothing      -> systemBuilderPath builder
         Just context -> programPath context
 
-    needBuilder :: Builder -> Action ()
-    needBuilder builder = do
-        path <- H.builderPath builder
-        case builder of
-            Configure dir -> need [dir -/- "configure"]
-            Hsc2Hs        -> need [path, templateHscPath]
-            Make dir      -> need [dir -/- "Makefile"]
-            _             -> when (isJust $ builderProvenance builder) $ need [path]
+    runtimeDependencies :: Builder -> Action [FilePath]
+    runtimeDependencies = \case
+        Configure dir -> return [dir -/- "configure"]
+
+        Ghc _ Stage0 -> return []
+        Ghc _ _ -> do
+            win <- windowsHost
+            touchyPath <- programPath (vanillaContext Stage0 touchy)
+            return $ [ inplaceLibPath -/- "ghc-usage.txt"
+                     , inplaceLibPath -/- "ghci-usage.txt"
+                     , inplaceLibPath -/- "llvm-targets"
+                     , inplaceLibPath -/- "platformConstants"
+                     , inplaceLibPath -/- "settings"
+                     , ghcSplitPath ] -- TODO: Make conditional on --split-objects
+                  ++ [ touchyPath | win ]
+
+        Haddock _ -> return [haddockHtmlResourcesStamp]
+        Hsc2Hs    -> return [templateHscPath]
+        Make dir  -> return [dir -/- "Makefile"]
+        _         -> return []
 
     runBuilderWith :: Builder -> BuildInfo -> Action ()
     runBuilderWith builder BuildInfo {..} = do
@@ -243,7 +255,13 @@ systemBuilderPath builder = case builder of
             unless (isOptional builder) . error $ "Non optional builder "
                 ++ quote key ++ " is not specified" ++ inCfg
             return "" -- TODO: Use a safe interface.
-        else fixAbsolutePathOnWindows =<< lookupInPath path
+        else do
+            win <- windowsHost
+            fullPath <- lookupInPath path
+            case (win, hasExtension fullPath) of
+                (False, _    ) -> return fullPath
+                (True , True ) -> fixAbsolutePathOnWindows fullPath
+                (True , False) -> fixAbsolutePathOnWindows fullPath <&> (<.> exe)
 
 -- | Was the path to a given system 'Builder' specified in configuration files?
 isSpecified :: Builder -> Action Bool
index baae940..771d37e 100644 (file)
@@ -14,7 +14,7 @@ module GHC (
     programName, nonCabalContext, nonHsMainPackage, autogenPath, installStage,
 
     -- * Miscellaneous
-    programPath, ghcSplitPath, stripCmdPath, buildDll0
+    programPath, buildDll0
     ) where
 
 import Base
@@ -265,24 +265,6 @@ autogenPath context@Context {..}
   where
     autogen dir = buildPath context <&> (-/- dir -/- "autogen")
 
--- | @ghc-split@ is a Perl script used by GHC with @-split-objs@ flag. It is
--- generated in "Rules.Generators.GhcSplit".
-ghcSplitPath :: FilePath
-ghcSplitPath = inplaceLibBinPath -/- "ghc-split"
-
--- ref: mk/config.mk
--- | Command line tool for stripping.
-stripCmdPath :: Action FilePath
-stripCmdPath = do
-    targetPlatform <- setting TargetPlatform
-    top <- topDirectory
-    case targetPlatform of
-        "x86_64-unknown-mingw32" ->
-             return (top -/- "inplace/mingw/bin/strip.exe")
-        "arm-unknown-linux" ->
-             return ":" -- HACK: from the make-based system, see the ref above
-        _ -> return "strip"
-
 buildDll0 :: Context -> Action Bool
 buildDll0 Context {..} = do
     windows <- windowsHost
index 4de658e..38810c7 100644 (file)
@@ -12,9 +12,9 @@
 -- functions that can be used to invoke builders.
 -----------------------------------------------------------------------------
 module Hadrian.Builder (
-    Builder (..), BuildInfo (..), runBuilder, runBuilderWithCmdOptions,
-    build, buildWithResources, buildWithCmdOptions, getBuilderPath,
-    builderEnvironment
+    Builder (..), BuildInfo (..), needBuilder, runBuilder,
+    runBuilderWithCmdOptions, build, buildWithResources, buildWithCmdOptions,
+    getBuilderPath, builderEnvironment
     ) where
 
 import Data.List
@@ -42,11 +42,10 @@ class ShakeValue b => Builder b where
     -- | The path to a builder.
     builderPath :: b -> Action FilePath
 
-    -- | Make sure a builder exists and rebuild it if out of date.
-    needBuilder :: b -> Action ()
-    needBuilder builder = do
-        path <- builderPath builder
-        need [path]
+    -- | Runtime dependencies of a builder. For example, on Windows GHC requires
+    -- the utility @touchy.exe@ to be avilable on a specific path.
+    runtimeDependencies :: b -> Action [FilePath]
+    runtimeDependencies _ = return []
 
     -- | Run a builder with a given 'BuildInfo'. Also see 'runBuilder'.
     runBuilderWith :: b -> BuildInfo -> Action ()
@@ -58,6 +57,13 @@ class ShakeValue b => Builder b where
         putBuild $ "| Run " ++ show builder ++ msg
         quietly $ cmd (buildOptions buildInfo) [path] args
 
+-- | Make sure a builder and its runtime dependencies are up-to-date.
+needBuilder :: Builder b => b -> Action ()
+needBuilder builder = do
+    path <- builderPath builder
+    deps <- runtimeDependencies builder
+    need (path : deps)
+
 -- | Run a builder with a specified list of command line arguments, reading a
 -- list of input files and writing a list of output files. A lightweight version
 -- of 'runBuilderWith'.
index 3043f8b..b8570a3 100644 (file)
@@ -117,12 +117,6 @@ allHaddocks = do
     sequence [ pkgHaddockFile $ vanillaContext Stage1 pkg
              | pkg <- pkgs, isLibrary pkg, isHsPackage pkg ]
 
--- TODO: This is fragile and will break if @README.md@ is removed. We need to
--- improve the story of program runtime dependencies on directories.
--- See: https://github.com/snowleopard/hadrian/issues/492.
-haddockHtmlResourcesStamp :: FilePath
-haddockHtmlResourcesStamp = "inplace/lib/html/README.md"
-
 -- | Find the haddock files for the dependencies of the current library
 haddockDependencies :: Context -> Action [FilePath]
 haddockDependencies context = do
@@ -147,7 +141,7 @@ buildPackageDocumentation context@Context {..} = when (stage == Stage1) $ do
     "//" ++ pkgName package <.> "haddock" %> \file -> do
         haddocks <- haddockDependencies context
         srcs <- hsSources context
-        need $ srcs ++ haddocks ++ [haddockHtmlResourcesStamp]
+        need $ srcs ++ haddocks
 
         -- Build Haddock documentation
         -- TODO: pass the correct way from Rules via Context
index bcdbf33..190bc48 100644 (file)
@@ -53,7 +53,20 @@ installBinPkgs :: [Package]
 installBinPkgs = [ghc, ghcPkg, ghcSplit, hp2ps, hpc, hsc2hs, runGhc, unlit]
 
 getLibExecDir :: Action FilePath
-getLibExecDir = (-/- "bin") <$> installGhcLibDir
+getLibExecDir = installGhcLibDir <&> (-/- "bin")
+
+-- ref: mk/config.mk
+-- | Command line tool for stripping.
+stripCmdPath :: Action FilePath
+stripCmdPath = do
+    targetPlatform <- setting TargetPlatform
+    top <- topDirectory
+    case targetPlatform of
+        "x86_64-unknown-mingw32" ->
+             return (top -/- "inplace/mingw/bin/strip.exe")
+        "arm-unknown-linux" ->
+             return ":" -- HACK: from the make-based system, see the ref above
+        _ -> return "strip"
 
 -- ref: ghc.mk
 -- | Install executable scripts to @prefix/lib/bin@.
index 0f28106..0fedd70 100644 (file)
@@ -33,14 +33,13 @@ testRules = do
         makeExecutable (root -/- timeoutProgPath)
 
     "validate" ~> do
-        need inplaceLibCopyTargets
         needBuilder $ Ghc CompileHs Stage2
         needBuilder $ GhcPkg Update Stage1
         needBuilder Hpc
-        -- TODO: Figure out why @needBuilder Hsc2Hs@ doesn't work.
+        needBuilder Hsc2Hs
         -- TODO: Eliminate explicit filepaths.
         -- See https://github.com/snowleopard/hadrian/issues/376.
-        need ["inplace/bin/hp2ps", "inplace/bin/hsc2hs"]
+        need ["inplace/bin/hp2ps"]
         build $ target (vanillaContext Stage2 compiler) (Make "testsuite/tests") [] []
 
     "test" ~> do
index af78b74..3fba00d 100644 (file)
@@ -12,21 +12,15 @@ ghcBuilderArgs = mconcat [compileAndLinkHs, compileC, findHsDependencies]
 
 compileAndLinkHs :: Args
 compileAndLinkHs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do
-    needTouchy
     mconcat [ arg "-Wall"
             , commonGhcArgs
-            , splitObjectsArgs
+            , splitObjects <$> flavour ? arg "-split-objs"
             , ghcLinkArgs
             , defaultGhcWarningsArgs
             , builder (Ghc CompileHs) ? arg "-c"
             , getInputs
             , arg "-o", arg =<< getOutput ]
 
-needTouchy :: Expr ()
-needTouchy = notStage0 ? windowsHost ? do
-    touchyPath <- expr $ programPath (vanillaContext Stage0 touchy)
-    expr $ need [touchyPath]
-
 compileC :: Args
 compileC = builder (Ghc CompileCWithGhc) ? do
     way <- getWay
@@ -66,11 +60,6 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do
             , pure [ "-optl-l" ++           lib | lib <- libs ++ gmpLibs ]
             , pure [ "-optl-L" ++ unifyPath dir | dir <- libDirs ] ]
 
-splitObjectsArgs :: Args
-splitObjectsArgs = splitObjects <$> flavour ? do
-    expr $ need [ghcSplitPath]
-    arg "-split-objs"
-
 findHsDependencies :: Args
 findHsDependencies = builder (Ghc FindHsDependencies) ? do
     ways <- getLibraryWays