[commit: ghc] wip/hadrian-ghc-in-ghci: WIP Ghc-in-ghci/IDE support target (72aaf1f)
git at git.haskell.org
git at git.haskell.org
Mon Feb 25 22:05:50 UTC 2019
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/hadrian-ghc-in-ghci
Link : http://ghc.haskell.org/trac/ghc/changeset/72aaf1fa5bf2ec98e119d0f03c25d3920e7833a0/ghc
>---------------------------------------------------------------
commit 72aaf1fa5bf2ec98e119d0f03c25d3920e7833a0
Author: Matthew Pickering <matthewtpickering at gmail.com>
Date: Mon Feb 25 18:14:22 2019 +0000
WIP Ghc-in-ghci/IDE support target
>---------------------------------------------------------------
72aaf1fa5bf2ec98e119d0f03c25d3920e7833a0
compiler/utils/Encoding.hs | 1 -
compiler/utils/FastMutInt.hs | 1 -
hadrian/build.cabal.sh | 4 ++--
hadrian/src/Builder.hs | 6 +++++-
hadrian/src/Main.hs | 1 +
hadrian/src/Rules.hs | 24 +++++++++++++++++++++++-
hadrian/src/Settings/Builders/Ghc.hs | 6 +++++-
hadrian/src/Settings/Warnings.hs | 2 +-
8 files changed, 37 insertions(+), 8 deletions(-)
diff --git a/compiler/utils/Encoding.hs b/compiler/utils/Encoding.hs
index b4af686..4d269d6 100644
--- a/compiler/utils/Encoding.hs
+++ b/compiler/utils/Encoding.hs
@@ -1,5 +1,4 @@
{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}
-{-# OPTIONS_GHC -O2 #-}
-- We always optimise this, otherwise performance of a non-optimised
-- compiler is severely affected
diff --git a/compiler/utils/FastMutInt.hs b/compiler/utils/FastMutInt.hs
index 20206f8..27d228d 100644
--- a/compiler/utils/FastMutInt.hs
+++ b/compiler/utils/FastMutInt.hs
@@ -1,5 +1,4 @@
{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}
-{-# OPTIONS_GHC -O2 #-}
-- We always optimise this, otherwise performance of a non-optimised
-- compiler is severely affected
--
diff --git a/hadrian/build.cabal.sh b/hadrian/build.cabal.sh
index 13ef927..b28f727 100755
--- a/hadrian/build.cabal.sh
+++ b/hadrian/build.cabal.sh
@@ -23,9 +23,9 @@ CABVER=( ${CABVERSTR//./ } )
if [ "${CABVER[0]}" -gt 2 -o "${CABVER[0]}" -eq 2 -a "${CABVER[1]}" -ge 2 ];
then
- "$CABAL" --project-file="$PROJ" new-build $CABFLAGS -j exe:hadrian
+ "$CABAL" --project-file="$PROJ" new-build $CABFLAGS -v0 -j exe:hadrian
# use new-exec instead of new-run to make sure that the build-tools (alex & happy) are in PATH
- "$CABAL" --project-file="$PROJ" new-exec $CABFLAGS hadrian -- \
+ "$CABAL" --project-file="$PROJ" new-exec $CABFLAGS -v0 hadrian -- \
--directory "$PWD" \
"$@"
else
diff --git a/hadrian/src/Builder.hs b/hadrian/src/Builder.hs
index 02edb19..50d36ab 100644
--- a/hadrian/src/Builder.hs
+++ b/hadrian/src/Builder.hs
@@ -45,7 +45,11 @@ instance NFData CcMode
-- * Compile a C source file.
-- * Extract source dependencies by passing @-M@ command line argument.
-- * Link object files & static libraries into an executable.
-data GhcMode = CompileHs | CompileCWithGhc | FindHsDependencies | LinkHs
+data GhcMode = CompileHs
+ | CompileCWithGhc
+ | FindHsDependencies
+ | LinkHs
+ | GhcInGhci
deriving (Eq, Generic, Show)
instance Binary GhcMode
diff --git a/hadrian/src/Main.hs b/hadrian/src/Main.hs
index 083e683..ef16806 100644
--- a/hadrian/src/Main.hs
+++ b/hadrian/src/Main.hs
@@ -50,6 +50,7 @@ main = do
Rules.SourceDist.sourceDistRules
Rules.Test.testRules
Rules.topLevelTargets
+ Rules.dumpArgsTarget
shakeArgsWith options CommandLine.optDescrs $ \_ targets -> do
Environment.setupEnvironment
diff --git a/hadrian/src/Rules.hs b/hadrian/src/Rules.hs
index c5be5a7..3e62584 100644
--- a/hadrian/src/Rules.hs
+++ b/hadrian/src/Rules.hs
@@ -1,4 +1,5 @@
-module Rules (buildRules, oracleRules, packageTargets, topLevelTargets) where
+module Rules (buildRules, oracleRules, packageTargets, topLevelTargets
+ , dumpArgsTarget ) where
import qualified Hadrian.Oracles.ArgsHash
import qualified Hadrian.Oracles.Cabal.Rules
@@ -26,6 +27,27 @@ import Target
import UserSettings
import Utilities
+
+dumpArgsTarget :: Rules ()
+dumpArgsTarget = do
+ "dump-args" ~> do
+ root <- buildRoot
+ let fake_target = target (vanillaContext Stage0 compiler)
+ (Ghc GhcInGhci Stage0) [] ["ignored"]
+
+ -- need the autogenerated files so that they are precompiled
+ let dir = buildDir (vanillaContext Stage0 compiler)
+ generatedGhcDependencies Stage0 >>= need
+ interpret fake_target Rules.Generate.compilerDependencies >>= need
+ need [ root <//> dir -/- "Config.hs" ]
+ need [ root <//> dir -/- "Fingerprint.hs" ]
+ need [ root <//> dir -/- "Parser.hs" ]
+ need [ root <//> dir -/- "Lexer.hs" ]
+ need [ root <//> dir -/- "CmmParse.hs" ]
+ need [ root <//> dir -/- "CmmLex.hs" ]
+ arg_list <- interpret fake_target getArgs
+ liftIO $ putStrLn (intercalate " " arg_list)
+
allStages :: [Stage]
allStages = [minBound .. maxBound]
diff --git a/hadrian/src/Settings/Builders/Ghc.hs b/hadrian/src/Settings/Builders/Ghc.hs
index 4bc10e5..ea5cebc 100644
--- a/hadrian/src/Settings/Builders/Ghc.hs
+++ b/hadrian/src/Settings/Builders/Ghc.hs
@@ -11,7 +11,11 @@ import qualified Context as Context
import Rules.Libffi (libffiName)
ghcBuilderArgs :: Args
-ghcBuilderArgs = mconcat [compileAndLinkHs, compileC, findHsDependencies]
+ghcBuilderArgs = mconcat [compileAndLinkHs, compileC, findHsDependencies, ghcInGhciArgs]
+
+ghcInGhciArgs :: Args
+ghcInGhciArgs = builder (Ghc GhcInGhci) ? mconcat [commonGhcArgs, arg "-fno-worker-wrapper"
+ , arg "-O0" ]
compileAndLinkHs :: Args
compileAndLinkHs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do
diff --git a/hadrian/src/Settings/Warnings.hs b/hadrian/src/Settings/Warnings.hs
index 42e7662..393856d 100644
--- a/hadrian/src/Settings/Warnings.hs
+++ b/hadrian/src/Settings/Warnings.hs
@@ -23,7 +23,7 @@ ghcWarningsArgs = do
isIntegerSimple <- (== integerSimple) <$> getIntegerPackage
mconcat
[ stage0 ? mconcat
- [ libraryPackage ? pure [ "-fno-warn-deprecated-flags" ]
+ [ libraryPackage ? pure [ "-fno-warn-deprecated-flags -O0" ]
, package terminfo ? pure [ "-fno-warn-unused-imports" ]
, package transformers ? pure [ "-fno-warn-unused-matches"
, "-fno-warn-unused-imports" ] ]
More information about the ghc-commits
mailing list