From 0106f203927187d76ce9e92e69ed9864d01091dc Mon Sep 17 00:00:00 2001 From: Andrey Mokhov Date: Mon, 27 Aug 2018 21:45:17 +0100 Subject: [PATCH] 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" --- hadrian.cabal | 3 +- src/Builder.hs | 2 +- src/Builder.hs-boot | 46 ------- src/Expression.hs | 2 +- src/Expression/Type.hs | 2 +- src/GHC.hs | 192 -------------------------- src/GHC/Packages.hs | 108 --------------- src/Hadrian/Haskell/Cabal/Parse.hs | 12 +- src/Oracles/ModuleFiles.hs | 5 +- src/Packages.hs | 210 +++++++++++++++++++++++++++++ src/Rules.hs | 2 +- src/Rules/BinaryDist.hs | 26 ++-- src/Rules/Configure.hs | 6 +- src/Rules/Documentation.hs | 2 +- src/Rules/Generate.hs | 2 +- src/Rules/Gmp.hs | 2 +- src/Rules/Libffi.hs | 3 +- src/Rules/Library.hs | 9 +- src/Rules/Nofib.hs | 87 ++++++------ src/Rules/Program.hs | 3 +- src/Rules/Register.hs | 12 +- src/Rules/Selftest.hs | 4 +- src/Rules/Test.hs | 111 ++++++--------- src/Settings.hs | 2 +- src/Settings/Builders/Cabal.hs | 8 +- src/Settings/Builders/Common.hs | 5 +- src/Settings/Builders/Configure.hs | 2 +- src/Settings/Builders/Ghc.hs | 8 +- src/Settings/Builders/HsCpp.hs | 2 +- src/Settings/Builders/Hsc2Hs.hs | 6 +- src/Settings/Builders/Make.hs | 2 +- src/Settings/Builders/RunTest.hs | 43 +++++- src/Settings/Default.hs | 163 +++++++++++++++++----- src/Settings/Packages.hs | 2 +- src/Settings/Warnings.hs | 2 +- 35 files changed, 529 insertions(+), 567 deletions(-) delete mode 100644 src/Builder.hs-boot delete mode 100644 src/GHC.hs delete mode 100644 src/GHC/Packages.hs create mode 100644 src/Packages.hs diff --git a/hadrian.cabal b/hadrian.cabal index f94fb80eec..82026c9971 100644 --- a/hadrian.cabal +++ b/hadrian.cabal @@ -28,8 +28,6 @@ executable hadrian , Expression , Expression.Type , Flavour - , GHC - , GHC.Packages , Hadrian.Builder , Hadrian.Builder.Ar , Hadrian.Builder.Sphinx @@ -53,6 +51,7 @@ executable hadrian , Oracles.Setting , Oracles.ModuleFiles , Oracles.TestSettings + , Packages , Rules , Rules.BinaryDist , Rules.Clean diff --git a/src/Builder.hs b/src/Builder.hs index b4eafaf542..6427e4b750 100644 --- a/src/Builder.hs +++ b/src/Builder.hs @@ -27,9 +27,9 @@ import Hadrian.Utilities import Base import Context -import GHC import Oracles.Flag import Oracles.Setting +import Packages -- | C compiler can be used in two different modes: -- * Compile or preprocess a source file. diff --git a/src/Builder.hs-boot b/src/Builder.hs-boot deleted file mode 100644 index 85a4b149c9..0000000000 --- a/src/Builder.hs-boot +++ /dev/null @@ -1,46 +0,0 @@ -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 diff --git a/src/Expression.hs b/src/Expression.hs index 211ca194a0..61fd41ea39 100644 --- a/src/Expression.hs +++ b/src/Expression.hs @@ -23,7 +23,7 @@ module Expression ( ) where import Base -import {-# SOURCE #-} Builder +import Builder import Context hiding (stage, package, way) import Expression.Type import Hadrian.Expression hiding (Expr, Predicate, Args) diff --git a/src/Expression/Type.hs b/src/Expression/Type.hs index 8c5ede8f2b..b5b0138f0a 100644 --- a/src/Expression/Type.hs +++ b/src/Expression/Type.hs @@ -3,7 +3,7 @@ module Expression.Type where import Context.Type import Way.Type -import {-# SOURCE #-} Builder +import Builder import qualified Hadrian.Expression as H -- | @Expr a@ is a computation that produces a value of type @Action a@ and can diff --git a/src/GHC.hs b/src/GHC.hs deleted file mode 100644 index 23244d6277..0000000000 --- a/src/GHC.hs +++ /dev/null @@ -1,192 +0,0 @@ -{-# 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" diff --git a/src/GHC/Packages.hs b/src/GHC/Packages.hs deleted file mode 100644 index 87bc6fd1da..0000000000 --- a/src/GHC/Packages.hs +++ /dev/null @@ -1,108 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-missing-signatures #-} -module GHC.Packages where - -import Hadrian.Package -import Hadrian.Utilities - --- | 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, --- package 'win32' is built only on Windows. 'defaultPackages' defines default --- conditions for building each package. Users can add their own packages and --- modify build default build conditions in "UserSettings". -ghcPackages :: [Package] -ghcPackages = - [ array, base, binary, bytestring, cabal, checkPpr, checkApiAnnotations - , compareSizes, compiler, containers, deepseq, deriveConstants, directory - , filepath, genapply, genprimopcode, ghc, ghcBoot, ghcBootTh, ghcCompact - , ghcHeap, ghci, ghcPkg, ghcPrim, ghcTags, haddock, haskeline, hsc2hs, hp2ps - , hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, libiserv, mtl - , parsec, parallel, pretty, process, rts, runGhc, stm, templateHaskell - , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml - , timeout ] - --- TODO: Optimise by switching to sets of packages. -isGhcPackage :: Package -> Bool -isGhcPackage = (`elem` ghcPackages) - --- | Package definitions, see 'Package'. -array = hsLib "array" -base = hsLib "base" -binary = hsLib "binary" -bytestring = hsLib "bytestring" -cabal = hsLib "Cabal" `setPath` "libraries/Cabal/Cabal" -checkApiAnnotations = hsUtil "check-api-annotations" -checkPpr = hsUtil "check-ppr" -compareSizes = hsUtil "compareSizes" `setPath` "utils/compare_sizes" -compiler = hsTop "ghc" `setPath` "compiler" -containers = hsLib "containers" -deepseq = hsLib "deepseq" -deriveConstants = hsUtil "deriveConstants" -directory = hsLib "directory" -filepath = hsLib "filepath" -genapply = hsUtil "genapply" -genprimopcode = hsUtil "genprimopcode" -ghc = hsPrg "ghc-bin" `setPath` "ghc" -ghcBoot = hsLib "ghc-boot" -ghcBootTh = hsLib "ghc-boot-th" -ghcCompact = hsLib "ghc-compact" -ghcHeap = hsLib "ghc-heap" -ghci = hsLib "ghci" -ghcPkg = hsUtil "ghc-pkg" -ghcPrim = hsLib "ghc-prim" -ghcTags = hsUtil "ghctags" -ghcSplit = hsUtil "ghc-split" -haddock = hsUtil "haddock" -haskeline = hsLib "haskeline" -hsc2hs = hsUtil "hsc2hs" -hp2ps = hsUtil "hp2ps" -hpc = hsLib "hpc" -hpcBin = hsUtil "hpc-bin" `setPath` "utils/hpc" -integerGmp = hsLib "integer-gmp" -integerSimple = hsLib "integer-simple" -iserv = hsUtil "iserv" -libffi = cTop "libffi" -libiserv = hsLib "libiserv" -mtl = hsLib "mtl" -parsec = hsLib "parsec" -parallel = hsLib "parallel" -pretty = hsLib "pretty" -primitive = hsLib "primitive" -process = hsLib "process" -rts = cTop "rts" -runGhc = hsUtil "runghc" -stm = hsLib "stm" -templateHaskell = hsLib "template-haskell" -terminfo = hsLib "terminfo" -text = hsLib "text" -time = hsLib "time" -touchy = hsUtil "touchy" -transformers = hsLib "transformers" -unlit = hsUtil "unlit" -unix = hsLib "unix" -win32 = hsLib "Win32" -xhtml = hsLib "xhtml" -timeout = hsUtil "timeout" `setPath` "testsuite/timeout" - --- | Construct a Haskell library package, e.g. @array@. -hsLib :: PackageName -> Package -hsLib name = hsLibrary name ("libraries" -/- name) - --- | Construct a top-level Haskell library package, e.g. @compiler@. -hsTop :: PackageName -> Package -hsTop name = hsLibrary name name - --- | Construct a top-level C library package, e.g. @rts@. -cTop :: PackageName -> Package -cTop name = cLibrary name name - --- | Construct a top-level Haskell program package, e.g. @ghc@. -hsPrg :: PackageName -> Package -hsPrg name = hsProgram name name - --- | Construct a Haskell utility package, e.g. @haddock@. -hsUtil :: PackageName -> Package -hsUtil name = hsProgram name ("utils" -/- name) - --- | Amend a package path if it doesn't conform to a typical pattern. -setPath :: Package -> FilePath -> Package -setPath pkg path = pkg { pkgPath = path } diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs b/src/Hadrian/Haskell/Cabal/Parse.hs index 593403c8e1..113771136d 100644 --- a/src/Hadrian/Haskell/Cabal/Parse.hs +++ b/src/Hadrian/Haskell/Cabal/Parse.hs @@ -37,17 +37,17 @@ import qualified Distribution.Types.LocalBuildInfo as C import qualified Distribution.Text as C import qualified Distribution.Types.MungedPackageId as C import qualified Distribution.Verbosity as C - -import Base -import Builder -import Context -import Flavour -import GHC.Packages import Hadrian.Expression import Hadrian.Haskell.Cabal.CabalData import Hadrian.Haskell.Cabal.PackageData import Hadrian.Oracles.TextFile import Hadrian.Target + +import Base +import Builder +import Context +import Flavour +import Packages import Settings -- | Parse the Cabal package identifier from a @.cabal@ file. diff --git a/src/Oracles/ModuleFiles.hs b/src/Oracles/ModuleFiles.hs index f167de0953..cb2011c571 100644 --- a/src/Oracles/ModuleFiles.hs +++ b/src/Oracles/ModuleFiles.hs @@ -5,12 +5,13 @@ module Oracles.ModuleFiles ( import qualified Data.HashMap.Strict as Map +import Hadrian.Haskell.Cabal.PackageData as PD + import Base import Builder import Context import Expression -import GHC -import Hadrian.Haskell.Cabal.PackageData as PD +import Packages newtype ModuleFiles = ModuleFiles (Stage, Package) deriving (Binary, Eq, Hashable, NFData, Show, Typeable) diff --git a/src/Packages.hs b/src/Packages.hs new file mode 100644 index 0000000000..8a0d150d55 --- /dev/null +++ b/src/Packages.hs @@ -0,0 +1,210 @@ +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} +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.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 +-- all of them. However, not all of these packages will be built. For example, +-- package 'win32' is built only on Windows. @GHC.defaultPackages@ defines +-- default conditions for building each package. Users can add their own +-- packages and modify build default build conditions in "UserSettings". +ghcPackages :: [Package] +ghcPackages = + [ array, base, binary, bytestring, cabal, checkPpr, checkApiAnnotations + , compareSizes, compiler, containers, deepseq, deriveConstants, directory + , filepath, genapply, genprimopcode, ghc, ghcBoot, ghcBootTh, ghcCompact + , ghcHeap, ghci, ghcPkg, ghcPrim, ghcTags, haddock, haskeline, hsc2hs, hp2ps + , hpc, hpcBin, integerGmp, integerSimple, iserv, libffi, libiserv, mtl + , parsec, parallel, pretty, process, rts, runGhc, stm, templateHaskell + , terminfo, text, time, touchy, transformers, unlit, unix, win32, xhtml + , timeout ] + +-- TODO: Optimise by switching to sets of packages. +isGhcPackage :: Package -> Bool +isGhcPackage = (`elem` ghcPackages) + +-- | Package definitions, see 'Package'. +array = hsLib "array" +base = hsLib "base" +binary = hsLib "binary" +bytestring = hsLib "bytestring" +cabal = hsLib "Cabal" `setPath` "libraries/Cabal/Cabal" +checkApiAnnotations = hsUtil "check-api-annotations" +checkPpr = hsUtil "check-ppr" +compareSizes = hsUtil "compareSizes" `setPath` "utils/compare_sizes" +compiler = hsTop "ghc" `setPath` "compiler" +containers = hsLib "containers" +deepseq = hsLib "deepseq" +deriveConstants = hsUtil "deriveConstants" +directory = hsLib "directory" +filepath = hsLib "filepath" +genapply = hsUtil "genapply" +genprimopcode = hsUtil "genprimopcode" +ghc = hsPrg "ghc-bin" `setPath` "ghc" +ghcBoot = hsLib "ghc-boot" +ghcBootTh = hsLib "ghc-boot-th" +ghcCompact = hsLib "ghc-compact" +ghcHeap = hsLib "ghc-heap" +ghci = hsLib "ghci" +ghcPkg = hsUtil "ghc-pkg" +ghcPrim = hsLib "ghc-prim" +ghcTags = hsUtil "ghctags" +ghcSplit = hsUtil "ghc-split" +haddock = hsUtil "haddock" +haskeline = hsLib "haskeline" +hsc2hs = hsUtil "hsc2hs" +hp2ps = hsUtil "hp2ps" +hpc = hsLib "hpc" +hpcBin = hsUtil "hpc-bin" `setPath` "utils/hpc" +integerGmp = hsLib "integer-gmp" +integerSimple = hsLib "integer-simple" +iserv = hsUtil "iserv" +libffi = cTop "libffi" +libiserv = hsLib "libiserv" +mtl = hsLib "mtl" +parsec = hsLib "parsec" +parallel = hsLib "parallel" +pretty = hsLib "pretty" +primitive = hsLib "primitive" +process = hsLib "process" +rts = cTop "rts" +runGhc = hsUtil "runghc" +stm = hsLib "stm" +templateHaskell = hsLib "template-haskell" +terminfo = hsLib "terminfo" +text = hsLib "text" +time = hsLib "time" +timeout = hsUtil "timeout" `setPath` "testsuite/timeout" +touchy = hsUtil "touchy" +transformers = hsLib "transformers" +unlit = hsUtil "unlit" +unix = hsLib "unix" +win32 = hsLib "Win32" +xhtml = hsLib "xhtml" + +-- | Construct a Haskell library package, e.g. @array@. +hsLib :: PackageName -> Package +hsLib name = hsLibrary name ("libraries" -/- name) + +-- | Construct a top-level Haskell library package, e.g. @compiler@. +hsTop :: PackageName -> Package +hsTop name = hsLibrary name name + +-- | Construct a top-level C library package, e.g. @rts@. +cTop :: PackageName -> Package +cTop name = cLibrary name name + +-- | Construct a top-level Haskell program package, e.g. @ghc@. +hsPrg :: PackageName -> Package +hsPrg name = hsProgram name name + +-- | Construct a Haskell utility package, e.g. @haddock@. +hsUtil :: PackageName -> Package +hsUtil name = hsProgram name ("utils" -/- name) + +-- | Amend a package path if it doesn't conform to a typical pattern. +setPath :: Package -> FilePath -> Package +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" diff --git a/src/Rules.hs b/src/Rules.hs index 85eb001399..2b2a15fcad 100644 --- a/src/Rules.hs +++ b/src/Rules.hs @@ -6,8 +6,8 @@ import qualified Hadrian.Oracles.Path import qualified Hadrian.Oracles.TextFile.Rules import Expression -import GHC import qualified Oracles.ModuleFiles +import Packages import qualified Rules.BinaryDist import qualified Rules.Compile import qualified Rules.Configure diff --git a/src/Rules/BinaryDist.hs b/src/Rules/BinaryDist.hs index c9273ecff0..90922bd422 100644 --- a/src/Rules/BinaryDist.hs +++ b/src/Rules/BinaryDist.hs @@ -2,8 +2,8 @@ module Rules.BinaryDist where import Context import Expression -import GHC import Oracles.Setting +import Packages import Settings import Target import Utilities @@ -25,7 +25,7 @@ bindistRules = do bindistFilesDir = root -/- "bindist" -/- ghcVersionPretty ghcVersionPretty = "ghc-" ++ version ++ "-" ++ targetPlatform distDir = hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ version - rtsIncludeDir = ghcBuildDir -/- "lib" -/- distDir -/- rtsDir + rtsIncludeDir = ghcBuildDir -/- "lib" -/- distDir -/- rtsDir -/- "include" -- we create the bindist directory at /bindist/ghc-X.Y.Z-platform/ @@ -33,7 +33,7 @@ bindistRules = do createDirectory bindistFilesDir copyDirectory (ghcBuildDir -/- "bin") bindistFilesDir copyDirectory (ghcBuildDir -/- "lib") bindistFilesDir - copyDirectory (rtsIncludeDir) bindistFilesDir + copyDirectory (rtsIncludeDir) bindistFilesDir {- SHOULD WE SHIP DOCS? need ["docs"] copyDirectory (root -/- "docs") bindistFilesDir @@ -72,8 +72,8 @@ bindistRules = do -- generate the Makefile that enables the "make install" part root -/- "bindist" -/- "ghc-*" -/- "Makefile" %> \makefilePath -> writeFile' makefilePath bindistMakefile - - root -/- "bindist" -/- "ghc-*" -/- "wrappers/*" %> \wrapperPath -> + + root -/- "bindist" -/- "ghc-*" -/- "wrappers/*" %> \wrapperPath -> writeFile' wrapperPath $ wrapper (takeFileName wrapperPath) -- copy over the various configure-related files needed for a working @@ -148,7 +148,7 @@ bindistMakefile = unlines , "# This implementation is a bit hacky and depends on consistency of program" , "# names. For hadrian build this will work as programs have a consistent " , "# naming procefure. This file is tested on Linux(Ubuntu)" - , "# TODO : Check implementation in other distributions" + , "# TODO : Check implementation in other distributions" , "\trm -f $2" , "\t$(CREATE_SCRIPT) $2" , "\t@echo \"#!$(SHELL)\" >> $2" @@ -160,7 +160,7 @@ bindistMakefile = unlines , "\t@echo \"docdir=\\\"$7\\\"\" >> $2" , "\t@echo \"includedir=\\\"$8\\\"\" >> $2" , "\t@echo \"\" >> $2 " - , "\tcat wrappers/$1 >> $2" + , "\tcat wrappers/$1 >> $2" , "\t$(EXECUTABLE_FILE) $2 ;" , "endef" , "" @@ -181,13 +181,13 @@ bindistMakefile = unlines , "endif" , "" , "# 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)\"" , "install: install_wrappers" , "endif" , "" , "# We need to install binaries relative to libraries." - , "BINARIES = $(wildcard ./bin/*)" + , "BINARIES = $(wildcard ./bin/*)" , "install_bin:" , "\t@echo \"Copying Binaries to $(GHCBINDIR)\"" , "\t$(INSTALL_DIR) \"$(GHCBINDIR)\"" @@ -215,7 +215,7 @@ bindistMakefile = unlines , "\t$(INSTALL_DIR) \"$(includedir)\"" , "\tfor i in $(INCLUDES); do \\" , "\t\tcp -R $$i \"$(includedir)/\"; \\" - , "\tdone" + , "\tdone" , "" , "DOCS = $(wildcard ./docs/*)" , "install_docs:" @@ -242,11 +242,11 @@ wrapper "ghc-pkg" = ghcPkgWrapper wrapper "ghci" = ghciWrapper wrapper "ghci-script" = ghciScriptWrapper wrapper "haddock" = haddockWrapper -wrapper "hsc2hs" = hsc2hsWrapper +wrapper "hsc2hs" = hsc2hsWrapper wrapper "runhaskell" = runhaskellWrapper wrapper _ = commonWrapper --- | Wrapper scripts for different programs. Common is default wrapper. +-- | Wrapper scripts for different programs. Common is default wrapper. ghcWrapper :: String ghcWrapper = unlines @@ -303,7 +303,7 @@ runhaskellWrapper = unlines ] -- | We need to ship ghci executable, which basically just calls ghc with --- | --interactive flag. +-- | --interactive flag. ghciScriptWrapper :: String ghciScriptWrapper = unlines [ "DIR=`dirname \"$0\"`" diff --git a/src/Rules/Configure.hs b/src/Rules/Configure.hs index 547384101a..909b3c3357 100644 --- a/src/Rules/Configure.hs +++ b/src/Rules/Configure.hs @@ -1,15 +1,15 @@ module Rules.Configure (configureRules) where -import qualified System.Info.Extra as System - import Base import Builder import CommandLine import Context -import GHC +import Packages import Target import Utilities +import qualified System.Info.Extra as System + -- TODO: Make this list complete. -- | Files generated by running the @configure@ script. configureResults :: [FilePath] diff --git a/src/Rules/Documentation.hs b/src/Rules/Documentation.hs index ce1121e080..23c13b306e 100644 --- a/src/Rules/Documentation.hs +++ b/src/Rules/Documentation.hs @@ -10,8 +10,8 @@ import Base import Context import Expression (getPackageData, interpretInContext) import Flavour -import GHC import Oracles.ModuleFiles +import Packages import Settings import Target import Utilities diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs index c6be43ae30..c3650c36b1 100644 --- a/src/Rules/Generate.hs +++ b/src/Rules/Generate.hs @@ -6,10 +6,10 @@ module Rules.Generate ( import Base import Expression import Flavour -import GHC import Oracles.Flag import Oracles.ModuleFiles import Oracles.Setting +import Packages import Rules.Gmp import Rules.Libffi import Settings diff --git a/src/Rules/Gmp.hs b/src/Rules/Gmp.hs index 828d86a5e6..32265fe401 100644 --- a/src/Rules/Gmp.hs +++ b/src/Rules/Gmp.hs @@ -4,8 +4,8 @@ module Rules.Gmp ( import Base import Context -import GHC import Oracles.Setting +import Packages import Target import Utilities diff --git a/src/Rules/Libffi.hs b/src/Rules/Libffi.hs index 834cbc6d6f..58ac1efbdc 100644 --- a/src/Rules/Libffi.hs +++ b/src/Rules/Libffi.hs @@ -1,7 +1,8 @@ module Rules.Libffi (libffiRules, libffiDependencies) where -import GHC import Hadrian.Utilities + +import Packages import Settings.Builders.Common import Target import Utilities diff --git a/src/Rules/Library.hs b/src/Rules/Library.hs index d4228dd920..1ad67b6a8c 100644 --- a/src/Rules/Library.hs +++ b/src/Rules/Library.hs @@ -1,24 +1,23 @@ module Rules.Library (libraryRules) where +import Data.Functor import Hadrian.Haskell.Cabal import Hadrian.Haskell.Cabal.PackageData as PD import Hadrian.Package.Type +import qualified System.Directory as IO +import qualified Text.Parsec as Parsec import Base import Context import Expression hiding (way, package) import Flavour -import GHC.Packages import Oracles.ModuleFiles +import Packages import Rules.Gmp import Settings import Target import Utilities -import Data.Functor -import qualified System.Directory as IO -import qualified Text.Parsec as Parsec - -- * Library 'Rules' libraryRules :: Rules () diff --git a/src/Rules/Nofib.hs b/src/Rules/Nofib.hs index e0ef5ea2c4..0950605199 100644 --- a/src/Rules/Nofib.hs +++ b/src/Rules/Nofib.hs @@ -2,57 +2,56 @@ module Rules.Nofib where import Base import Expression -import GHC import Oracles.Setting -import Target +import Packages import System.Environment import System.Exit -nofibRules :: Rules () -nofibRules = do - root <- buildRootRules - - -- a phony "nofib" rule that just triggers - -- the rule below. - "nofib" ~> need [root -/- nofibLogFile] - - -- a rule to produce /nofig-log - -- by running the nofib suite and capturing - -- the relevant output. - root -/- nofibLogFile %> \fp -> do - needNofibDeps - - makePath <- builderPath (Make "nofib") - top <- topDirectory - ghcPath <- builderPath (Ghc CompileHs Stage2) - perlPath <- builderPath Perl - - -- some makefiles in nofib rely on a $MAKE - -- env var being defined - liftIO (setEnv "MAKE" makePath) - - -- this runs make commands in the nofib - -- subdirectory, passing the path to - -- the GHC to benchmark and perl to - -- nofib's makefiles. - let nofibArgs = ["WithNofibHc=" ++ (top -/- ghcPath), "PERL=" ++ perlPath] - unit $ cmd (Cwd "nofib") [makePath] ["clean"] - unit $ cmd (Cwd "nofib") [makePath] (nofibArgs ++ ["boot"]) - (Exit e, Stdouterr log) <- cmd (Cwd "nofib") [makePath] nofibArgs - writeFile' fp log - if e == ExitSuccess - then putLoud $ "nofib log available at " ++ fp - else error $ "nofib failed, full log available at " ++ fp - nofibLogFile :: FilePath nofibLogFile = "nofib-log" - --- the dependencies that nofib seems to require. +-- | Rules for running the @nofib@ benchmark suite. +nofibRules :: Rules () +nofibRules = do + root <- buildRootRules + + -- a phony "nofib" rule that just triggers + -- the rule below. + "nofib" ~> need [root -/- nofibLogFile] + + -- a rule to produce /nofig-log + -- by running the nofib suite and capturing + -- the relevant output. + root -/- nofibLogFile %> \fp -> do + needNofibDeps + + makePath <- builderPath (Make "nofib") + top <- topDirectory + ghcPath <- builderPath (Ghc CompileHs Stage2) + perlPath <- builderPath Perl + + -- some makefiles in nofib rely on a $MAKE + -- env var being defined + liftIO (setEnv "MAKE" makePath) + + -- this runs make commands in the nofib + -- subdirectory, passing the path to + -- the GHC to benchmark and perl to + -- nofib's makefiles. + let nofibArgs = ["WithNofibHc=" ++ (top -/- ghcPath), "PERL=" ++ perlPath] + unit $ cmd (Cwd "nofib") [makePath] ["clean"] + unit $ cmd (Cwd "nofib") [makePath] (nofibArgs ++ ["boot"]) + (Exit e, Stdouterr log) <- cmd (Cwd "nofib") [makePath] nofibArgs + writeFile' fp log + if e == ExitSuccess + then putLoud $ "nofib log available at " ++ fp + else error $ "nofib failed, full log available at " ++ fp + +-- | Build the dependencies required by @nofib@. needNofibDeps :: Action () needNofibDeps = do - unlitPath <- programPath (Context Stage1 unlit vanilla) - mtlPath <- pkgConfFile (Context Stage1 mtl vanilla) - need [ unlitPath, mtlPath ] - needBuilder (Ghc CompileHs Stage2) + unlitPath <- programPath (vanillaContext Stage1 unlit) + mtlPath <- pkgConfFile (vanillaContext Stage1 mtl ) + need [ unlitPath, mtlPath ] + needBuilder (Ghc CompileHs Stage2) diff --git a/src/Rules/Program.hs b/src/Rules/Program.hs index f329199a6e..9c0f4593f2 100644 --- a/src/Rules/Program.hs +++ b/src/Rules/Program.hs @@ -6,10 +6,11 @@ import Hadrian.Haskell.Cabal.PackageData as PD import Base import Context import Expression hiding (stage, way) -import GHC import Oracles.Flag import Oracles.ModuleFiles +import Packages import Settings +import Settings.Default import Target import Utilities diff --git a/src/Rules/Register.hs b/src/Rules/Register.hs index 909b1b3c13..62023d72e4 100644 --- a/src/Rules/Register.hs +++ b/src/Rules/Register.hs @@ -2,20 +2,18 @@ module Rules.Register (configurePackage, registerPackage) where import Distribution.ParseUtils import Distribution.Version (Version) +import qualified Distribution.Compat.ReadP as Parse +import qualified Hadrian.Haskell.Cabal.Parse as Cabal +import Hadrian.Expression +import qualified System.Directory as IO import Base import Context -import GHC +import Packages import Settings import Target import Utilities -import Hadrian.Expression - -import qualified Distribution.Compat.ReadP as Parse -import qualified System.Directory as IO -import qualified Hadrian.Haskell.Cabal.Parse as Cabal - parseCabalName :: String -> Maybe (String, Version) parseCabalName = readPToMaybe parse where diff --git a/src/Rules/Selftest.hs b/src/Rules/Selftest.hs index 0bf2824835..b435df2b3c 100644 --- a/src/Rules/Selftest.hs +++ b/src/Rules/Selftest.hs @@ -1,14 +1,14 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Rules.Selftest (selftestRules) where +import Hadrian.Haskell.Cabal import Test.QuickCheck import Base import Context -import GHC -import Hadrian.Haskell.Cabal import Oracles.ModuleFiles import Oracles.Setting +import Packages import Settings import Target import Utilities diff --git a/src/Rules/Test.hs b/src/Rules/Test.hs index 6a04c1e751..8fef83b078 100644 --- a/src/Rules/Test.hs +++ b/src/Rules/Test.hs @@ -1,16 +1,25 @@ -module Rules.Test (testRules, runTestGhcFlags, timeoutProgPath) where +module Rules.Test (testRules) where + +import System.Environment import Base import Expression -import GHC -import GHC.Packages (timeout) -import Oracles.Flag import Oracles.Setting +import Packages import Settings +import Settings.Default +import Settings.Builders.RunTest import Target import Utilities -import System.Environment +ghcConfigHsPath :: FilePath +ghcConfigHsPath = "testsuite/mk/ghc-config.hs" + +ghcConfigProgPath :: FilePath +ghcConfigProgPath = "test/bin/ghc-config" + +ghcConfigPath :: FilePath +ghcConfigPath = "test/ghcconfig" -- TODO: clean up after testing testRules :: Rules () @@ -19,17 +28,17 @@ testRules = do -- | Using program shipped with testsuite to generate ghcconfig file. root -/- ghcConfigProgPath ~> do - ghc <- builderPath $ Ghc CompileHs Stage0 + ghc <- builderPath $ Ghc CompileHs Stage0 cmd ghc [ghcConfigHsPath, "-o" , root -/- ghcConfigProgPath] -- | TODO : Use input test compiler and not just stage2 compiler. root -/- ghcConfigPath ~> do - ghcPath <- needfile Stage1 ghc - need [ root -/- ghcConfigProgPath] + ghcPath <- needFile Stage1 ghc + need [root -/- ghcConfigProgPath] cmd [FileStdout $ root -/- ghcConfigPath] (root -/- ghcConfigProgPath) - [ ghcPath ] + [ghcPath] - root -/- timeoutProgPath ~> timeoutProgBuilder + root -/- timeoutPath ~> timeoutProgBuilder "validate" ~> do needTestBuilders @@ -40,7 +49,7 @@ testRules = do -- TODO : Should we remove the previosly generated config file? -- Prepare Ghc configuration file for input compiler. - need [ root -/- ghcConfigPath, root -/- timeoutProgPath ] + need [root -/- ghcConfigPath, root -/- timeoutPath] -- TODO This approach doesn't work. -- Set environment variables for test's Makefile. @@ -53,8 +62,8 @@ testRules = do top <- topDirectory ghcPath <- (top -/-) <$> builderPath (Ghc CompileHs Stage2) ghcFlags <- runTestGhcFlags - checkPprPath <- (top -/-) <$> needfile Stage1 checkPpr - annotationsPath <- (top -/-) <$> needfile Stage1 checkApiAnnotations + checkPprPath <- (top -/-) <$> needFile Stage1 checkPpr + annotationsPath <- (top -/-) <$> needFile Stage1 checkApiAnnotations -- Set environment variables for test's Makefile. liftIO $ do @@ -62,7 +71,7 @@ testRules = do setEnv "TEST_HC" ghcPath setEnv "TEST_HC_OPTS" ghcFlags setEnv "CHECK_PPR" checkPprPath - setEnv "CHECK_API_ANNOTATIONS" annotationsPath + setEnv "CHECK_API_ANNOTATIONS" annotationsPath -- Execute the test target. buildWithCmdOptions env $ target (vanillaContext Stage2 compiler) RunTest [] [] @@ -70,15 +79,15 @@ testRules = do -- | Build extra programs and libraries required by testsuite needTestsuitePackages :: Action () needTestsuitePackages = do - targets <- mapM (needfile Stage1) =<< testsuitePackages + targets <- mapM (needFile Stage1) =<< testsuitePackages binPath <- stageBinPath Stage1 libPath <- stageLibPath Stage1 - iservPath <- needfile Stage1 iserv - runhaskellPath <- needfile Stage1 runGhc + iservPath <- needFile Stage1 iserv + runhaskellPath <- needFile Stage1 runGhc need targets -- | We need to copy iserv bin to lib/bin as this is where testsuite looks - -- | for iserv. Also, using runhaskell gives different stdout due to - -- | difference in program name. This causes StdMismatch errors. + -- | for iserv. Also, using runhaskell gives different stdout due to + -- | difference in program name. This causes StdMismatch errors. copyFile iservPath $ libPath -/- "bin/ghc-iserv" copyFile runhaskellPath $ binPath -/- "runghc" @@ -91,72 +100,28 @@ timeoutProgBuilder = do if windows then do prog <- programPath =<< programContext Stage1 timeout - need [ prog ] - copyFile prog (root -/- timeoutProgPath) + copyFile prog (root -/- timeoutPath) else do python <- builderPath Python - copyFile "testsuite/timeout/timeout.py" (root -/- timeoutProgPath <.> "py") + copyFile "testsuite/timeout/timeout.py" (root -/- timeoutPath <.> "py") let script = unlines [ "#!/usr/bin/env sh" - , "exec " ++ python ++ " $0.py \"$@\"" - ] - writeFile' (root -/- timeoutProgPath) script - makeExecutable (root -/- timeoutProgPath) + , "exec " ++ python ++ " $0.py \"$@\"" ] + writeFile' (root -/- timeoutPath) script + makeExecutable (root -/- timeoutPath) needTestBuilders :: Action () needTestBuilders = do needBuilder $ Ghc CompileHs Stage2 needBuilder $ GhcPkg Update Stage1 needBuilder Hpc - needBuilder (Hsc2Hs Stage1) + needBuilder $ Hsc2Hs Stage1 needTestsuitePackages --- | Extra flags to send to the Haskell compiler to run tests. -runTestGhcFlags :: Action String -runTestGhcFlags = do - unregisterised <- flag GhcUnregisterised - - let ifMinGhcVer ver opt = do v <- ghcCanonVersion - if ver <= v then pure opt - else pure "" - - -- Read extra argument for test from command line, like `-fvectorize`. - ghcOpts <- fromMaybe "" <$> (liftIO $ lookupEnv "EXTRA_HC_OPTS") - - -- See: https://github.com/ghc/ghc/blob/master/testsuite/mk/test.mk#L28 - let ghcExtraFlags = if unregisterised - then "-optc-fno-builtin" - else "" - - -- Take flags to send to the Haskell compiler from test.mk. - -- See: https://github.com/ghc/ghc/blob/master/testsuite/mk/test.mk#L37 - unwords <$> sequence - [ pure " -dcore-lint -dcmm-lint -no-user-package-db -rtsopts" - , pure ghcOpts - , pure ghcExtraFlags - , ifMinGhcVer "711" "-fno-warn-missed-specialisations" - , ifMinGhcVer "711" "-fshow-warning-groups" - , ifMinGhcVer "801" "-fdiagnostics-color=never" - , ifMinGhcVer "801" "-fno-diagnostics-show-caret" - , pure "-dno-debug-output" - ] - -timeoutProgPath :: FilePath -timeoutProgPath = "testsuite/timeout/install-inplace/bin/timeout" <.> exe - -ghcConfigHsPath :: FilePath -ghcConfigHsPath = "testsuite/mk/ghc-config.hs" - -ghcConfigProgPath :: FilePath -ghcConfigProgPath = "test/bin/ghc-config" - -ghcConfigPath :: FilePath -ghcConfigPath = "test/ghcconfig" - -needfile :: Stage -> Package -> Action FilePath -needfile stage pkg ---TODO (Alp): we might sometimes need more than vanilla! +needFile :: Stage -> Package -> Action FilePath +needFile stage pkg +-- TODO (Alp): we might sometimes need more than vanilla! -- This should therefore depend on what test ways -- we are going to use, I suppose? | isLibrary pkg = pkgConfFile (Context stage pkg profilingDynamic) - | otherwise = programPath =<< programContext stage pkg + | otherwise = programPath =<< programContext stage pkg diff --git a/src/Settings.hs b/src/Settings.hs index bdc18fc924..3497f43a1e 100755 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -7,7 +7,7 @@ module Settings ( import CommandLine import Expression import Flavour -import GHC.Packages +import Packages import UserSettings import {-# SOURCE #-} Settings.Default diff --git a/src/Settings/Builders/Cabal.hs b/src/Settings/Builders/Cabal.hs index 100e16b20d..685b84fa2a 100644 --- a/src/Settings/Builders/Cabal.hs +++ b/src/Settings/Builders/Cabal.hs @@ -1,13 +1,13 @@ module Settings.Builders.Cabal (cabalBuilderArgs) where import Data.Maybe (fromJust) +import Hadrian.Builder (getBuilderPath, needBuilder) +import Hadrian.Haskell.Cabal -import Builder (ArMode (Pack)) +import Builder import Context import Flavour -import GHC.Packages -import Hadrian.Builder (getBuilderPath, needBuilder) -import Hadrian.Haskell.Cabal +import Packages import Settings.Builders.Common cabalBuilderArgs :: Args diff --git a/src/Settings/Builders/Common.hs b/src/Settings/Builders/Common.hs index ae660db31e..c845650523 100644 --- a/src/Settings/Builders/Common.hs +++ b/src/Settings/Builders/Common.hs @@ -9,12 +9,13 @@ module Settings.Builders.Common ( packageDatabaseArgs, bootPackageDatabaseArgs ) where +import Hadrian.Haskell.Cabal.PackageData + import Base import Expression -import GHC.Packages -import Hadrian.Haskell.Cabal.PackageData import Oracles.Flag import Oracles.Setting +import Packages import Settings import UserSettings diff --git a/src/Settings/Builders/Configure.hs b/src/Settings/Builders/Configure.hs index 37442d448d..068591dfbb 100644 --- a/src/Settings/Builders/Configure.hs +++ b/src/Settings/Builders/Configure.hs @@ -1,6 +1,6 @@ module Settings.Builders.Configure (configureBuilderArgs) where -import GHC +import Packages import Rules.Gmp import Settings.Builders.Common diff --git a/src/Settings/Builders/Ghc.hs b/src/Settings/Builders/Ghc.hs index 49bfbd6fbc..4d6aa6700c 100644 --- a/src/Settings/Builders/Ghc.hs +++ b/src/Settings/Builders/Ghc.hs @@ -1,13 +1,13 @@ module Settings.Builders.Ghc (ghcBuilderArgs, haddockGhcArgs) where +import Hadrian.Haskell.Cabal +import Hadrian.Haskell.Cabal.PackageData as PD + import Flavour -import GHC +import Packages import Settings.Builders.Common import Settings.Warnings -import Hadrian.Haskell.Cabal -import Hadrian.Haskell.Cabal.PackageData as PD - ghcBuilderArgs :: Args ghcBuilderArgs = mconcat [compileAndLinkHs, compileC, findHsDependencies] diff --git a/src/Settings/Builders/HsCpp.hs b/src/Settings/Builders/HsCpp.hs index 54b6faf4f0..e33061c9d0 100644 --- a/src/Settings/Builders/HsCpp.hs +++ b/src/Settings/Builders/HsCpp.hs @@ -1,6 +1,6 @@ module Settings.Builders.HsCpp (hsCppBuilderArgs) where -import GHC.Packages +import Packages import Settings.Builders.Common hsCppBuilderArgs :: Args diff --git a/src/Settings/Builders/Hsc2Hs.hs b/src/Settings/Builders/Hsc2Hs.hs index 2c9194aeb1..10fbb1bbd8 100644 --- a/src/Settings/Builders/Hsc2Hs.hs +++ b/src/Settings/Builders/Hsc2Hs.hs @@ -1,9 +1,9 @@ module Settings.Builders.Hsc2Hs (hsc2hsBuilderArgs) where -import Builder () -import GHC (autogenPath) -import Hadrian.Builder (getBuilderPath) import Hadrian.Haskell.Cabal.PackageData as PD + +import Builder +import Packages import Settings.Builders.Common hsc2hsBuilderArgs :: Args diff --git a/src/Settings/Builders/Make.hs b/src/Settings/Builders/Make.hs index 4062ac2ddb..102ba54845 100644 --- a/src/Settings/Builders/Make.hs +++ b/src/Settings/Builders/Make.hs @@ -1,7 +1,7 @@ module Settings.Builders.Make (makeBuilderArgs, validateBuilderArgs) where -import GHC import Oracles.Setting +import Packages import Rules.Gmp import Settings.Builders.Common import CommandLine diff --git a/src/Settings/Builders/RunTest.hs b/src/Settings/Builders/RunTest.hs index 1d4ec7dfb3..c2e6bfddbf 100644 --- a/src/Settings/Builders/RunTest.hs +++ b/src/Settings/Builders/RunTest.hs @@ -1,12 +1,13 @@ -module Settings.Builders.RunTest (runTestBuilderArgs) where +module Settings.Builders.RunTest (runTestBuilderArgs, runTestGhcFlags) where -import CommandLine (TestArgs(..), defaultTestArgs, TestSpeed(..)) -import Flavour -import GHC import Hadrian.Utilities +import System.Environment + +import CommandLine +import Flavour import Oracles.Setting (setting) import Oracles.TestSettings -import Rules.Test +import Packages import Settings.Builders.Common getTestSetting :: TestSetting -> Expr String @@ -18,6 +19,36 @@ getBooleanSetting key = fromMaybe (error msg) <$> parseYesNo <$> getTestSetting where msg = "Cannot parse test setting " ++ quote (show key) +-- | Extra flags to send to the Haskell compiler to run tests. +runTestGhcFlags :: Action String +runTestGhcFlags = do + unregisterised <- flag GhcUnregisterised + + let ifMinGhcVer ver opt = do v <- ghcCanonVersion + if ver <= v then pure opt + else pure "" + + -- Read extra argument for test from command line, like `-fvectorize`. + ghcOpts <- fromMaybe "" <$> (liftIO $ lookupEnv "EXTRA_HC_OPTS") + + -- See: https://github.com/ghc/ghc/blob/master/testsuite/mk/test.mk#L28 + let ghcExtraFlags = if unregisterised + then "-optc-fno-builtin" + else "" + + -- Take flags to send to the Haskell compiler from test.mk. + -- See: https://github.com/ghc/ghc/blob/master/testsuite/mk/test.mk#L37 + unwords <$> sequence + [ pure " -dcore-lint -dcmm-lint -no-user-package-db -rtsopts" + , pure ghcOpts + , pure ghcExtraFlags + , ifMinGhcVer "711" "-fno-warn-missed-specialisations" + , ifMinGhcVer "711" "-fshow-warning-groups" + , ifMinGhcVer "801" "-fdiagnostics-color=never" + , ifMinGhcVer "801" "-fno-diagnostics-show-caret" + , pure "-dno-debug-output" + ] + -- Command line arguments for invoking the @runtest.py@ script. A lot of this -- mirrors @testsuite/mk/test.mk@. runTestBuilderArgs :: Args @@ -49,7 +80,7 @@ runTestBuilderArgs = builder RunTest ? do wordsize <- getTestSetting TestWORDSIZE top <- expr $ topDirectory ghcFlags <- expr runTestGhcFlags - timeoutProg <- expr buildRoot <&> (-/- timeoutProgPath) + timeoutProg <- expr buildRoot <&> (-/- timeoutPath) let asZeroOne s b = s ++ zeroOne b diff --git a/src/Settings/Default.hs b/src/Settings/Default.hs index 3a1bb75b36..689a49e7ac 100644 --- a/src/Settings/Default.hs +++ b/src/Settings/Default.hs @@ -1,13 +1,29 @@ module Settings.Default ( + -- * Packages that are build by default and for the testsuite + defaultPackages, testsuitePackages, + + -- * Default build ways + defaultLibraryWays, defaultRtsWays, + + -- * Default command line arguments for various builders SourceArgs (..), sourceArgs, defaultBuilderArgs, defaultPackageArgs, - defaultArgs, defaultLibraryWays, defaultRtsWays, + defaultArgs, + + -- * Default build flavour defaultFlavour, defaultSplitObjects ) where +import qualified Hadrian.Builder.Ar +import qualified Hadrian.Builder.Sphinx +import qualified Hadrian.Builder.Tar +import Hadrian.Haskell.Cabal.PackageData as PD + import CommandLine import Expression import Flavour import Oracles.Flag +import Oracles.Setting +import Packages import Settings import Settings.Builders.Alex import Settings.Builders.DeriveConstants @@ -28,12 +44,122 @@ import Settings.Builders.Xelatex import Settings.Packages import Settings.Warnings -import {-# SOURCE #-} Builder -import GHC -import qualified Hadrian.Builder.Ar -import qualified Hadrian.Builder.Sphinx -import qualified Hadrian.Builder.Tar -import Hadrian.Haskell.Cabal.PackageData as PD +-- | 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 [] + +-- | Packages built in 'Stage0' by default. You can change this in "UserSettings". +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 ] + +-- | Packages built in 'Stage1' by default. You can change this in "UserSettings". +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 ] + +-- | Packages built in 'Stage2' by default. You can change this in "UserSettings". +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 ] + +-- | Default build ways for library packages: +-- * We always build 'vanilla' way. +-- * We build 'profiling' way when stage > Stage0. +-- * We build 'dynamic' way when stage > Stage0 and the platform supports it. +defaultLibraryWays :: Ways +defaultLibraryWays = mconcat + [ pure [vanilla] + , notStage0 ? pure [profiling] + -- , notStage0 ? platformSupportsSharedLibs ? pure [dynamic] + ] + +-- | Default build ways for the RTS. +defaultRtsWays :: Ways +defaultRtsWays = do + ways <- getLibraryWays + mconcat + [ pure [ logging, debug, threaded, threadedDebug, threadedLogging ] + , (profiling `elem` ways) ? pure [threadedProfiling] + {- , (dynamic `elem` ways) ? + pure [ dynamic, debugDynamic, threadedDynamic, threadedDebugDynamic + , loggingDynamic, threadedLoggingDynamic ] -} + ] -- TODO: Move C source arguments here -- | Default and package-specific source arguments. @@ -69,29 +195,6 @@ defaultSourceArgs = SourceArgs , hsCompiler = mempty , hsGhc = mempty } --- | Default build ways for library packages: --- * We always build 'vanilla' way. --- * We build 'profiling' way when stage > Stage0. --- * We build 'dynamic' way when stage > Stage0 and the platform supports it. -defaultLibraryWays :: Ways -defaultLibraryWays = mconcat - [ pure [vanilla] - , notStage0 ? pure [profiling] - -- , notStage0 ? platformSupportsSharedLibs ? pure [dynamic] - ] - --- | Default build ways for the RTS. -defaultRtsWays :: Ways -defaultRtsWays = do - ways <- getLibraryWays - mconcat - [ pure [ logging, debug, threaded, threadedDebug, threadedLogging ] - , (profiling `elem` ways) ? pure [threadedProfiling] - {- , (dynamic `elem` ways) ? - pure [ dynamic, debugDynamic, threadedDynamic, threadedDebugDynamic - , loggingDynamic, threadedLoggingDynamic ] -} - ] - -- Please update doc/flavours.md when changing the default build flavour. -- | Default build flavour. Other build flavours are defined in modules -- @Settings.Flavours.*@. Users can add new build flavours in "UserSettings". diff --git a/src/Settings/Packages.hs b/src/Settings/Packages.hs index 774078e03b..a1c156a40e 100644 --- a/src/Settings/Packages.hs +++ b/src/Settings/Packages.hs @@ -2,9 +2,9 @@ module Settings.Packages (packageArgs) where import Expression import Flavour -import GHC import Oracles.Setting import Oracles.Flag +import Packages import Rules.Gmp import Settings diff --git a/src/Settings/Warnings.hs b/src/Settings/Warnings.hs index 2e3c50bacf..5a9e8311db 100644 --- a/src/Settings/Warnings.hs +++ b/src/Settings/Warnings.hs @@ -1,9 +1,9 @@ module Settings.Warnings (defaultGhcWarningsArgs, warningArgs) where import Expression -import GHC.Packages import Oracles.Flag import Oracles.Setting +import Packages import Settings -- See @mk/warnings.mk@ for warning-related arguments in the Make build system. -- GitLab