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

@@ -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

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.

src/Builder.hs-boot

-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

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)

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

src/GHC.hs

-{-# 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"

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.

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)

src/GHC/Packages.hs → src/Packages.hs

 {-# 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.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. 'defaultPackages' defines default
--- conditions for building each package. Users can add their own packages and
--- modify build default build conditions in "UserSettings".
+-- 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
@@ -75,13 +95,13 @@ 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"
-timeout             = hsUtil "timeout"         `setPath` "testsuite/timeout"
 
 -- | Construct a Haskell library package, e.g. @array@.
 hsLib :: PackageName -> Package
@@ -106,3 +126,85 @@ 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"

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

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 <root>/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\"`"

src/Rules/Configure.hs

 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]

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

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

src/Rules/Gmp.hs

@@ -4,8 +4,8 @@ module Rules.Gmp (
 
 import Base