Use Cabal directly in place of ghc-cabal + make build root configurable (#531)
[hadrian.git] / src / Settings / Builders / GhcCabal.hs
index 6969aec..4ed06d6 100644 (file)
 module Settings.Builders.GhcCabal (
-    cabalArgs, bootPackageDbArgs, customPackageArgs
+    ghcCabalBuilderArgs
     ) where
 
-import Way
-import Base
-import Util
-import Stage
-import Builder
-import Package
-import Switches
-import Expression
-import Oracles.Flag
-import Oracles.Setting
-import Settings.User
-import Settings.Ways
-import Settings.Util
-import Settings.Packages
-
-cabalArgs :: Args
-cabalArgs = builder GhcCabal ? do
-    path <- getPackagePath
-    dir  <- getTargetDirectory
+import Data.Maybe (fromJust)
+
+import Builder ( ArMode ( Pack ) )
+import Context
+import Flavour
+import GHC.Packages
+import Hadrian.Builder (getBuilderPath, needBuilder )
+import Hadrian.Haskell.Cabal
+import Settings.Builders.Common
+
+ghcCabalBuilderArgs :: Args
+ghcCabalBuilderArgs = mconcat
+  [ builder (GhcCabal Conf) ? do
+    verbosity <- expr getVerbosity
+    top       <- expr topDirectory
+    path      <- getContextPath
+    stage     <- getStage
     mconcat [ arg "configure"
-            , arg path
-            , arg dir
-            , dllArgs
-            , withStaged Ghc
-            , withStaged GhcPkg
-            , stage0 ? bootPackageDbArgs
+            -- don't strip libraries when cross compiling.
+            -- XXX we need to set --with-strip= (stripCmdPath :: Action FilePath), and if it's ':' disable
+            --     stripping as well. As it is now, I believe we might have issues with stripping on
+            --     windows, as I can't see a consumre of `stripCmdPath`.
+            , crossCompiling ? pure [ "--disable-executable-stripping", "--disable-library-stripping" ]
+            , arg "--cabal-file"
+            , arg =<< fromJust . pkgCabalFile <$> getPackage
+            , arg "--distdir"
+            , arg $ top -/- path
+            , arg "--ipid"
+            , arg "$pkg-$version"
+            , arg "--prefix"
+            , arg "${pkgroot}/.."
+            , withStaged $ Ghc CompileHs
+            , withStaged (GhcPkg Update)
+            , withBuilderArgs (GhcPkg Update stage)
+            , bootPackageDatabaseArgs
             , libraryArgs
-            , with HsColour
             , configureArgs
-            , packageConstraints
-            , withStaged Gcc
-            , notStage0 ? with Ld
-            , with Ar
+            , bootPackageConstraints
+            , withStaged $ Cc CompileC
+            , notStage0 ? with (Ld stage)
+            , withStaged (Ar Pack)
             , with Alex
-            , with Happy ]
+            , with Happy
+            , verbosity < Chatty ?
+              pure [ "-v0", "--configure-option=--quiet"
+                   , "--configure-option=--disable-option-checking"
+                   ]
+            ]
+  ]
+
 
 -- TODO: Isn't vanilla always built? If yes, some conditions are redundant.
 -- TODO: Need compiler_stage1_CONFIGURE_OPTS += --disable-library-for-ghci?
+-- TODO: should `elem` be `wayUnit`?
 libraryArgs :: Args
 libraryArgs = do
-    ways   <- getWays
-    ghcInt <- lift $ ghcWithInterpreter
-    append [ if vanilla `elem` ways
-             then  "--enable-library-vanilla"
-             else "--disable-library-vanilla"
-           , if vanilla `elem` ways && ghcInt && not dynamicGhcPrograms
-             then  "--enable-library-for-ghci"
-             else "--disable-library-for-ghci"
-           , if profiling `elem` ways
-             then  "--enable-library-profiling"
-             else "--disable-library-profiling"
-           , if dynamic `elem` ways
-             then  "--enable-shared"
-             else "--disable-shared" ]
-
+    ways        <- getLibraryWays
+    withGhci    <- expr ghcWithInterpreter
+    dynPrograms <- dynamicGhcPrograms <$> expr flavour
+    pure [ if vanilla `elem` ways
+           then  "--enable-library-vanilla"
+           else "--disable-library-vanilla"
+         , if vanilla `elem` ways && withGhci && not dynPrograms
+           then  "--enable-library-for-ghci"
+           else "--disable-library-for-ghci"
+         , if profiling `elem` ways
+           then  "--enable-library-profiling"
+           else "--disable-library-profiling"
+         , if dynamic `elem` ways
+           then  "--enable-shared"
+           else "--disable-shared" ]
+
+-- TODO: LD_OPTS?
 configureArgs :: Args
 configureArgs = do
