Use Cabal directly in place of ghc-cabal + make build root configurable (#531)
[hadrian.git] / src / Settings / Builders / GhcCabal.hs
index 9b54fbe..4ed06d6 100644 (file)
 module Settings.Builders.GhcCabal (
-    ghcCabalBuilderArgs, ghcCabalHsColourBuilderArgs, buildDll0
+    ghcCabalBuilderArgs
     ) where
 
+import Data.Maybe (fromJust)
+
+import Builder ( ArMode ( Pack ) )
 import Context
 import Flavour
-import Settings.Builders.Common hiding (package)
-import Util
+import GHC.Packages
+import Hadrian.Builder (getBuilderPath, needBuilder )
+import Hadrian.Haskell.Cabal
+import Settings.Builders.Common
 
 ghcCabalBuilderArgs :: Args
-ghcCabalBuilderArgs = builder GhcCabal ? do
+ghcCabalBuilderArgs = mconcat
+  [ builder (GhcCabal Conf) ? do
     verbosity <- expr getVerbosity
     top       <- expr topDirectory
-    context   <- getContext
-    when (package context /= deriveConstants) $ expr (need inplaceLibCopyTargets)
+    path      <- getContextPath
+    stage     <- getStage
     mconcat [ arg "configure"
-            , arg =<< getPackagePath
-            , arg $ top -/- buildPath context
-            , dll0Args
+            -- 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
+            , bootPackageConstraints
             , withStaged $ Cc CompileC
-            , notStage0 ? with Ld
-            , withStaged Ar
+            , notStage0 ? with (Ld stage)
+            , withStaged (Ar Pack)
             , with Alex
             , with Happy
-            , verbosity < Chatty ? append [ "-v0", "--configure-option=--quiet"
-                , "--configure-option=--disable-option-checking"  ] ]
+            , verbosity < Chatty ?
+              pure [ "-v0", "--configure-option=--quiet"
+                   , "--configure-option=--disable-option-checking"
+                   ]
+            ]
+  ]
 
-ghcCabalHsColourBuilderArgs :: Args
-ghcCabalHsColourBuilderArgs = builder GhcCabalHsColour ? do
-    path    <- getPackagePath
-    top     <- expr topDirectory
-    context <- getContext
-    append [ "hscolour", path, top -/- buildPath context ]
 
 -- 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     <- getLibraryWays
-    withGhci <- expr ghcWithInterpreter
-    append [ if vanilla `elem` ways
-             then  "--enable-library-vanilla"
-             else "--disable-library-vanilla"
-           , if vanilla `elem` ways && withGhci && not (dynamicGhcPrograms flavour)
-             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
-    top <- expr topDirectory
+    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
-                           , argStagedSettingList ConfCcArgs
-                           , arg $ "-I" ++ top -/- generatedPath ]
-        ldFlags  = ldArgs  <> (argStagedSettingList ConfGccLinkerArgs)
-        cppFlags = cppArgs <> (argStagedSettingList ConfCppArgs)
+                           , 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
         , not (null cldFlags) ? arg ("--gcc-options=" ++ cldFlags)
-        , conf "--with-iconv-includes"    $ return <$> getSetting IconvIncludeDir
-        , conf "--with-iconv-libraries"   $ return <$> getSetting IconvLibDir
-        , conf "--with-gmp-includes"      $ return <$> getSetting GmpIncludeDir
-        , conf "--with-gmp-libraries"     $ return <$> getSetting GmpLibDir
-        , conf "--with-curses-libraries"  $ return <$> getSetting CursesLibDir
-        , crossCompiling ? (conf "--host" $ return <$> getSetting TargetPlatformFull)
-        , conf "--with-cc" $ argStagedBuilderPath (Cc CompileC) ]
+        , 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))]
 
-packageConstraints :: Args
-packageConstraints = stage0 ? do
-    constraints <- expr . readFileLines $ bootPackageConstraints
-    append $ concat [ ["--constraint", c] | c <- constraints ]
+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 = arg $ "-I" ++ generatedPath
+cppArgs = do
+    root <- getBuildRoot
+    arg $ "-I" ++ root -/- generatedDir
 
 withBuilderKey :: Builder -> String
 withBuilderKey b = case b of
-    Ar _       -> "--with-ar="
-    Ld         -> "--with-ld="
+    Ar _ _     -> "--with-ar="
+    Ld _       -> "--with-ld="
     Cc  _ _    -> "--with-gcc="
     Ghc _ _    -> "--with-ghc="
     Alex       -> "--with-alex="
     Happy      -> "--with-happy="
     GhcPkg _ _ -> "--with-ghc-pkg="
-    HsColour   -> "--with-hscolour="
     _          -> 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 b = isSpecified b ? do
-    top  <- expr topDirectory
+with b = do
     path <- getBuilderPath b
-    expr $ needBuilder b
-    arg $ withBuilderKey b ++ unifyPath (top </> path)
+    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 = with . sb =<< getStage
 
