Unverified Commit 0106f203 authored by Andrey Mokhov's avatar Andrey Mokhov Committed by GitHub

Reorganise GHC packages, get rid of Builder import cycle (#662)

* Reorganise GHC and GHC.Packages modules to get rid of import cycles
* Move "GHC.Packages" to "Packages", merge "GHC" into "Settings.Default"
parent 0059b9f2
...@@ -28,8 +28,6 @@ executable hadrian ...@@ -28,8 +28,6 @@ executable hadrian
, Expression , Expression
, Expression.Type , Expression.Type
, Flavour , Flavour
, GHC
, GHC.Packages
, Hadrian.Builder , Hadrian.Builder
, Hadrian.Builder.Ar , Hadrian.Builder.Ar
, Hadrian.Builder.Sphinx , Hadrian.Builder.Sphinx
...@@ -53,6 +51,7 @@ executable hadrian ...@@ -53,6 +51,7 @@ executable hadrian
, Oracles.Setting , Oracles.Setting
, Oracles.ModuleFiles , Oracles.ModuleFiles
, Oracles.TestSettings , Oracles.TestSettings
, Packages
, Rules , Rules
, Rules.BinaryDist , Rules.BinaryDist
, Rules.Clean , Rules.Clean
......
...@@ -27,9 +27,9 @@ import Hadrian.Utilities ...@@ -27,9 +27,9 @@ import Hadrian.Utilities
import Base import Base
import Context import Context
import GHC
import Oracles.Flag import Oracles.Flag
import Oracles.Setting import Oracles.Setting
import Packages
-- | C compiler can be used in two different modes: -- | C compiler can be used in two different modes:
-- * Compile or preprocess a source file. -- * Compile or preprocess a source file.
......
module Builder where
import Stage
import Hadrian.Builder.Ar
import Hadrian.Builder.Sphinx
import Hadrian.Builder.Tar
data CcMode = CompileC | FindCDependencies
data GhcMode = CompileHs | CompileCWithGhc | FindHsDependencies | LinkHs
data ConfigurationInfo = Setup | Flags
data GhcPkgMode = Init | Update | Copy | Unregister | Dependencies
data HaddockMode = BuildPackage | BuildIndex
data Builder = Alex
| Ar ArMode Stage
| Autoreconf FilePath
| DeriveConstants
| Cabal ConfigurationInfo Stage
| Cc CcMode Stage
| Configure FilePath
| GenApply
| GenPrimopCode
| Ghc GhcMode Stage
| GhcPkg GhcPkgMode Stage
| Haddock HaddockMode
| Happy
| Hpc
| Hp2Ps
| HsCpp
| Hsc2Hs Stage
| Ld Stage
| Make FilePath
| Nm
| Objdump
| Patch
| Perl
| Python
| Ranlib
| RunTest
| Sphinx SphinxMode
| Tar TarMode
| Unlit
| Xelatex
instance Eq Builder
instance Show Builder
...@@ -23,7 +23,7 @@ module Expression ( ...@@ -23,7 +23,7 @@ module Expression (
) where ) where
import Base import Base
import {-# SOURCE #-} Builder import Builder
import Context hiding (stage, package, way) import Context hiding (stage, package, way)
import Expression.Type import Expression.Type
import Hadrian.Expression hiding (Expr, Predicate, Args) import Hadrian.Expression hiding (Expr, Predicate, Args)
......
...@@ -3,7 +3,7 @@ module Expression.Type where ...@@ -3,7 +3,7 @@ module Expression.Type where
import Context.Type import Context.Type
import Way.Type import Way.Type
import {-# SOURCE #-} Builder import Builder
import qualified Hadrian.Expression as H import qualified Hadrian.Expression as H
-- | @Expr a@ is a computation that produces a value of type @Action a@ and can -- | @Expr a@ is a computation that produces a value of type @Action a@ and can
......
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
module GHC (
-- * GHC packages
array, base, binary, bytestring, cabal, checkApiAnnotations, checkPpr,
compareSizes, compiler, containers, deepseq, deriveConstants, directory,
filepath, genapply, genprimopcode, ghc, ghcBoot, ghcBootTh, ghcCompact,
ghcHeap, ghci, ghcPkg, ghcPrim, ghcTags, ghcSplit, haddock, haskeline,
hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi,
libiserv, mtl, parsec, parallel, pretty, primitive, process, rts, runGhc,
stm, templateHaskell, terminfo, text, time, touchy, transformers, unlit,
unix, win32, xhtml, ghcPackages, isGhcPackage, defaultPackages,
testsuitePackages,
-- * Package information
programName, nonHsMainPackage, autogenPath,
-- * Miscellaneous
programPath, buildDll0, rtsContext, rtsBuildPath, libffiContext,
libffiBuildPath, libffiLibraryName
) where
import Base
import Context
import Flavour
import GHC.Packages
import Oracles.Flag
import Oracles.Setting
import Settings (flavour)
-- | Packages that are built by default. You can change this in "UserSettings".
defaultPackages :: Stage -> Action [Package]
defaultPackages Stage0 = stage0Packages
defaultPackages Stage1 = stage1Packages
defaultPackages Stage2 = stage2Packages
defaultPackages Stage3 = return []
stage0Packages :: Action [Package]
stage0Packages = do
win <- windowsHost
cross <- flag CrossCompiling
return $ [ binary
, cabal
, compareSizes
, compiler
, deriveConstants
, genapply
, genprimopcode
, ghc
, ghcBoot
, ghcBootTh
, ghcHeap
, ghci
, ghcPkg
, hsc2hs
, hpc
, mtl
, parsec
, templateHaskell
, text
, transformers
, unlit ]
++ [ terminfo | not win, not cross ]
++ [ touchy | win ]
stage1Packages :: Action [Package]
stage1Packages = do
win <- windowsHost
intLib <- integerLibrary =<< flavour
libraries0 <- filter isLibrary <$> stage0Packages
cross <- flag CrossCompiling
return $ libraries0 -- Build all Stage0 libraries in Stage1
++ [ array
, base
, bytestring
, containers
, deepseq
, directory
, filepath
, ghc
, ghcCompact
, ghcPkg
, ghcPrim
, haskeline
, hsc2hs
, intLib
, pretty
, process
, rts
, stm
, time
, unlit
, xhtml ]
++ [ hpcBin | not cross ]
++ [ iserv | not win, not cross ]
++ [ libiserv | not win, not cross ]
++ [ runGhc | not cross ]
++ [ touchy | win ]
++ [ unix | not win ]
++ [ win32 | win ]
stage2Packages :: Action [Package]
stage2Packages = do
cross <- flag CrossCompiling
return $ [ ghcTags ]
++ [ haddock | not cross ]
-- | Packages that are built only for the testsuite.
testsuitePackages :: Action [Package]
testsuitePackages = do
win <- windowsHost
return $ [ checkApiAnnotations
, checkPpr
, ghci
, ghcPkg
, hp2ps
, iserv
, parallel
, runGhc ] ++
[ timeout | win ]
-- | Given a 'Context', compute the name of the program that is built in it
-- assuming that the corresponding package's type is 'Program'. For example, GHC
-- built in 'Stage0' is called @ghc-stage1@. If the given package is a
-- 'Library', the function simply returns its name.
programName :: Context -> Action String
programName Context {..} = do
cross <- flag CrossCompiling
targetPlatform <- setting TargetPlatformFull
let prefix = if cross then targetPlatform ++ "-" else ""
in return $ prefix ++ case package of
p | p == ghc -> "ghc"
| p == hpcBin -> "hpc"
| p == runGhc -> "runhaskell"
| p == iserv -> "ghc-iserv"
_ -> pkgName package
-- | The 'FilePath' to a program executable in a given 'Context'.
programPath :: Context -> Action FilePath
programPath context@Context {..} = do
-- The @touchy@ utility lives in the @lib/bin@ directory instead of @bin@,
-- which is likely just a historical accident that will hopefully be fixed.
-- See: https://github.com/snowleopard/hadrian/issues/570
-- Likewise for 'unlit'.
path <- if package `elem` [touchy, unlit]
then stageLibPath stage <&> (-/- "bin")
else stageBinPath stage
pgm <- programName context
return $ path -/- pgm <.> exe
-- | Some program packages should not be linked with Haskell main function.
nonHsMainPackage :: Package -> Bool
nonHsMainPackage = (`elem` [ghc, hp2ps, iserv, touchy, unlit])
-- | Path to the @autogen@ directory generated when configuring a package.
autogenPath :: Context -> Action FilePath
autogenPath context@Context {..}
| isLibrary package = autogen "build"
| package == ghc = autogen "build/ghc"
| package == hpcBin = autogen "build/hpc"
| otherwise = autogen $ "build" -/- pkgName package
where
autogen dir = contextPath context <&> (-/- dir -/- "autogen")
buildDll0 :: Context -> Action Bool
buildDll0 Context {..} = do
windows <- windowsHost
return $ windows && stage == Stage1 && package == compiler
-- | RTS is considered a Stage1 package. This determines RTS build directory.
rtsContext :: Context
rtsContext = vanillaContext Stage1 rts
-- | Path to the RTS build directory.
rtsBuildPath :: Action FilePath
rtsBuildPath = buildPath rtsContext
-- | Libffi is considered a Stage1 package. This determines its build directory.
libffiContext :: Context
libffiContext = vanillaContext Stage1 libffi
-- | Build directory for in-tree Libffi library.
libffiBuildPath :: Action FilePath
libffiBuildPath = buildPath libffiContext
libffiLibraryName :: Action FilePath
libffiLibraryName = do
useSystemFfi <- flag UseSystemFfi
windows <- windowsHost
return $ case (useSystemFfi, windows) of
(True , False) -> "ffi"
(False, False) -> "Cffi"
(_ , True ) -> "Cffi-6"
...@@ -37,17 +37,17 @@ import qualified Distribution.Types.LocalBuildInfo as C ...@@ -37,17 +37,17 @@ import qualified Distribution.Types.LocalBuildInfo as C
import qualified Distribution.Text as C import qualified Distribution.Text as C
import qualified Distribution.Types.MungedPackageId as C import qualified Distribution.Types.MungedPackageId as C
import qualified Distribution.Verbosity as C import qualified Distribution.Verbosity as C
import Base
import Builder
import Context
import Flavour
import GHC.Packages
import Hadrian.Expression import Hadrian.Expression
import Hadrian.Haskell.Cabal.CabalData import Hadrian.Haskell.Cabal.CabalData
import Hadrian.Haskell.Cabal.PackageData import Hadrian.Haskell.Cabal.PackageData
import Hadrian.Oracles.TextFile import Hadrian.Oracles.TextFile
import Hadrian.Target import Hadrian.Target
import Base
import Builder
import Context
import Flavour
import Packages
import Settings import Settings
-- | Parse the Cabal package identifier from a @.cabal@ file. -- | Parse the Cabal package identifier from a @.cabal@ file.
......
...@@ -5,12 +5,13 @@ module Oracles.ModuleFiles ( ...@@ -5,12 +5,13 @@ module Oracles.ModuleFiles (
import qualified Data.HashMap.Strict as Map import qualified Data.HashMap.Strict as Map
import Hadrian.Haskell.Cabal.PackageData as PD
import Base import Base
import Builder import Builder
import Context import Context
import Expression import Expression
import GHC import Packages
import Hadrian.Haskell.Cabal.PackageData as PD
newtype ModuleFiles = ModuleFiles (Stage, Package) newtype ModuleFiles = ModuleFiles (Stage, Package)
deriving (Binary, Eq, Hashable, NFData, Show, Typeable) deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
......
{-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
module GHC.Packages where module Packages (
-- * GHC packages
array, base, binary, bytestring, cabal, checkApiAnnotations, checkPpr,
compareSizes, compiler, containers, deepseq, deriveConstants, directory,
filepath, genapply, genprimopcode, ghc, ghcBoot, ghcBootTh, ghcCompact,
ghcHeap, ghci, ghcPkg, ghcPrim, ghcTags, ghcSplit, haddock, haskeline,
hsc2hs, hp2ps, hpc, hpcBin, integerGmp, integerSimple, iserv, libffi,
libiserv, mtl, parsec, parallel, pretty, primitive, process, rts, runGhc,
stm, templateHaskell, terminfo, text, time, timeout, touchy, transformers,
unlit, unix, win32, xhtml, ghcPackages, isGhcPackage,
-- * Package information
programName, nonHsMainPackage, autogenPath, programPath, timeoutPath,
buildDll0, rtsContext, rtsBuildPath, libffiContext, libffiBuildPath,
libffiLibraryName
) where
import Hadrian.Package import Hadrian.Package
import Hadrian.Utilities import Hadrian.Utilities
import Base
import Context
import Oracles.Flag
import Oracles.Setting
-- | These are all GHC packages we know about. Build rules will be generated for -- | These are all GHC packages we know about. Build rules will be generated for
-- all of them. However, not all of these packages will be built. For example, -- all of them. However, not all of these packages will be built. For example,
-- package 'win32' is built only on Windows. 'defaultPackages' defines default -- package 'win32' is built only on Windows. @GHC.defaultPackages@ defines
-- conditions for building each package. Users can add their own packages and -- default conditions for building each package. Users can add their own
-- modify build default build conditions in "UserSettings". -- packages and modify build default build conditions in "UserSettings".
ghcPackages :: [Package] ghcPackages :: [Package]
ghcPackages = ghcPackages =
[ array, base, binary, bytestring, cabal, checkPpr, checkApiAnnotations [ array, base, binary, bytestring, cabal, checkPpr, checkApiAnnotations
...@@ -75,13 +95,13 @@ templateHaskell = hsLib "template-haskell" ...@@ -75,13 +95,13 @@ templateHaskell = hsLib "template-haskell"
terminfo = hsLib "terminfo" terminfo = hsLib "terminfo"
text = hsLib "text" text = hsLib "text"
time = hsLib "time" time = hsLib "time"
timeout = hsUtil "timeout" `setPath` "testsuite/timeout"
touchy = hsUtil "touchy" touchy = hsUtil "touchy"
transformers = hsLib "transformers" transformers = hsLib "transformers"
unlit = hsUtil "unlit" unlit = hsUtil "unlit"
unix = hsLib "unix" unix = hsLib "unix"
win32 = hsLib "Win32" win32 = hsLib "Win32"
xhtml = hsLib "xhtml" xhtml = hsLib "xhtml"
timeout = hsUtil "timeout" `setPath` "testsuite/timeout"
-- | Construct a Haskell library package, e.g. @array@. -- | Construct a Haskell library package, e.g. @array@.
hsLib :: PackageName -> Package hsLib :: PackageName -> Package
...@@ -106,3 +126,85 @@ hsUtil name = hsProgram name ("utils" -/- name) ...@@ -106,3 +126,85 @@ hsUtil name = hsProgram name ("utils" -/- name)
-- | Amend a package path if it doesn't conform to a typical pattern. -- | Amend a package path if it doesn't conform to a typical pattern.
setPath :: Package -> FilePath -> Package setPath :: Package -> FilePath -> Package
setPath pkg path = pkg { pkgPath = path } setPath pkg path = pkg { pkgPath = path }
-- | Given a 'Context', compute the name of the program that is built in it
-- assuming that the corresponding package's type is 'Program'. For example, GHC
-- built in 'Stage0' is called @ghc-stage1@. If the given package is a
-- 'Library', the function simply returns its name.
programName :: Context -> Action String
programName Context {..} = do
cross <- flag CrossCompiling
targetPlatform <- setting TargetPlatformFull
let prefix = if cross then targetPlatform ++ "-" else ""
-- TODO: Can we extract this information from Cabal files?
-- Also, why @runhaskell@ instead of @runghc@?
return $ prefix ++ case package of
p | p == ghc -> "ghc"
| p == hpcBin -> "hpc"
| p == runGhc -> "runhaskell"
| p == iserv -> "ghc-iserv"
_ -> pkgName package
-- | The 'FilePath' to a program executable in a given 'Context'.
programPath :: Context -> Action FilePath
programPath context@Context {..} = do
-- TODO: The @touchy@ utility lives in the @lib/bin@ directory instead of
-- @bin@, which is likely just a historical accident that should be fixed.
-- See: https://github.com/snowleopard/hadrian/issues/570
-- Likewise for 'unlit'.
name <- programName context
path <- if package `elem` [touchy, unlit] then stageLibPath stage <&> (-/- "bin")
else stageBinPath stage
return $ path -/- name <.> exe
-- TODO: Move @timeout@ to the @util@ directory and build in a more standard
-- location like other programs used only by the testsuite.
timeoutPath :: FilePath
timeoutPath = "testsuite/timeout/install-inplace/bin/timeout" <.> exe
-- TODO: Can we extract this information from Cabal files?
-- | Some program packages should not be linked with Haskell main function.
nonHsMainPackage :: Package -> Bool
nonHsMainPackage = (`elem` [ghc, hp2ps, iserv, touchy, unlit])
-- TODO: Can we extract this information from Cabal files?
-- | Path to the @autogen@ directory generated when configuring a package.
autogenPath :: Context -> Action FilePath
autogenPath context@Context {..}
| isLibrary package = autogen "build"
| package == ghc = autogen "build/ghc"
| package == hpcBin = autogen "build/hpc"
| otherwise = autogen $ "build" -/- pkgName package
where
autogen dir = contextPath context <&> (-/- dir -/- "autogen")
buildDll0 :: Context -> Action Bool
buildDll0 Context {..} = do
windows <- windowsHost
return $ windows && stage == Stage1 && package == compiler
-- | RTS is considered a Stage1 package.
rtsContext :: Context
rtsContext = vanillaContext Stage1 rts
-- | Path to the RTS build directory.
rtsBuildPath :: Action FilePath
rtsBuildPath = buildPath rtsContext
-- | The 'libffi' library is considered a 'Stage1' package.
libffiContext :: Context
libffiContext = vanillaContext Stage1 libffi
-- | Build directory for in-tree 'libffi' library.
libffiBuildPath :: Action FilePath
libffiBuildPath = buildPath libffiContext
-- | Name of the 'libffi' library.
libffiLibraryName :: Action FilePath
libffiLibraryName = do
useSystemFfi <- flag UseSystemFfi
windows <- windowsHost
return $ case (useSystemFfi, windows) of
(True , False) -> "ffi"
(False, False) -> "Cffi"
(_ , True ) -> "Cffi-6"
...@@ -6,8 +6,8 @@ import qualified Hadrian.Oracles.Path ...@@ -6,8 +6,8 @@ import qualified Hadrian.Oracles.Path
import qualified Hadrian.Oracles.TextFile.Rules import qualified Hadrian.Oracles.TextFile.Rules
import Expression import Expression
import GHC
import qualified Oracles.ModuleFiles import qualified Oracles.ModuleFiles
import Packages
import qualified Rules.BinaryDist import qualified Rules.BinaryDist
import qualified Rules.Compile import qualified Rules.Compile
import qualified Rules.Configure import qualified Rules.Configure
......
...@@ -2,8 +2,8 @@ module Rules.BinaryDist where ...@@ -2,8 +2,8 @@ module Rules.BinaryDist where
import Context import Context
import Expression import Expression
import GHC
import Oracles.Setting import Oracles.Setting
import Packages
import Settings import Settings
import Target import Target
import Utilities import Utilities
...@@ -25,7 +25,7 @@ bindistRules = do ...@@ -25,7 +25,7 @@ bindistRules = do
bindistFilesDir = root -/- "bindist" -/- ghcVersionPretty bindistFilesDir = root -/- "bindist" -/- ghcVersionPretty
ghcVersionPretty = "ghc-" ++ version ++ "-" ++ targetPlatform ghcVersionPretty = "ghc-" ++ version ++ "-" ++ targetPlatform
distDir = hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ version distDir = hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ version
rtsIncludeDir = ghcBuildDir -/- "lib" -/- distDir -/- rtsDir rtsIncludeDir = ghcBuildDir -/- "lib" -/- distDir -/- rtsDir
-/- "include" -/- "include"
-- we create the bindist directory at <root>/bindist/ghc-X.Y.Z-platform/ -- we create the bindist directory at <root>/bindist/ghc-X.Y.Z-platform/
...@@ -33,7 +33,7 @@ bindistRules = do ...@@ -33,7 +33,7 @@ bindistRules = do
createDirectory bindistFilesDir createDirectory bindistFilesDir
copyDirectory (ghcBuildDir -/- "bin") bindistFilesDir copyDirectory (ghcBuildDir -/- "bin") bindistFilesDir
copyDirectory (ghcBuildDir -/- "lib") bindistFilesDir copyDirectory (ghcBuildDir -/- "lib") bindistFilesDir
copyDirectory (rtsIncludeDir) bindistFilesDir copyDirectory (rtsIncludeDir) bindistFilesDir
{- SHOULD WE SHIP DOCS? {- SHOULD WE SHIP DOCS?
need ["docs"] need ["docs"]
copyDirectory (root -/- "docs") bindistFilesDir copyDirectory (root -/- "docs") bindistFilesDir
...@@ -72,8 +72,8 @@ bindistRules = do ...@@ -72,8 +72,8 @@ bindistRules = do
-- generate the Makefile that enables the "make install" part -- generate the Makefile that enables the "make install" part
root -/- "bindist" -/- "ghc-*" -/- "Makefile" %> \makefilePath -> root -/- "bindist" -/- "ghc-*" -/- "Makefile" %> \makefilePath ->
writeFile' makefilePath bindistMakefile writeFile' makefilePath bindistMakefile
root -/- "bindist" -/- "ghc-*" -/- "wrappers/*" %> \wrapperPath -> root -/- "bindist" -/- "ghc-*" -/- "wrappers/*" %> \wrapperPath ->
writeFile' wrapperPath $ wrapper (takeFileName wrapperPath) writeFile' wrapperPath $ wrapper (takeFileName wrapperPath)
-- copy over the various configure-related files needed for a working -- copy over the various configure-related files needed for a working
...@@ -148,7 +148,7 @@ bindistMakefile = unlines ...@@ -148,7 +148,7 @@ bindistMakefile = unlines
, "# This implementation is a bit hacky and depends on consistency of program" , "# This implementation is a bit hacky and depends on consistency of program"
, "# names. For hadrian build this will work as programs have a consistent " , "# names. For hadrian build this will work as programs have a consistent "
, "# naming procefure. This file is tested on Linux(Ubuntu)" , "# naming procefure. This file is tested on Linux(Ubuntu)"
, "# TODO : Check implementation in other distributions" , "# TODO : Check implementation in other distributions"
, "\trm -f $2" , "\trm -f $2"
, "\t$(CREATE_SCRIPT) $2" , "\t$(CREATE_SCRIPT) $2"
, "\t@echo \"#!$(SHELL)\" >> $2" , "\t@echo \"#!$(SHELL)\" >> $2"
...@@ -160,7 +160,7 @@ bindistMakefile = unlines ...@@ -160,7 +160,7 @@ bindistMakefile = unlines
, "\t@echo \"docdir=\\\"$7\\\"\" >> $2" , "\t@echo \"docdir=\\\"$7\\\"\" >> $2"
, "\t@echo \"includedir=\\\"$8\\\"\" >> $2" , "\t@echo \"includedir=\\\"$8\\\"\" >> $2"
, "\t@echo \"\" >> $2 " , "\t@echo \"\" >> $2 "
, "\tcat wrappers/$1 >> $2" , "\tcat wrappers/$1 >> $2"
, "\t$(EXECUTABLE_FILE) $2 ;" , "\t$(EXECUTABLE_FILE) $2 ;"
, "endef" , "endef"
, "" , ""
...@@ -181,13 +181,13 @@ bindistMakefile = unlines ...@@ -181,13 +181,13 @@ bindistMakefile = unlines
, "endif" , "endif"
, "" , ""
, "# If the relative path of binaries and libraries are altered, we will need to" , "# If the relative path of binaries and libraries are altered, we will need to"
, "# install additional wrapper scripts at bindir." , "# install additional wrapper scripts at bindir."
, "ifneq \"$(LIBPARENT)/bin\" \"$(bindir)\"" , "ifneq \"$(LIBPARENT)/bin\" \"$(bindir)\""
, "install: install_wrappers" , "install: install_wrappers"
, "endif" , "endif"
, ""