-    stage <- getStage
-    let conf key = appendSubD $ "--configure-option=" ++ key
-        cFlags   = mconcat [ ccArgs
-                           , remove ["-Werror"]
-                           , argSettingList $ ConfCcArgs stage ]
-        ldFlags  = ldArgs <> (argSettingList $ ConfGccLinkerArgs stage)
-        cppFlags = cppArgs <> (argSettingList $ ConfCppArgs stage)
+    top  <- expr topDirectory
+    root <- getBuildRoot
+    pkg  <- getPackage
+    let conf key expr = do
+            values <- unwords <$> expr
+            not (null values) ?
+                arg ("--configure-option=" ++ key ++ "=" ++ values)
+        cFlags   = mconcat [ remove ["-Werror"] cArgs
+                           , getStagedSettingList ConfCcArgs
+                           , arg $ "-I" ++ top -/- root -/- generatedDir
+                           -- See https://github.com/snowleopard/hadrian/issues/523
+                           , arg $ "-I" ++ top -/- pkgPath pkg
+                           , arg $ "-I" ++ top -/- "includes" ]
+        ldFlags  = ldArgs  <> (getStagedSettingList ConfGccLinkerArgs)
+        cppFlags = cppArgs <> (getStagedSettingList ConfCppArgs)
+    cldFlags <- unwords <$> (cFlags <> ldFlags)
     mconcat
         [ conf "CFLAGS"   cFlags
         , conf "LDFLAGS"  ldFlags
         , conf "CPPFLAGS" cppFlags
-        , appendSubD "--gcc-options" $ cFlags <> ldFlags
-        , conf "--with-iconv-includes"  $ argSettingList IconvIncludeDirs
-        , conf "--with-iconv-libraries" $ argSettingList IconvLibDirs
-        , conf "--with-gmp-includes"    $ argSettingList GmpIncludeDirs
-        , conf "--with-gmp-libraries"   $ argSettingList GmpLibDirs
-        -- TODO: why TargetPlatformFull and not host?
-        , crossCompiling ? (conf "--host" $ argSetting TargetPlatformFull)
-        , conf "--with-cc" . argM . builderPath $ Gcc stage ]
-
-bootPackageDbArgs :: Args
-bootPackageDbArgs = do
-    path <- getSetting GhcSourcePath
-    arg $ "--package-db=" ++ path -/- "libraries/bootstrapping.conf"
-
--- This is a positional argument, hence:
--- * if it is empty, we need to emit one empty string argument;
--- * otherwise, we must collapse it into one space-separated string.
--- TODO: should be non-empty for compiler
-dllArgs :: Args
-dllArgs = arg ""
-
-packageConstraints :: Args
-packageConstraints = stage0 ? do
-    constraints <- lift . readFileLines $ bootPackageConstraints
-    append . concatMap (\c -> ["--constraint", c]) $ constraints
-
--- TODO: should be in a different file
--- TODO: put all validating options together in one file
-ccArgs :: Args
-ccArgs = validating ? do
-    let gccGe46 = notP gccLt46
-    mconcat [ arg "-Werror"
-            , arg "-Wall"
-            , gccIsClang ??
-              ( arg "-Wno-unknown-pragmas" <>
-                gccGe46 ? windowsHost ? arg "-Werror=unused-but-set-variable"
-              , gccGe46 ? arg "-Wno-error=inline" )]
-
-ldArgs :: Args
-ldArgs = mempty
-
-ghcIncludeDirs :: [FilePath]
-ghcIncludeDirs = [ "includes", "includes/dist"
-                 , "includes/dist-derivedconstants/header"
-                 , "includes/dist-ghcconstants/header" ]
+        , not (null cldFlags) ? arg ("--gcc-options=" ++ cldFlags)
+        , conf "--with-iconv-includes"    $ arg =<< getSetting IconvIncludeDir
+        , conf "--with-iconv-libraries"   $ arg =<< getSetting IconvLibDir
+        , conf "--with-gmp-includes"      $ arg =<< getSetting GmpIncludeDir
+        , conf "--with-gmp-libraries"     $ arg =<< getSetting GmpLibDir
+        , conf "--with-curses-libraries"  $ arg =<< getSetting CursesLibDir
+        , crossCompiling ? (conf "--host" $ arg =<< getSetting TargetPlatformFull)
+        , conf "--with-cc" $ arg =<< getBuilderPath . (Cc CompileC) =<< getStage
+        , notStage0 ? (arg =<< ("--ghc-option=-ghcversion-file=" ++) <$> expr ((-/-) <$> topDirectory <*> ghcVersionH))]
+
+bootPackageConstraints :: Args
+bootPackageConstraints = stage0 ? do
+    bootPkgs <- expr $ stagePackages Stage0
+    let pkgs = filter (\p -> p /= compiler && isLibrary p) bootPkgs
+    ctx <- getContext
+    constraints <- expr $ fmap catMaybes $ forM (sort pkgs) $ \pkg -> do
+        version <- pkgVersion (ctx { Context.package = pkg})
+        return $ fmap ((pkgName pkg ++ " == ") ++) version
+    pure $ concat [ ["--constraint", c] | c <- constraints ]
 
 cppArgs :: Args