-buildDll0 :: Context -> Action Bool
-buildDll0 Context {..} = do
-    windows <- windowsHost
-    return $ windows && stage == Stage1 && package == compiler
-
--- 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.
-dll0Args :: Args
-dll0Args = do
-    context  <- getContext
-    dll0     <- expr $ buildDll0 context
-    withGhci <- expr ghcWithInterpreter
-    arg . unwords . concat $ [ modules     | dll0             ]
-                          ++ [ ghciModules | dll0 && withGhci ] -- see #9552
-  where
-    modules = [ "Annotations"
-              , "ApiAnnotation"
-              , "Avail"
-              , "Bag"
-              , "BasicTypes"
-              , "Binary"
-              , "BooleanFormula"
-              , "BreakArray"
-              , "BufWrite"
-              , "Class"
-              , "CmdLineParser"
-              , "CmmType"
-              , "CoAxiom"
-              , "ConLike"
-              , "Coercion"
-              , "Config"
-              , "Constants"
-              , "CoreArity"
-              , "CoreFVs"
-              , "CoreSubst"
-              , "CoreSyn"
-              , "CoreTidy"
-              , "CoreUnfold"
-              , "CoreUtils"
-              , "CoreSeq"
-              , "CoreStats"
-              , "CostCentre"
-              , "Ctype"
-              , "DataCon"
-              , "Demand"
-              , "Digraph"
-              , "DriverPhases"
-              , "DynFlags"
-              , "Encoding"
-              , "ErrUtils"
-              , "Exception"
-              , "ExtsCompat46"
-              , "FamInstEnv"
-              , "FastFunctions"
-              , "FastMutInt"
-              , "FastString"
-              , "FastTypes"
-              , "Fingerprint"
-              , "FiniteMap"
-              , "ForeignCall"
-              , "Hooks"
-              , "HsBinds"
-              , "HsDecls"
-              , "HsDoc"
-              , "HsExpr"
-              , "HsImpExp"
-              , "HsLit"
-              , "PlaceHolder"
-              , "HsPat"
-              , "HsSyn"
-              , "HsTypes"
-              , "HsUtils"
-              , "HscTypes"
-              , "IOEnv"
-              , "Id"
-              , "IdInfo"
-              , "IfaceSyn"
-              , "IfaceType"
-              , "InstEnv"
-              , "Kind"
-              , "Lexeme"
-              , "Lexer"
-              , "ListSetOps"
-              , "Literal"
-              , "Maybes"
-              , "MkCore"
-              , "MkId"
-              , "Module"
-              , "MonadUtils"
-              , "Name"
-              , "NameEnv"
-              , "NameSet"
-              , "OccName"
-              , "OccurAnal"
-              , "OptCoercion"
-              , "OrdList"
-              , "Outputable"
-              , "PackageConfig"
-              , "Packages"
-              , "Pair"
-              , "Panic"
-              , "PatSyn"
-              , "PipelineMonad"
-              , "Platform"
-              , "PlatformConstants"
-              , "PprCore"
-              , "PrelNames"
-              , "PrelRules"
-              , "Pretty"
-              , "PrimOp"
-              , "RdrName"
-              , "Rules"
-              , "Serialized"
-              , "SrcLoc"
-              , "StaticFlags"
-              , "StringBuffer"
-              , "TcEvidence"
-              , "TcRnTypes"
-              , "TcType"
-              , "TrieMap"
-              , "TyCon"
-              , "Type"
-              , "TypeRep"
-              , "TysPrim"
-              , "TysWiredIn"
-              , "Unify"
-              , "UniqFM"
-              , "UniqSet"
-              , "UniqSupply"
-              , "Unique"
-              , "Util"
-              , "Var"
-              , "VarEnv"
-              , "VarSet" ]
-    ghciModules = [ "Bitmap"
-                  , "BlockId"
-                  , "ByteCodeAsm"
-                  , "ByteCodeInstr"
-                  , "ByteCodeItbls"
-                  , "CLabel"
-                  , "Cmm"
-                  , "CmmCallConv"
-                  , "CmmExpr"
-                  , "CmmInfo"
-                  , "CmmMachOp"
-                  , "CmmNode"
-                  , "CmmSwitch"
-                  , "CmmUtils"
-                  , "CodeGen.Platform"
-                  , "CodeGen.Platform.ARM"
-                  , "CodeGen.Platform.ARM64"
-                  , "CodeGen.Platform.NoRegs"
-                  , "CodeGen.Platform.PPC"
-                  , "CodeGen.Platform.PPC_Darwin"
-                  , "CodeGen.Platform.SPARC"
-                  , "CodeGen.Platform.X86"
-                  , "CodeGen.Platform.X86_64"
-                  , "FastBool"
-                  , "InteractiveEvalTypes"
-                  , "MkGraph"
-                  , "PprCmm"
-                  , "PprCmmDecl"
-                  , "PprCmmExpr"
-                  , "Reg"
-                  , "RegClass"
-                  , "SMRep"
-                  , "StgCmmArgRep"
-                  , "StgCmmClosure"
-                  , "StgCmmEnv"
-                  , "StgCmmLayout"
-                  , "StgCmmMonad"
-                  , "StgCmmProf"
-                  , "StgCmmTicky"
-                  , "StgCmmUtils"
-                  , "StgSyn"
-                  , "Stream" ]
+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)