[commit: ghc] master: Modifications to support loading GHC into GHCi (60ecf43)
git at git.haskell.org
git at git.haskell.org
Fri Jul 27 17:43:50 UTC 2018
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/60ecf43a5a0b1cc732560058a06ca5b2f2e27773/ghc
>---------------------------------------------------------------
commit 60ecf43a5a0b1cc732560058a06ca5b2f2e27773
Author: Michael Sloan <mgsloan at gmail.com>
Date: Thu Jul 26 17:21:08 2018 -0400
Modifications to support loading GHC into GHCi
This change was previously part of
[D4904](https://phabricator.haskell.org/D4904), but is being split off
to aid in getting this reviewed and merged.
* The compiler code is built with `NoImplicitPrelude`, but GHCi's
modules are incompatible with it. So, this adds the pragma to all GHCi
modules that didn't have it, and adds imports of Prelude.
* In order to run GHC within itself, a `call of 'initGCStatistics`
needed to be skipped. This uses CPP to skip it when
`-DGHC_LOADED_INTO_GHCI` is set.
* There is an environment variable workaround suggested by Ben Gamari
[1], where `_GHC_TOP_DIR` can be used to specify GHC's top dir if `-B`
isn't provided. This can be used to solve a problem where the GHC being
run within GHCi attempts to look in `inplace/lib/lib/` instead of
`inplace/lib/`.
[1]: https://phabricator.haskell.org/D4904#135438
Reviewers: goldfire, bgamari, erikd, alpmestan
Reviewed By: alpmestan
Subscribers: alpmestan, lelf, rwbarton, thomie, carter
Differential Revision: https://phabricator.haskell.org/D4986
>---------------------------------------------------------------
60ecf43a5a0b1cc732560058a06ca5b2f2e27773
compiler/main/SysTools/BaseDir.hs | 22 ++++++++++++++++------
ghc/GHCi/Leak.hs | 1 +
ghc/GHCi/UI/Tags.hs | 5 +++--
ghc/Main.hs | 14 ++++++++++++++
ghc/ghc-bin.cabal.in | 5 +++++
.../template-haskell/Language/Haskell/TH/Lib.hs | 1 +
.../Language/Haskell/TH/Lib/Internal.hs | 1 +
.../Language/Haskell/TH/Lib/Map.hs | 2 ++
.../template-haskell/Language/Haskell/TH/Quote.hs | 1 +
.../template-haskell/Language/Haskell/TH/Syntax.hs | 1 +
libraries/template-haskell/template-haskell.cabal | 5 +++++
11 files changed, 50 insertions(+), 8 deletions(-)
diff --git a/compiler/main/SysTools/BaseDir.hs b/compiler/main/SysTools/BaseDir.hs
index 85635df..625baec 100644
--- a/compiler/main/SysTools/BaseDir.hs
+++ b/compiler/main/SysTools/BaseDir.hs
@@ -22,6 +22,7 @@ import GhcPrelude
import Panic
+import System.Environment (lookupEnv)
import System.FilePath
import Data.List
@@ -115,12 +116,21 @@ findTopDir :: Maybe String -- Maybe TopDir path (without the '-B' prefix).
-> IO String -- TopDir (in Unix format '/' separated)
findTopDir (Just minusb) = return (normalise minusb)
findTopDir Nothing
- = do -- Get directory of executable
- maybe_exec_dir <- getBaseDir
- case maybe_exec_dir of
- -- "Just" on Windows, "Nothing" on unix
- Nothing -> throwGhcExceptionIO (InstallationError "missing -B<dir> option")
- Just dir -> return dir
+ = do -- The _GHC_TOP_DIR environment variable can be used to specify
+ -- the top dir when the -B argument is not specified. It is not
+ -- intended for use by users, it was added specifically for the
+ -- purpose of running GHC within GHCi.
+ maybe_env_top_dir <- lookupEnv "_GHC_TOP_DIR"
+ case maybe_env_top_dir of
+ Just env_top_dir -> return env_top_dir
+ Nothing -> do
+ -- Get directory of executable
+ maybe_exec_dir <- getBaseDir
+ case maybe_exec_dir of
+ -- "Just" on Windows, "Nothing" on unix
+ Nothing -> throwGhcExceptionIO $
+ InstallationError "missing -B<dir> option"
+ Just dir -> return dir
getBaseDir :: IO (Maybe String)
#if defined(mingw32_HOST_OS)
diff --git a/ghc/GHCi/Leak.hs b/ghc/GHCi/Leak.hs
index aec1ab5..47fed9c 100644
--- a/ghc/GHCi/Leak.hs
+++ b/ghc/GHCi/Leak.hs
@@ -16,6 +16,7 @@ import GHC.Types (IO (..))
import HscTypes
import Outputable
import Platform (target32Bit)
+import Prelude
import System.Mem
import System.Mem.Weak
import UniqDFM
diff --git a/ghc/GHCi/UI/Tags.hs b/ghc/GHCi/UI/Tags.hs
index d8af7f8..09a8406 100644
--- a/ghc/GHCi/UI/Tags.hs
+++ b/ghc/GHCi/UI/Tags.hs
@@ -25,13 +25,14 @@ import OccName (pprOccName)
import ConLike
import MonadUtils
+import Control.Monad
import Data.Function
+import Data.List
import Data.Maybe
import Data.Ord
import DriverPhases
import Panic
-import Data.List
-import Control.Monad
+import Prelude
import System.Directory
import System.IO
import System.IO.Error
diff --git a/ghc/Main.hs b/ghc/Main.hs
index 276546b..ea80910 100644
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -74,6 +74,7 @@ import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
+import Prelude
-----------------------------------------------------------------------------
-- ToDo:
@@ -929,5 +930,18 @@ people since we're linking GHC dynamically, but most things themselves
link statically.
-}
+-- If GHC_LOADED_INTO_GHCI is not set when GHC is loaded into GHCi, then
+-- running it causes an error like this:
+--
+-- Loading temp shared object failed:
+-- /tmp/ghc13836_0/libghc_1872.so: undefined symbol: initGCStatistics
+--
+-- Skipping the foreign call fixes this problem, and the outer GHCi
+-- should have already made this call anyway.
+#if defined(GHC_LOADED_INTO_GHCI)
+initGCStatistics :: IO ()
+initGCStatistics = return ()
+#else
foreign import ccall safe "initGCStatistics"
initGCStatistics :: IO ()
+#endif
diff --git a/ghc/ghc-bin.cabal.in b/ghc/ghc-bin.cabal.in
index 85a9250..5c51058 100644
--- a/ghc/ghc-bin.cabal.in
+++ b/ghc/ghc-bin.cabal.in
@@ -84,3 +84,8 @@ Executable ghc
CPP
NondecreasingIndentation
TupleSections
+
+ -- This should match the default-extensions used in 'ghc.cabal'. This way,
+ -- GHCi can be used to load it all at once.
+ Default-Extensions:
+ NoImplicitPrelude
diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib.hs b/libraries/template-haskell/Language/Haskell/TH/Lib.hs
index b7966ce..b0aa580 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Lib.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Lib.hs
@@ -151,6 +151,7 @@ import Language.Haskell.TH.Lib.Internal hiding
import Language.Haskell.TH.Syntax
import Control.Monad (liftM2)
+import Prelude
-- All definitions below represent the "old" API, since their definitions are
-- different in Language.Haskell.TH.Lib.Internal. Please think carefully before
diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
index cac8ea8..0ddfddf 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
@@ -18,6 +18,7 @@ import Language.Haskell.TH.Syntax hiding (Role, InjectivityAnn)
import qualified Language.Haskell.TH.Syntax as TH
import Control.Monad( liftM, liftM2 )
import Data.Word( Word8 )
+import Prelude
----------------------------------------------------------
-- * Type synonyms
diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib/Map.hs b/libraries/template-haskell/Language/Haskell/TH/Lib/Map.hs
index ac24151..b11139c 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Lib/Map.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Lib/Map.hs
@@ -16,6 +16,8 @@ module Language.Haskell.TH.Lib.Map
, Language.Haskell.TH.Lib.Map.lookup
) where
+import Prelude
+
data Map k a = Bin {-# UNPACK #-} !Size !k a !(Map k a) !(Map k a)
| Tip
diff --git a/libraries/template-haskell/Language/Haskell/TH/Quote.hs b/libraries/template-haskell/Language/Haskell/TH/Quote.hs
index 91e3739..4ff5a20 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Quote.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Quote.hs
@@ -21,6 +21,7 @@ module Language.Haskell.TH.Quote(
) where
import Language.Haskell.TH.Syntax
+import Prelude
-- | The 'QuasiQuoter' type, a value @q@ of this type can be used
-- in the syntax @[q| ... string to parse ...|]@. In fact, for
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index f5f60c3..4e0a1c9 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -41,6 +41,7 @@ import GHC.Lexeme ( startsVarSym, startsVarId )
import GHC.ForeignSrcLang.Type
import Language.Haskell.TH.LanguageExtensions
import Numeric.Natural
+import Prelude
import qualified Control.Monad.Fail as Fail
diff --git a/libraries/template-haskell/template-haskell.cabal b/libraries/template-haskell/template-haskell.cabal
index 6cd156c..2b2c5db 100644
--- a/libraries/template-haskell/template-haskell.cabal
+++ b/libraries/template-haskell/template-haskell.cabal
@@ -60,3 +60,8 @@ Library
-- We need to set the unit ID to template-haskell (without a
-- version number) as it's magic.
ghc-options: -this-unit-id template-haskell
+
+ -- This should match the default-extensions used in 'ghc.cabal'. This way,
+ -- GHCi can be used to load it along with the compiler.
+ Default-Extensions:
+ NoImplicitPrelude
More information about the ghc-commits
mailing list