[commit: ghc] wip/hadrian-ghc-in-ghci: Hacky (c31b64a)
git at git.haskell.org
git at git.haskell.org
Fri Mar 8 01:45:52 UTC 2019
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/hadrian-ghc-in-ghci
Link : http://ghc.haskell.org/trac/ghc/changeset/c31b64a4161923aef5c40d0e1bab8c9343669421/ghc
>---------------------------------------------------------------
commit c31b64a4161923aef5c40d0e1bab8c9343669421
Author: Matthew Pickering <matthewtpickering at gmail.com>
Date: Thu Mar 7 20:45:52 2019 +0000
Hacky
>---------------------------------------------------------------
c31b64a4161923aef5c40d0e1bab8c9343669421
hadrian/src/Context.hs | 2 +-
hadrian/src/Hadrian/Utilities.hs | 16 +++++++++-------
hadrian/src/Oracles/Setting.hs | 2 +-
hadrian/src/Rules.hs | 2 +-
hadrian/src/Settings/Builders/Ghc.hs | 25 +++++++++++++++++++------
hadrian/src/Settings/Default.hs | 2 +-
hadrian/src/Settings/Flavours/Development.hs | 6 +++---
7 files changed, 35 insertions(+), 20 deletions(-)
diff --git a/hadrian/src/Context.hs b/hadrian/src/Context.hs
index f8a07d7..cf6381c 100644
--- a/hadrian/src/Context.hs
+++ b/hadrian/src/Context.hs
@@ -57,7 +57,7 @@ distDir = do
version <- setting ProjectVersion
hostOs <- cabalOsString <$> setting BuildOs
hostArch <- cabalArchString <$> setting BuildArch
- return $ hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ version
+ return $ hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ "8.4.4"
pkgFile :: Context -> String -> String -> Action FilePath
pkgFile context at Context {..} prefix suffix = do
diff --git a/hadrian/src/Hadrian/Utilities.hs b/hadrian/src/Hadrian/Utilities.hs
index 3e5d7b3..9ac3109 100644
--- a/hadrian/src/Hadrian/Utilities.hs
+++ b/hadrian/src/Hadrian/Utilities.hs
@@ -52,6 +52,7 @@ import qualified Data.HashMap.Strict as Map
import qualified System.Directory.Extra as IO
import qualified System.Info.Extra as IO
import qualified System.IO as IO
+import Debug.Trace
-- | Extract a value from a singleton list, or terminate with an error message
-- if the list does not contain exactly one value.
@@ -165,14 +166,15 @@ makeRelativeNoSysLink a b
-- Use removePrefix to get the relative paths relative to a new
-- base directory as high in the directory tree as possible.
(baseToA, baseToB) = removePrefix aRelSplit bRelSplit
- aToBase = if isDirUp (head baseToA)
- -- if baseToA contains any '..' then there is no way to get
- -- a path from a to the base directory.
- -- E.g. if baseToA == "../u/v"
- -- then aToBase == "../../<UnknownDir>"
- then error $ "Impossible to find relatieve path from "
+ aToBase = case baseToA of
+ (p: _) | isDirUp p ->
+ -- if baseToA contains any '..' then there is no way to get
+ -- a path from a to the base directory.
+ -- E.g. if baseToA == "../u/v"
+ -- then aToBase == "../../<UnknownDir>"
+ error $ "Impossible to find relatieve path from "
++ a ++ " to " ++ b
- else".." <$ baseToA
+ _ -> ".." <$ baseToA
aToB = aToBase ++ baseToB
-- removePrefix "pre123" "prefix456" == ("123", "fix456")
diff --git a/hadrian/src/Oracles/Setting.hs b/hadrian/src/Oracles/Setting.hs
index 02ac42e..2a88df4 100644
--- a/hadrian/src/Oracles/Setting.hs
+++ b/hadrian/src/Oracles/Setting.hs
@@ -226,4 +226,4 @@ libsuf way
extension <- setting DynamicExtension -- e.g., .dll or .so
version <- setting ProjectVersion -- e.g., 7.11.20141222
let suffix = waySuffix (removeWayUnit Dynamic way)
- return (suffix ++ "-ghc" ++ version ++ extension)
+ return (suffix ++ "-ghc" ++ "8.4.4" ++ extension)
diff --git a/hadrian/src/Rules.hs b/hadrian/src/Rules.hs
index 3e62584..f5655a7 100644
--- a/hadrian/src/Rules.hs
+++ b/hadrian/src/Rules.hs
@@ -32,7 +32,7 @@ dumpArgsTarget :: Rules ()
dumpArgsTarget = do
"dump-args" ~> do
root <- buildRoot
- let fake_target = target (vanillaContext Stage0 compiler)
+ let fake_target = target (Context Stage0 compiler dynamic)
(Ghc GhcInGhci Stage0) [] ["ignored"]
-- need the autogenerated files so that they are precompiled
diff --git a/hadrian/src/Settings/Builders/Ghc.hs b/hadrian/src/Settings/Builders/Ghc.hs
index ea5cebc..44a58bc 100644
--- a/hadrian/src/Settings/Builders/Ghc.hs
+++ b/hadrian/src/Settings/Builders/Ghc.hs
@@ -10,12 +10,23 @@ import Settings.Warnings
import qualified Context as Context
import Rules.Libffi (libffiName)
+import Debug.Trace
+
ghcBuilderArgs :: Args
ghcBuilderArgs = mconcat [compileAndLinkHs, compileC, findHsDependencies, ghcInGhciArgs]
ghcInGhciArgs :: Args
-ghcInGhciArgs = builder (Ghc GhcInGhci) ? mconcat [commonGhcArgs, arg "-fno-worker-wrapper"
- , arg "-O0" ]
+ghcInGhciArgs = do
+ builder (Ghc GhcInGhci) ? mconcat
+ [ arg "-O0"
+ , packageGhcArgs
+ , includeGhcArgs
+ , map ("-optc" ++) <$> getStagedSettingList ConfCcArgs
+ , map ("-optP" ++) <$> getStagedSettingList ConfCppArgs
+ , map ("-optP" ++) <$> getContextData cppOpts
+
+ --, ghcLinkArgs
+ ]
compileAndLinkHs :: Args
compileAndLinkHs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do
@@ -46,23 +57,26 @@ compileC = builder (Ghc CompileCWithGhc) ? do
, arg =<< getOutput ]
ghcLinkArgs :: Args
-ghcLinkArgs = builder (Ghc LinkHs) ? do
+ghcLinkArgs = builder (Ghc LinkHs) ||^ builder (Ghc GhcInGhci) ? do
pkg <- getPackage
libs <- getContextData extraLibs
libDirs <- getContextData extraLibDirs
fmwks <- getContextData frameworks
darwin <- expr osxHost
way <- getWay
-
+-- traceShowM (pkg, libs, libDirs, fmwks, darwin, way)
-- Relative path from the output (rpath $ORIGIN).
originPath <- dropFileName <$> getOutput
context <- getContext
libPath' <- expr (libPath context)
distDir <- expr Context.distDir
+-- traceShowM (originPath, context, libPath', distDir)
useSystemFfi <- expr (flag UseSystemFfi)
buildPath <- getBuildPath
libffiName' <- libffiName
+-- traceShowM (useSystemFfi, buildPath, libffiName')
+-- traceShowM (originPath, libPath' -/- distDir)
let
dynamic = Dynamic `wayUnit` way
@@ -86,8 +100,7 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do
[ arg "-dynamic"
-- TODO what about windows?
, isLibrary pkg ? pure [ "-shared", "-dynload", "deploy" ]
- , notStage0 ?
- hostSupportsRPaths ? arg ("-optl-Wl,-rpath," ++ rpath)
+ , hostSupportsRPaths ? arg ("-optl-Wl,-rpath," ++ rpath)
]
, arg "-no-auto-link-packages"
, nonHsMainPackage pkg ? arg "-no-hs-main"
diff --git a/hadrian/src/Settings/Default.hs b/hadrian/src/Settings/Default.hs
index de52613..0088260 100644
--- a/hadrian/src/Settings/Default.hs
+++ b/hadrian/src/Settings/Default.hs
@@ -147,7 +147,7 @@ defaultLibraryWays :: Ways
defaultLibraryWays = mconcat
[ pure [vanilla]
, notStage0 ? pure [profiling]
- , notStage0 ? platformSupportsSharedLibs ? pure [dynamic]
+ , platformSupportsSharedLibs ? pure [dynamic]
]
-- | Default build ways for the RTS.
diff --git a/hadrian/src/Settings/Flavours/Development.hs b/hadrian/src/Settings/Flavours/Development.hs
index 5fcc88b..9f06f7d 100644
--- a/hadrian/src/Settings/Flavours/Development.hs
+++ b/hadrian/src/Settings/Flavours/Development.hs
@@ -9,9 +9,9 @@ developmentFlavour :: Stage -> Flavour
developmentFlavour ghcStage = defaultFlavour
{ name = "devel" ++ show (fromEnum ghcStage)
, args = defaultBuilderArgs <> developmentArgs ghcStage <> defaultPackageArgs
- , libraryWays = pure [vanilla]
- , rtsWays = pure [vanilla, threaded]
- , dynamicGhcPrograms = return False }
+ , libraryWays = pure [vanilla, dynamic]
+ , rtsWays = pure [vanilla, threaded, dynamic]
+ , dynamicGhcPrograms = return True }
developmentArgs :: Stage -> Args
developmentArgs ghcStage = do
More information about the ghc-commits
mailing list