-cppArgs = append . map ("-I" ++ ) $ ghcIncludeDirs
-
-customPackageArgs :: Args
-customPackageArgs = do
-    stage   <- getStage
-    rtsWays <- getRtsWays
-    mconcat
-        [ package integerGmp2 ?
-          mconcat [ windowsHost ? builder GhcCabal ?
-                    arg "--configure-option=--with-intree-gmp"
-                  , appendCcArgs ["-I" ++ pkgPath integerGmp2 -/- "gmp"] ]
-
-        , package base ?
-          builder GhcCabal ?
-          arg ("--flags=" ++ takeFileName (pkgPath integerLibrary))
-
-        , package ghcPrim ?
-          builder GhcCabal ? arg "--flag=include-ghc-prim"
-
-        , package compiler ?
-          builder GhcCabal ?
-          mconcat [ arg $ "--ghc-option=-DSTAGE=" ++ show (succ stage)
-                  , arg $ "--flags=stage" ++ show (succ stage)
-                  , arg "--disable-library-for-ghci"
-                  , targetOs "openbsd" ? arg "--ld-options=-E"
-                  , flag GhcUnregisterised ? arg "--ghc-option=-DNO_REGS"
-                  , notP ghcWithSMP ? arg "--ghc-option=-DNOSMP"
-                  , notP ghcWithSMP ? arg "--ghc-option=-optc-DNOSMP"
-                  , (threaded `elem` rtsWays) ?
-                    notStage0 ? arg "--ghc-option=-optc-DTHREADED_RTS"
-                  , ghcWithNativeCodeGen ? arg "--flags=ncg"
-                  , ghcWithInterpreter ?
-                    notStage0 ? arg "--flags=ghci"
-                  , ghcWithInterpreter ?
-                    ghcEnableTablesNextToCode ?
-                    notP (flag GhcUnregisterised) ?
-                    notStage0 ? arg "--ghc-option=-DGHCI_TABLES_NEXT_TO_CODE"
-                  , ghcWithInterpreter ?
-                    ghciWithDebugger ?
-                    notStage0 ? arg "--ghc-option=-DDEBUGGER"
-                  , ghcProfiled ?
-                    notStage0 ? arg "--ghc-pkg-option=--force"
-                  ]
-        ]
+cppArgs = do
+    root <- getBuildRoot
+    arg $ "-I" ++ root -/- generatedDir
 
 withBuilderKey :: Builder -> String
-withBuilderKey builder = case builder of
-    Ar       -> "--with-ar="
-    Ld       -> "--with-ld="
-    Gcc _    -> "--with-gcc="
-    Ghc _    -> "--with-ghc="
-    Alex     -> "--with-alex="
-    Happy    -> "--with-happy="
-    GhcPkg _ -> "--with-ghc-pkg="
-    HsColour -> "--with-hscolour="
-    _        -> error "withBuilderKey: not supported builder"
-
--- Expression 'with Gcc' appends "--with-gcc=/path/to/gcc" and needs Gcc.
+withBuilderKey b = case b of
+    Ar _ _     -> "--with-ar="
+    Ld _       -> "--with-ld="
+    Cc  _ _    -> "--with-gcc="
+    Ghc _ _    -> "--with-ghc="
+    Alex       -> "--with-alex="
+    Happy      -> "--with-happy="
+    GhcPkg _ _ -> "--with-ghc-pkg="
+    _          -> error $ "withBuilderKey: not supported builder " ++ show b
+
+-- Adds arguments to builders if needed.
+withBuilderArgs :: Builder -> Args
+withBuilderArgs b = case b of
+    GhcPkg _ stage -> do
+      top   <- expr topDirectory
+      pkgDb <- expr $ packageDbPath stage
+      notStage0 ? arg ("--ghc-pkg-option=--global-package-db=" ++ top -/- pkgDb)
+    _          -> return [] -- no arguments
+
+
+-- Expression 'with Alex' appends "--with-alex=/path/to/alex" and needs Alex.
 with :: Builder -> Args
-with builder = specified builder ? do
-    path <- lift $ builderPath builder
-    lift $ needBuilder builder
-    append [withBuilderKey builder ++ path]
+with b = do
+    path <- getBuilderPath b
+    if (null path) then mempty else do
+        top  <- expr topDirectory
+        expr $ needBuilder b
+        arg $ withBuilderKey b ++ unifyPath (top </> path)
 
 withStaged :: (Stage -> Builder) -> Args
-withStaged sb = do
-    stage <- getStage
-    with $ sb stage
+withStaged sb = with . sb =<< getStage
+
+stagedBuilderPath :: (Stage -> Builder) -> Args
+stagedBuilderPath sb = builderPath . sb =<< getStage
+  where builderPath :: Builder -> Args
+        builderPath b = do
+          path <- getBuilderPath b
+          if (null path) then mempty else do
+            top <- expr topDirectory
+            expr $ needBuilder b
+            arg $ unifyPath (top </> path)