summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorShea Levy <shea@shealevy.com>2016-12-20 01:19:18 +0000
committerTamar Christina <tamar@zhox.com>2016-12-20 01:25:48 +0000
commit27f79255634d9789f367273504545c1ebfad90a0 (patch)
tree9d2977cd52f18abcc824dae743ec7c4a3e6f04c0
parentc0c1f801f4ca26f1db68ac527341a1cf051cb7d6 (diff)
downloadhaskell-27f79255634d9789f367273504545c1ebfad90a0.tar.gz
Allow use of the external interpreter in stage1.
Summary: Now that we have -fexternal-interpreter, we can lose most of the GHCI ifdefs. This was originally added in https://phabricator.haskell.org/D2826 but that led to a compatibility issue with ghc 7.10.x on Windows. That's fixed here and the revert reverted. Reviewers: goldfire, hvr, austin, bgamari, Phyx Reviewed By: Phyx Subscribers: thomie Differential Revision: https://phabricator.haskell.org/D2884 GHC Trac Issues: #13008
-rw-r--r--compiler/deSugar/Coverage.hs8
-rw-r--r--compiler/ghc.cabal.in21
-rw-r--r--compiler/ghci/ByteCodeGen.hs4
-rw-r--r--compiler/ghci/ByteCodeInstr.hs4
-rw-r--r--compiler/ghci/ByteCodeTypes.hs6
-rw-r--r--compiler/ghci/GHCi.hsc (renamed from compiler/ghci/GHCi.hs)50
-rw-r--r--compiler/ghci/Linker.hs10
-rw-r--r--compiler/hsSyn/HsExpr.hs13
-rw-r--r--compiler/main/DriverPipeline.hs4
-rw-r--r--compiler/main/DynFlags.hs29
-rw-r--r--compiler/main/GHC.hs38
-rw-r--r--compiler/main/GhcMake.hs8
-rw-r--r--compiler/main/Hooks.hs14
-rw-r--r--compiler/main/HscMain.hs24
-rw-r--r--compiler/main/HscTypes.hs28
-rw-r--r--compiler/main/InteractiveEval.hs7
-rw-r--r--compiler/main/InteractiveEvalTypes.hs9
-rw-r--r--compiler/rename/RnEnv.hs4
-rw-r--r--compiler/rename/RnSplice.hs22
-rw-r--r--compiler/simplCore/CoreMonad.hs8
-rw-r--r--compiler/specialise/SpecConstr.hs19
-rw-r--r--compiler/typecheck/TcAnnotations.hs19
-rw-r--r--compiler/typecheck/TcRnDriver.hs23
-rw-r--r--compiler/typecheck/TcRnMonad.hs16
-rw-r--r--compiler/typecheck/TcRnTypes.hs8
-rw-r--r--compiler/typecheck/TcSplice.hs20
-rw-r--r--compiler/typecheck/TcSplice.hs-boot4
-rw-r--r--ghc.mk5
-rw-r--r--libraries/ghci/GHCi/BreakArray.hs6
-rw-r--r--libraries/ghci/GHCi/InfoTable.hsc125
-rw-r--r--libraries/ghci/GHCi/Message.hs33
-rw-r--r--libraries/ghci/GHCi/Run.hs13
-rw-r--r--libraries/ghci/ghci.cabal.in21
33 files changed, 218 insertions, 405 deletions
diff --git a/compiler/deSugar/Coverage.hs b/compiler/deSugar/Coverage.hs
index 51bfb1811d..1f6effa6b9 100644
--- a/compiler/deSugar/Coverage.hs
+++ b/compiler/deSugar/Coverage.hs
@@ -7,12 +7,14 @@
module Coverage (addTicksToBinds, hpcInitCode) where
-#ifdef GHCI
import qualified GHCi
import GHCi.RemoteTypes
import Data.Array
import ByteCodeTypes
+#if MIN_VERSION_base(4,9,0)
import GHC.Stack.CCS
+#else
+import GHC.Stack as GHC.Stack.CCS
#endif
import Type
import HsSyn
@@ -129,9 +131,6 @@ guessSourceFile binds orig_file =
mkModBreaks :: HscEnv -> Module -> Int -> [MixEntry_] -> IO ModBreaks
-#ifndef GHCI
-mkModBreaks _hsc_env _mod _count _entries = return emptyModBreaks
-#else
mkModBreaks hsc_env mod count entries
| HscInterpreted <- hscTarget (hsc_dflags hsc_env) = do
breakArray <- GHCi.newBreakArray hsc_env (length entries)
@@ -165,7 +164,6 @@ mkCCSArray hsc_env modul count entries = do
mk_one (srcspan, decl_path, _, _) = (name, src)
where name = concat (intersperse "." decl_path)
src = showSDoc dflags (ppr srcspan)
-#endif
writeMixEntries
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 4875753a1c..99bb463f54 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -64,6 +64,7 @@ Library
transformers == 0.5.*,
ghc-boot == @ProjectVersionMunged@,
ghc-boot-th == @ProjectVersionMunged@,
+ ghci == @ProjectVersionMunged@,
hoopl >= 3.10.2 && < 3.11
if os(windows)
@@ -73,9 +74,6 @@ Library
Build-Depends: terminfo == 0.4.*
Build-Depends: unix == 2.7.*
- if flag(ghci)
- Build-Depends: ghci == @ProjectVersionMunged@
-
GHC-Options: -Wall -fno-warn-name-shadowing
if flag(ghci)
@@ -605,16 +603,6 @@ Library
Dwarf
Dwarf.Types
Dwarf.Constants
-
- if !flag(stage1)
- -- ghc:Serialized moved to ghc-boot:GHC.Serialized. So for
- -- compatibility with GHC 7.10 and earlier, we reexport it
- -- under the old name.
- reexported-modules:
- ghc-boot:GHC.Serialized as Serialized
-
- if flag(ghci)
- Exposed-Modules:
Convert
ByteCodeTypes
ByteCodeAsm
@@ -627,3 +615,10 @@ Library
RtClosureInspect
DebuggerUtils
GHCi
+
+ if !flag(stage1)
+ -- ghc:Serialized moved to ghc-boot:GHC.Serialized. So for
+ -- compatibility with GHC 7.10 and earlier, we reexport it
+ -- under the old name.
+ reexported-modules:
+ ghc-boot:GHC.Serialized as Serialized
diff --git a/compiler/ghci/ByteCodeGen.hs b/compiler/ghci/ByteCodeGen.hs
index 0e7aea493e..9a5e4141f1 100644
--- a/compiler/ghci/ByteCodeGen.hs
+++ b/compiler/ghci/ByteCodeGen.hs
@@ -66,7 +66,11 @@ import qualified Data.Map as Map
import qualified Data.IntMap as IntMap
import qualified FiniteMap as Map
import Data.Ord
+#if MIN_VERSION_base(4,9,0)
import GHC.Stack.CCS
+#else
+import GHC.Stack as GHC.Stack.CCS
+#endif
-- -----------------------------------------------------------------------------
-- Generating byte code for a complete module
diff --git a/compiler/ghci/ByteCodeInstr.hs b/compiler/ghci/ByteCodeInstr.hs
index f1f6f70e57..43444321de 100644
--- a/compiler/ghci/ByteCodeInstr.hs
+++ b/compiler/ghci/ByteCodeInstr.hs
@@ -30,7 +30,11 @@ import PrimOp
import SMRep
import Data.Word
+#if MIN_VERSION_base(4,9,0)
import GHC.Stack.CCS (CostCentre)
+#else
+import GHC.Stack (CostCentre)
+#endif
-- ----------------------------------------------------------------------------
-- Bytecode instructions
diff --git a/compiler/ghci/ByteCodeTypes.hs b/compiler/ghci/ByteCodeTypes.hs
index 3537a2bff3..ec962c886b 100644
--- a/compiler/ghci/ByteCodeTypes.hs
+++ b/compiler/ghci/ByteCodeTypes.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MagicHash, RecordWildCards, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE CPP, MagicHash, RecordWildCards, GeneralizedNewtypeDeriving #-}
--
-- (c) The University of Glasgow 2002-2006
--
@@ -34,7 +34,11 @@ import Data.Array.Base ( UArray(..) )
import Data.ByteString (ByteString)
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
+#if MIN_VERSION_base(4,9,0)
import GHC.Stack.CCS
+#else
+import GHC.Stack as GHC.Stack.CCS
+#endif
-- -----------------------------------------------------------------------------
-- Compiled Byte Code
diff --git a/compiler/ghci/GHCi.hs b/compiler/ghci/GHCi.hsc
index 472251db04..4503034971 100644
--- a/compiler/ghci/GHCi.hs
+++ b/compiler/ghci/GHCi.hsc
@@ -46,7 +46,9 @@ module GHCi
) where
import GHCi.Message
+#ifdef GHCI
import GHCi.Run
+#endif
import GHCi.RemoteTypes
import GHCi.ResolvedBCO
import GHCi.BreakArray (BreakArray)
@@ -71,13 +73,23 @@ import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as LB
import Data.IORef
import Foreign hiding (void)
+#if MIN_VERSION_base(4,9,0)
import GHC.Stack.CCS (CostCentre,CostCentreStack)
+#else
+import GHC.Stack (CostCentre,CostCentreStack)
+#endif
import System.Exit
import Data.Maybe
import GHC.IO.Handle.Types (Handle)
#ifdef mingw32_HOST_OS
import Foreign.C
import GHC.IO.Handle.FD (fdToHandle)
+#if !MIN_VERSION_process(1,4,2)
+import System.Posix.Internals
+import Foreign.Marshal.Array
+import Foreign.C.Error
+import Foreign.Storable
+#endif
#else
import System.Posix as Posix
#endif
@@ -148,6 +160,12 @@ Other Notes on Remote GHCi
* Note [Remote Template Haskell] in libraries/ghci/GHCi/TH.hs
-}
+#ifndef GHCI
+needExtInt :: IO a
+needExtInt = throwIO
+ (InstallationError "this operation requires -fexternal-interpreter")
+#endif
+
-- | Run a command in the interpreter's context. With
-- @-fexternal-interpreter@, the command is serialized and sent to an
-- external iserv process, and the response is deserialized (hence the
@@ -160,8 +178,11 @@ iservCmd hsc_env@HscEnv{..} msg
uninterruptibleMask_ $ do -- Note [uninterruptibleMask_]
iservCall iserv msg
| otherwise = -- Just run it directly
+#ifdef GHCI
run msg
-
+#else
+ needExtInt
+#endif
-- Note [uninterruptibleMask_ and iservCmd]
--
@@ -357,7 +378,11 @@ lookupSymbol hsc_env@HscEnv{..} str
writeIORef iservLookupSymbolCache $! addToUFM cache str p
return (Just p)
| otherwise =
+#ifdef GHCI
fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str))
+#else
+ needExtInt
+#endif
lookupClosure :: HscEnv -> String -> IO (Maybe HValueRef)
lookupClosure hsc_env str =
@@ -512,6 +537,23 @@ runWithPipes createProc prog opts = do
return (ph, rh, wh)
where mkHandle :: CInt -> IO Handle
mkHandle fd = (fdToHandle fd) `onException` (c__close fd)
+
+#if !MIN_VERSION_process(1,4,2)
+-- This #include and the _O_BINARY below are the only reason this is hsc,
+-- so we can remove that once we can depend on process 1.4.2
+#include <fcntl.h>
+
+createPipeFd :: IO (FD, FD)
+createPipeFd = do
+ allocaArray 2 $ \ pfds -> do
+ throwErrnoIfMinus1_ "_pipe" $ c__pipe pfds 2 (#const _O_BINARY)
+ readfd <- peek pfds
+ writefd <- peekElemOff pfds 1
+ return (readfd, writefd)
+
+foreign import ccall "io.h _pipe" c__pipe ::
+ Ptr CInt -> CUInt -> CInt -> IO CInt
+#endif
#else
runWithPipes createProc prog opts = do
(rfd1, wfd1) <- Posix.createPipe -- we read on rfd1
@@ -603,8 +645,14 @@ wormholeRef dflags r
| gopt Opt_ExternalInterpreter dflags
= throwIO (InstallationError
"this operation requires -fno-external-interpreter")
+#ifdef GHCI
| otherwise
= localRef r
+#else
+ | otherwise
+ = throwIO (InstallationError
+ "can't wormhole a value in a stage1 compiler")
+#endif
-- -----------------------------------------------------------------------------
-- Misc utils
diff --git a/compiler/ghci/Linker.hs b/compiler/ghci/Linker.hs
index 7379c46772..6a0483ce1b 100644
--- a/compiler/ghci/Linker.hs
+++ b/compiler/ghci/Linker.hs
@@ -709,6 +709,16 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods
adjust_ul _ (DotA fp) = panic ("adjust_ul DotA " ++ show fp)
adjust_ul _ (DotDLL fp) = panic ("adjust_ul DotDLL " ++ show fp)
adjust_ul _ l@(BCOs {}) = return l
+#if !MIN_VERSION_filepath(1,4,1)
+ stripExtension :: String -> FilePath -> Maybe FilePath
+ stripExtension [] path = Just path
+ stripExtension ext@(x:_) path = stripSuffix dotExt path
+ where dotExt = if isExtSeparator x then ext else '.':ext
+
+ stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]
+ stripSuffix xs ys = fmap reverse $ stripPrefix (reverse xs) (reverse ys)
+#endif
+
{- **********************************************************************
diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs
index 8cead39c68..d695d8e651 100644
--- a/compiler/hsSyn/HsExpr.hs
+++ b/compiler/hsSyn/HsExpr.hs
@@ -48,10 +48,8 @@ import Data.Data hiding (Fixity(..))
import qualified Data.Data as Data (Fixity(..))
import Data.Maybe (isNothing)
-#ifdef GHCI
import GHCi.RemoteTypes ( ForeignRef )
import qualified Language.Haskell.TH as TH (Q)
-#endif
{-
************************************************************************
@@ -2047,24 +2045,13 @@ isTypedSplice _ = False -- Quasi-quotes are untyped splices
-- See Note [Delaying modFinalizers in untyped splices] in RnSplice. For how
-- this is used.
--
-#ifdef GHCI
newtype ThModFinalizers = ThModFinalizers [ForeignRef (TH.Q ())]
-#else
-data ThModFinalizers = ThModFinalizers
-#endif
-- A Data instance which ignores the argument of 'ThModFinalizers'.
-#ifdef GHCI
instance Data ThModFinalizers where
gunfold _ z _ = z $ ThModFinalizers []
toConstr a = mkConstr (dataTypeOf a) "ThModFinalizers" [] Data.Prefix
dataTypeOf a = mkDataType "HsExpr.ThModFinalizers" [toConstr a]
-#else
-instance Data ThModFinalizers where
- gunfold _ z _ = z ThModFinalizers
- toConstr a = mkConstr (dataTypeOf a) "ThModFinalizers" [] Data.Prefix
- dataTypeOf a = mkDataType "HsExpr.ThModFinalizers" [toConstr a]
-#endif
-- | Haskell Spliced Thing
--
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index ea0c6eded1..133bdde283 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -2054,11 +2054,7 @@ doCpp dflags raw input_fn output_fn = do
backend_defs <- getBackendDefs dflags
-#ifdef GHCI
let th_defs = [ "-D__GLASGOW_HASKELL_TH__" ]
-#else
- let th_defs = [ "-D__GLASGOW_HASKELL_TH__=0" ]
-#endif
-- Default CPP defines in Haskell source
ghcVersionH <- getGhcVersionPathName dflags
let hsSourceCppOpts = [ "-include", ghcVersionH ]
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index aee5edce85..6ecf8ca9a9 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -124,9 +124,7 @@ module DynFlags (
-- * Compiler configuration suitable for display to the user
compilerInfo,
-#ifdef GHCI
rtsIsProfiled,
-#endif
dynamicGhc,
#include "GHCConstantsHaskellExports.hs"
@@ -3613,12 +3611,6 @@ supportedExtensions :: [String]
supportedExtensions = concatMap toFlagSpecNamePair xFlags
where
toFlagSpecNamePair flg
-#ifndef GHCI
- -- make sure that `ghc --supported-extensions` omits
- -- "TemplateHaskell" when it's known to be unsupported. See also
- -- GHC #11102 for rationale
- | flagSpecFlag flg == LangExt.TemplateHaskell = [noName]
-#endif
| otherwise = [name, noName]
where
noName = "No" ++ name
@@ -4155,7 +4147,6 @@ foreign import ccall unsafe "rts_isProfiled" rtsIsProfiledIO :: IO CInt
rtsIsProfiled :: Bool
rtsIsProfiled = unsafeDupablePerformIO rtsIsProfiledIO /= 0
-#ifdef GHCI
-- Consult the RTS to find whether GHC itself has been built with
-- dynamic linking. This can't be statically known at compile-time,
-- because we build both the static and dynamic versions together with
@@ -4164,10 +4155,6 @@ foreign import ccall unsafe "rts_isDynamic" rtsIsDynamicIO :: IO CInt
dynamicGhc :: Bool
dynamicGhc = unsafeDupablePerformIO rtsIsDynamicIO /= 0
-#else
-dynamicGhc :: Bool
-dynamicGhc = False
-#endif
setWarnSafe :: Bool -> DynP ()
setWarnSafe True = getCurLoc >>= \l -> upd (\d -> d { warnSafeOnLoc = l })
@@ -4200,24 +4187,8 @@ setIncoherentInsts True = do
upd (\d -> d { incoherentOnLoc = l })
checkTemplateHaskellOk :: TurnOnFlag -> DynP ()
-#ifdef GHCI
checkTemplateHaskellOk _turn_on
= getCurLoc >>= \l -> upd (\d -> d { thOnLoc = l })
-#else
--- In stage 1, Template Haskell is simply illegal, except with -M
--- We don't bleat with -M because there's no problem with TH there,
--- and in fact GHC's build system does ghc -M of the DPH libraries
--- with a stage1 compiler
-checkTemplateHaskellOk turn_on
- | turn_on = do dfs <- liftEwM getCmdLineState
- case ghcMode dfs of
- MkDepend -> return ()
- _ -> addErr msg
- | otherwise = return ()
- where
- msg = "Template Haskell requires GHC with interpreter support\n " ++
- "Perhaps you are using a stage-1 compiler?"
-#endif
{- **********************************************************************
%* *
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index cf066d0ea7..59e42f9c75 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -91,7 +91,6 @@ module GHC (
-- * Interactive evaluation
-#ifdef GHCI
-- ** Executing statements
execStmt, ExecOptions(..), execOptions, ExecResult(..),
resumeExec,
@@ -103,11 +102,10 @@ module GHC (
parseImportDecl,
setContext, getContext,
setGHCiMonad, getGHCiMonad,
-#endif
+
-- ** Inspecting the current context
getBindings, getInsts, getPrintUnqual,
findModule, lookupModule,
-#ifdef GHCI
isModuleTrusted, moduleTrustReqs,
getNamesInScope,
getRdrNamesInScope,
@@ -123,9 +121,8 @@ module GHC (
-- ** Looking up a Name
parseName,
-#endif
lookupName,
-#ifdef GHCI
+
-- ** Compiling expressions
HValue, parseExpr, compileParsedExpr,
InteractiveEval.compileExpr, dynCompileExpr,
@@ -154,7 +151,6 @@ module GHC (
RunResult(..),
runStmt, runStmtWithLocation,
resume,
-#endif
-- * Abstract syntax elements
@@ -290,14 +286,12 @@ module GHC (
#include "HsVersions.h"
-#ifdef GHCI
import ByteCodeTypes
import InteractiveEval
import InteractiveEvalTypes
import TcRnDriver ( runTcInteractive )
import GHCi
import GHCi.RemoteTypes
-#endif
import PprTyThing ( pprFamInst )
import HscMain
@@ -469,9 +463,7 @@ withCleanupSession ghc = ghc `gfinally` cleanup
liftIO $ do
cleanTempFiles dflags
cleanTempDirs dflags
-#ifdef GHCI
stopIServ hsc_env -- shut down the IServ
-#endif
-- exceptions will be blocked while we clean the temporary files,
-- so there shouldn't be any difficulty if we receive further
-- signals.
@@ -889,10 +881,8 @@ typecheckModule pmod = do
minf_rdr_env = Just (tcg_rdr_env tc_gbl_env),
minf_instances = fixSafeInstances safe $ md_insts details,
minf_iface = Nothing,
- minf_safe = safe
-#ifdef GHCI
- ,minf_modBreaks = emptyModBreaks
-#endif
+ minf_safe = safe,
+ minf_modBreaks = emptyModBreaks
}}
-- | Desugar a typechecked module.
@@ -1080,10 +1070,8 @@ data ModuleInfo = ModuleInfo {
minf_rdr_env :: Maybe GlobalRdrEnv, -- Nothing for a compiled/package mod
minf_instances :: [ClsInst],
minf_iface :: Maybe ModIface,
- minf_safe :: SafeHaskellMode
-#ifdef GHCI
- ,minf_modBreaks :: ModBreaks
-#endif
+ minf_safe :: SafeHaskellMode,
+ minf_modBreaks :: ModBreaks
}
-- We don't want HomeModInfo here, because a ModuleInfo applies
-- to package modules too.
@@ -1106,7 +1094,6 @@ getModuleInfo mdl = withSession $ \hsc_env -> do
-- exist... hence the isHomeModule test here. (ToDo: reinstate)
getPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
-#ifdef GHCI
getPackageModuleInfo hsc_env mdl
= do eps <- hscEPS hsc_env
iface <- hscGetModuleInterface hsc_env mdl
@@ -1125,11 +1112,6 @@ getPackageModuleInfo hsc_env mdl
minf_safe = getSafeMode $ mi_trust iface,
minf_modBreaks = emptyModBreaks
}))
-#else
--- bogusly different for non-GHCI (ToDo)
-getPackageModuleInfo _hsc_env _mdl = do
- return Nothing
-#endif
getHomeModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
getHomeModuleInfo hsc_env mdl =
@@ -1145,9 +1127,7 @@ getHomeModuleInfo hsc_env mdl =
minf_instances = md_insts details,
minf_iface = Just iface,
minf_safe = getSafeMode $ mi_trust iface
-#ifdef GHCI
,minf_modBreaks = getModBreaks hmi
-#endif
}))
-- | The list of top-level entities defined in a module
@@ -1196,10 +1176,8 @@ modInfoIface = minf_iface
modInfoSafe :: ModuleInfo -> SafeHaskellMode
modInfoSafe = minf_safe
-#ifdef GHCI
modInfoModBreaks :: ModuleInfo -> ModBreaks
modInfoModBreaks = minf_modBreaks
-#endif
isDictonaryId :: Id -> Bool
isDictonaryId id
@@ -1219,11 +1197,9 @@ findGlobalAnns deserialize target = withSession $ \hsc_env -> do
ann_env <- liftIO $ prepareAnnotations hsc_env Nothing
return (findAnns deserialize ann_env target)
-#ifdef GHCI
-- | get the GlobalRdrEnv for a session
getGRE :: GhcMonad m => m GlobalRdrEnv
getGRE = withSession $ \hsc_env-> return $ ic_rn_gbl_env (hsc_IC hsc_env)
-#endif
-- -----------------------------------------------------------------------------
@@ -1422,7 +1398,6 @@ lookupLoadedHomeModule mod_name = withSession $ \hsc_env ->
Just mod_info -> return (Just (mi_module (hm_iface mod_info)))
_not_a_home_module -> return Nothing
-#ifdef GHCI
-- | Check that a module is safe to import (according to Safe Haskell).
--
-- We return True to indicate the import is safe and False otherwise
@@ -1464,7 +1439,6 @@ obtainTermFromId :: GhcMonad m => Int -> Bool -> Id -> m Term
obtainTermFromId bound force id = withSession $ \hsc_env ->
liftIO $ InteractiveEval.obtainTermFromId hsc_env bound force id
-#endif
-- | Returns the 'TyThing' for a 'Name'. The 'Name' may refer to any
-- entity known to GHC, including 'Name's defined using 'runStmt'.
diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs
index 6b103c9e1b..be6510bcb2 100644
--- a/compiler/main/GhcMake.hs
+++ b/compiler/main/GhcMake.hs
@@ -31,9 +31,7 @@ module GhcMake(
#include "HsVersions.h"
-#ifdef GHCI
import qualified Linker ( unload )
-#endif
import DriverPhases
import DriverPipeline
@@ -563,13 +561,7 @@ findPartiallyCompletedCycles modsDone theGraph
unload :: HscEnv -> [Linkable] -> IO ()
unload hsc_env stable_linkables -- Unload everthing *except* 'stable_linkables'
= case ghcLink (hsc_dflags hsc_env) of
-#ifdef GHCI
LinkInMemory -> Linker.unload hsc_env stable_linkables
-#else
- LinkInMemory -> panic "unload: no interpreter"
- -- urgh. avoid warnings:
- hsc_env stable_linkables
-#endif
_other -> return ()
-- -----------------------------------------------------------------------------
diff --git a/compiler/main/Hooks.hs b/compiler/main/Hooks.hs
index 8d706d8fa5..eefdde4b88 100644
--- a/compiler/main/Hooks.hs
+++ b/compiler/main/Hooks.hs
@@ -15,18 +15,14 @@ module Hooks ( Hooks
, tcForeignImportsHook
, tcForeignExportsHook
, hscFrontendHook
-#ifdef GHCI
, hscCompileCoreExprHook
-#endif
, ghcPrimIfaceHook
, runPhaseHook
, runMetaHook
, linkHook
, runRnSpliceHook
-#ifdef GHCI
, getValueSafelyHook
, createIservProcessHook
-#endif
) where
import DynFlags
@@ -42,12 +38,10 @@ import TcRnTypes
import Bag
import RdrName
import CoreSyn
-#ifdef GHCI
import GHCi.RemoteTypes
import SrcLoc
import Type
import System.Process
-#endif
import BasicTypes
import Data.Maybe
@@ -70,18 +64,14 @@ emptyHooks = Hooks
, tcForeignImportsHook = Nothing
, tcForeignExportsHook = Nothing
, hscFrontendHook = Nothing
-#ifdef GHCI
, hscCompileCoreExprHook = Nothing
-#endif
, ghcPrimIfaceHook = Nothing
, runPhaseHook = Nothing
, runMetaHook = Nothing
, linkHook = Nothing
, runRnSpliceHook = Nothing
-#ifdef GHCI
, getValueSafelyHook = Nothing
, createIservProcessHook = Nothing
-#endif
}
data Hooks = Hooks
@@ -89,18 +79,14 @@ data Hooks = Hooks
, tcForeignImportsHook :: Maybe ([LForeignDecl Name] -> TcM ([Id], [LForeignDecl Id], Bag GlobalRdrElt))
, tcForeignExportsHook :: Maybe ([LForeignDecl Name] -> TcM (LHsBinds TcId, [LForeignDecl TcId], Bag GlobalRdrElt))
, hscFrontendHook :: Maybe (ModSummary -> Hsc FrontendResult)
-#ifdef GHCI
, hscCompileCoreExprHook :: Maybe (HscEnv -> SrcSpan -> CoreExpr -> IO ForeignHValue)
-#endif
, ghcPrimIfaceHook :: Maybe ModIface
, runPhaseHook :: Maybe (PhasePlus -> FilePath -> DynFlags -> CompPipeline (PhasePlus, FilePath))
, runMetaHook :: Maybe (MetaHook TcM)
, linkHook :: Maybe (GhcLink -> DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag)
, runRnSpliceHook :: Maybe (HsSplice Name -> RnM (HsSplice Name))
-#ifdef GHCI
, getValueSafelyHook :: Maybe (HscEnv -> Name -> Type -> IO (Maybe HValue))
, createIservProcessHook :: Maybe (CreateProcess -> IO ProcessHandle)
-#endif
}
getHooked :: (Functor f, HasDynFlags f) => (Hooks -> Maybe a) -> a -> f a
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 9a64794b77..7d809126bf 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -59,7 +59,6 @@ module HscMain
, hscParseIdentifier
, hscTcRcLookupName
, hscTcRnGetInfo
-#ifdef GHCI
, hscIsGHCiMonad
, hscGetModuleInterface
, hscRnImportDecls
@@ -71,7 +70,6 @@ module HscMain
, hscCompileCoreExpr
-- * Low-level exports for hooks
, hscCompileCoreExpr'
-#endif
-- We want to make sure that we export enough to be able to redefine
-- hscFileFrontEnd in client code
, hscParse', hscSimplify', hscDesugar', tcRnModule'
@@ -83,7 +81,6 @@ module HscMain
, showModuleIndex
) where
-#ifdef GHCI
import Id
import GHCi.RemoteTypes ( ForeignHValue )
import ByteCodeGen ( byteCodeGen, coreExprToBCOs )
@@ -96,7 +93,6 @@ import VarEnv ( emptyTidyEnv )
import Panic
import ConLike
import Control.Concurrent
-#endif
import Module
import Packages
@@ -178,9 +174,7 @@ newHscEnv dflags = do
us <- mkSplitUniqSupply 'r'
nc_var <- newIORef (initNameCache us knownKeyNames)
fc_var <- newIORef emptyInstalledModuleEnv
-#ifdef GHCI
iserv_mvar <- newMVar Nothing
-#endif
return HscEnv { hsc_dflags = dflags
, hsc_targets = []
, hsc_mod_graph = []
@@ -190,9 +184,7 @@ newHscEnv dflags = do
, hsc_NC = nc_var
, hsc_FC = fc_var
, hsc_type_env_var = Nothing
-#ifdef GHCI
, hsc_iserv = iserv_mvar
-#endif
}
-- -----------------------------------------------------------------------------
@@ -262,13 +254,11 @@ ioMsgMaybe' ioA = do
-- -----------------------------------------------------------------------------
-- | Lookup things in the compiler's environment
-#ifdef GHCI
hscTcRnLookupRdrName :: HscEnv -> Located RdrName -> IO [Name]
hscTcRnLookupRdrName hsc_env0 rdr_name
= runInteractiveHsc hsc_env0 $
do { hsc_env <- getHscEnv
; ioMsgMaybe $ tcRnLookupRdrName hsc_env rdr_name }
-#endif
hscTcRcLookupName :: HscEnv -> Name -> IO (Maybe TyThing)
hscTcRcLookupName hsc_env0 name = runInteractiveHsc hsc_env0 $ do
@@ -284,7 +274,6 @@ hscTcRnGetInfo hsc_env0 name
do { hsc_env <- getHscEnv
; ioMsgMaybe' $ tcRnGetInfo hsc_env name }
-#ifdef GHCI
hscIsGHCiMonad :: HscEnv -> String -> IO Name
hscIsGHCiMonad hsc_env name
= runHsc hsc_env $ ioMsgMaybe $ isGHCiMonad hsc_env name
@@ -300,7 +289,6 @@ hscRnImportDecls :: HscEnv -> [LImportDecl RdrName] -> IO GlobalRdrEnv
hscRnImportDecls hsc_env0 import_decls = runInteractiveHsc hsc_env0 $ do
hsc_env <- getHscEnv
ioMsgMaybe $ tcRnImportDecls hsc_env import_decls
-#endif
-- -----------------------------------------------------------------------------
-- | parse a file, returning the abstract syntax
@@ -1073,7 +1061,6 @@ hscCheckSafe' dflags m l = do
let pkgIfaceT = eps_PIT hsc_eps
homePkgT = hsc_HPT hsc_env
iface = lookupIfaceByModule dflags homePkgT pkgIfaceT m
-#ifdef GHCI
-- the 'lookupIfaceByModule' method will always fail when calling from GHCi
-- as the compiler hasn't filled in the various module tables
-- so we need to call 'getModuleInterface' to load from disk
@@ -1081,9 +1068,6 @@ hscCheckSafe' dflags m l = do
Just _ -> return iface
Nothing -> snd `fmap` (liftIO $ getModuleInterface hsc_env m)
return iface'
-#else
- return iface
-#endif
isHomePkg :: Module -> Bool
@@ -1320,7 +1304,6 @@ hscInteractive :: HscEnv
-> CgGuts
-> ModSummary
-> IO (Maybe FilePath, CompiledByteCode)
-#ifdef GHCI
hscInteractive hsc_env cgguts mod_summary = do
let dflags = hsc_dflags hsc_env
let CgGuts{ -- This is the last use of the ModGuts in a compilation.
@@ -1347,9 +1330,6 @@ hscInteractive hsc_env cgguts mod_summary = do
(_istub_h_exists, istub_c_exists)
<- outputForeignStubs dflags this_mod location foreign_stubs
return (istub_c_exists, comp_bc)
-#else
-hscInteractive _ _ = panic "GHC not compiled with interpreter"
-#endif
------------------------------
@@ -1472,7 +1452,6 @@ A naked expression returns a singleton Name [it]. The stmt is lifted into the
IO monad as explained in Note [Interactively-bound Ids in GHCi] in HscTypes
-}
-#ifdef GHCI
-- | Compile a stmt all the way to an HValue, but don't run it
--
-- We return Nothing to indicate an empty statement (or comment only), not a
@@ -1676,7 +1655,6 @@ hscParseStmtWithLocation source linenumber stmt =
hscParseType :: String -> Hsc (LHsType RdrName)
hscParseType = hscParseThing parseType
-#endif
hscParseIdentifier :: HscEnv -> String -> IO (Located RdrName)
hscParseIdentifier hsc_env str =
@@ -1713,7 +1691,6 @@ hscParseThingWithLocation source linenumber parser str
%* *
%********************************************************************* -}
-#ifdef GHCI
hscCompileCoreExpr :: HscEnv -> SrcSpan -> CoreExpr -> IO ForeignHValue
hscCompileCoreExpr hsc_env =
lookupHook hscCompileCoreExprHook hscCompileCoreExpr' (hsc_dflags hsc_env) hsc_env
@@ -1742,7 +1719,6 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr
; hval <- linkExpr hsc_env srcspan bcos
; return hval }
-#endif
{- **********************************************************************
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index e5f824f2e4..5b3c058d35 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -14,9 +14,7 @@ module HscTypes (
Target(..), TargetId(..), pprTarget, pprTargetId,
ModuleGraph, emptyMG,
HscStatus(..),
-#ifdef GHCI
IServ(..),
-#endif
-- * Hsc monad
Hsc(..), runHsc, runInteractiveHsc,
@@ -137,12 +135,10 @@ module HscTypes (
#include "HsVersions.h"
-#ifdef GHCI
import ByteCodeTypes
import InteractiveEvalTypes ( Resume )
import GHCi.Message ( Pipe )
import GHCi.RemoteTypes
-#endif
import UniqFM
import HsSyn
@@ -202,10 +198,8 @@ import Data.IORef
import Data.Time
import Exception
import System.FilePath
-#ifdef GHCI
import Control.Concurrent
import System.Process ( ProcessHandle )
-#endif
-- -----------------------------------------------------------------------------
-- Compilation state
@@ -403,11 +397,9 @@ data HscEnv
-- the 'IfGblEnv'. See 'TcRnTypes.tcg_type_env_var' for
-- 'TcRnTypes.TcGblEnv'. See also Note [hsc_type_env_var hack]
-#ifdef GHCI
, hsc_iserv :: MVar (Maybe IServ)
-- ^ interactive server process. Created the first
-- time it is needed.
-#endif
}
-- Note [hsc_type_env_var hack]
@@ -453,14 +445,12 @@ data HscEnv
-- another day.
-#ifdef GHCI
data IServ = IServ
{ iservPipe :: Pipe
, iservProcess :: ProcessHandle
, iservLookupSymbolCache :: IORef (UniqFM (Ptr ()))
, iservPendingFrees :: [HValueRef]
}
-#endif
-- | Retrieve the ExternalPackageState cache.
hscEPS :: HscEnv -> IO ExternalPackageState
@@ -1490,10 +1480,8 @@ data InteractiveContext
ic_default :: Maybe [Type],
-- ^ The current default types, set by a 'default' declaration
-#ifdef GHCI
ic_resume :: [Resume],
-- ^ The stack of breakpoint contexts
-#endif
ic_monad :: Name,
-- ^ The monad that GHCi is executing in
@@ -1531,9 +1519,7 @@ emptyInteractiveContext dflags
ic_monad = ioTyConName, -- IO monad by default
ic_int_print = printName, -- System.IO.print by default
ic_default = Nothing,
-#ifdef GHCI
ic_resume = [],
-#endif
ic_cwd = Nothing }
icInteractiveModule :: InteractiveContext -> Module
@@ -2950,25 +2936,11 @@ data Unlinked
| DotDLL FilePath -- ^ Dynamically linked library file (.so, .dll, .dylib)
| BCOs CompiledByteCode -- ^ A byte-code object, lives only in memory
-#ifndef GHCI
-data CompiledByteCode = CompiledByteCodeUndefined
-_unusedCompiledByteCode :: CompiledByteCode
-_unusedCompiledByteCode = CompiledByteCodeUndefined
-
-data ModBreaks = ModBreaksUndefined
-emptyModBreaks :: ModBreaks
-emptyModBreaks = ModBreaksUndefined
-#endif
-
instance Outputable Unlinked where
ppr (DotO path) = text "DotO" <+> text path
ppr (DotA path) = text "DotA" <+> text path
ppr (DotDLL path) = text "DotDLL" <+> text path
-#ifdef GHCI
ppr (BCOs bcos) = text "BCOs" <+> ppr bcos
-#else
- ppr (BCOs _) = text "No byte code"
-#endif
-- | Is this an actual file on disk we can link in somehow?
isObject :: Unlinked -> Bool
diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index a421c72baf..3cb1856725 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -10,7 +10,6 @@
-- -----------------------------------------------------------------------------
module InteractiveEval (
-#ifdef GHCI
Resume(..), History(..),
execStmt, ExecOptions(..), execOptions, ExecResult(..), resumeExec,
runDecls, runDeclsWithLocation,
@@ -40,17 +39,14 @@ module InteractiveEval (
Term(..), obtainTermFromId, obtainTermFromVal, reconstructType,
-- * Depcreated API (remove in GHC 7.14)
RunResult(..), runStmt, runStmtWithLocation,
-#endif
) where
-#ifdef GHCI
-
#include "HsVersions.h"
import InteractiveEvalTypes
import GHCi
-import GHCi.Run
+import GHCi.Message
import GHCi.RemoteTypes
import GhcMonad
import HscMain
@@ -979,4 +975,3 @@ reconstructType hsc_env bound id = do
mkRuntimeUnkTyVar :: Name -> Kind -> TyVar
mkRuntimeUnkTyVar name kind = mkTcTyVar name kind RuntimeUnk
-#endif /* GHCI */
diff --git a/compiler/main/InteractiveEvalTypes.hs b/compiler/main/InteractiveEvalTypes.hs
index 34ae2ccaa0..cb0121950f 100644
--- a/compiler/main/InteractiveEvalTypes.hs
+++ b/compiler/main/InteractiveEvalTypes.hs
@@ -9,15 +9,11 @@
-- -----------------------------------------------------------------------------
module InteractiveEvalTypes (
-#ifdef GHCI
Resume(..), History(..), ExecResult(..),
SingleStep(..), isStep, ExecOptions(..),
BreakInfo(..)
-#endif
) where
-#ifdef GHCI
-
import GHCi.RemoteTypes
import GHCi.Message (EvalExpr, ResumeContext)
import Id
@@ -29,7 +25,11 @@ import SrcLoc
import Exception
import Data.Word
+#if MIN_VERSION_base(4,9,0)
import GHC.Stack.CCS
+#else
+import GHC.Stack as GHC.Stack.CCS
+#endif
data ExecOptions
= ExecOptions
@@ -91,4 +91,3 @@ data History
historyBreakInfo :: BreakInfo,
historyEnclosingDecls :: [String] -- declarations enclosing the breakpoint
}
-#endif
diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs
index f8969a8e13..97718f88d2 100644
--- a/compiler/rename/RnEnv.hs
+++ b/compiler/rename/RnEnv.hs
@@ -341,16 +341,12 @@ lookupExactOcc_either name
; if name `inLocalRdrEnvScope` lcl_env
then return (Right name)
else
-#ifdef GHCI
do { th_topnames_var <- fmap tcg_th_topnames getGblEnv
; th_topnames <- readTcRef th_topnames_var
; if name `elemNameSet` th_topnames
then return (Right name)
else return (Left exact_nm_err)
}
-#else /* !GHCI */
- return (Left exact_nm_err)
-#endif /* !GHCI */
}
gres -> return (Left (sameNameErr gres)) -- Ugh! See Note [Template Haskell ambiguity]
}
diff --git a/compiler/rename/RnSplice.hs b/compiler/rename/RnSplice.hs
index 0c41ed30b6..ccfd00257b 100644
--- a/compiler/rename/RnSplice.hs
+++ b/compiler/rename/RnSplice.hs
@@ -5,9 +5,7 @@ module RnSplice (
rnSpliceType, rnSpliceExpr, rnSplicePat, rnSpliceDecl,
rnBracket,
checkThLocalName
-#ifdef GHCI
, traceSplice, SpliceInfo(..)
-#endif
) where
#include "HsVersions.h"
@@ -35,7 +33,6 @@ import {-# SOURCE #-} RnExpr ( rnLExpr )
import TcEnv ( checkWellStaged )
import THNames ( liftName )
-#ifdef GHCI
import DynFlags
import FastString
import ErrUtils ( dumpIfSet_dyn_printer )
@@ -57,7 +54,6 @@ import {-# SOURCE #-} TcSplice
import GHCi.RemoteTypes ( ForeignRef )
import qualified Language.Haskell.TH as TH (Q)
-#endif
import qualified GHC.LanguageExtensions as LangExt
@@ -201,23 +197,6 @@ quotedNameStageErr br
= sep [ text "Stage error: the non-top-level quoted name" <+> ppr br
, text "must be used at the same stage at which is is bound" ]
-#ifndef GHCI
-rnTopSpliceDecls :: HsSplice RdrName -> RnM ([LHsDecl RdrName], FreeVars)
-rnTopSpliceDecls e = failTH e "Template Haskell top splice"
-
-rnSpliceType :: HsSplice RdrName -> PostTc Name Kind
- -> RnM (HsType Name, FreeVars)
-rnSpliceType e _ = failTH e "Template Haskell type splice"
-
-rnSpliceExpr :: HsSplice RdrName -> RnM (HsExpr Name, FreeVars)
-rnSpliceExpr e = failTH e "Template Haskell splice"
-
-rnSplicePat :: HsSplice RdrName -> RnM (Either (Pat RdrName) (Pat Name), FreeVars)
-rnSplicePat e = failTH e "Template Haskell pattern splice"
-
-rnSpliceDecl :: SpliceDecl RdrName -> RnM (SpliceDecl Name, FreeVars)
-rnSpliceDecl e = failTH e "Template Haskell declaration splice"
-#else
{-
*********************************************************
@@ -760,7 +739,6 @@ illegalUntypedSplice = text "Untyped splices may not appear in typed brackets"
-- = vcat [ hang (text "In the splice:")
-- 2 (char '$' <> pprParendExpr expr)
-- , text "To see what the splice expanded to, use -ddump-splices" ]
-#endif
checkThLocalName :: Name -> RnM ()
checkThLocalName name
diff --git a/compiler/simplCore/CoreMonad.hs b/compiler/simplCore/CoreMonad.hs
index 03c990a83d..ea94d9b20e 100644
--- a/compiler/simplCore/CoreMonad.hs
+++ b/compiler/simplCore/CoreMonad.hs
@@ -49,16 +49,12 @@ module CoreMonad (
debugTraceMsg, debugTraceMsgS,
dumpIfSet_dyn,
-#ifdef GHCI
-- * Getting 'Name's
thNameToGhcName
-#endif
) where
-#ifdef GHCI
import Name( Name )
import TcRnMonad ( initTcForLookup )
-#endif
import CoreSyn
import HscTypes
import Module
@@ -94,10 +90,8 @@ import Control.Applicative ( Alternative(..) )
import Prelude hiding ( read )
-#ifdef GHCI
import {-# SOURCE #-} TcSplice ( lookupThName_maybe )
import qualified Language.Haskell.TH as TH
-#endif
{-
************************************************************************
@@ -812,7 +806,6 @@ instance MonadThings CoreM where
************************************************************************
-}
-#ifdef GHCI
-- | Attempt to convert a Template Haskell name to one that GHC can
-- understand. Original TH names such as those you get when you use
-- the @'foo@ syntax will be translated to their equivalent GHC name
@@ -823,4 +816,3 @@ thNameToGhcName :: TH.Name -> CoreM (Maybe Name)
thNameToGhcName th_name = do
hsc_env <- getHscEnv
liftIO $ initTcForLookup hsc_env (lookupThName_maybe th_name)
-#endif
diff --git a/compiler/specialise/SpecConstr.hs b/compiler/specialise/SpecConstr.hs
index 60632255d8..2f2087cd2e 100644
--- a/compiler/specialise/SpecConstr.hs
+++ b/compiler/specialise/SpecConstr.hs
@@ -13,10 +13,8 @@ ToDo [Oct 2013]
{-# LANGUAGE CPP #-}
module SpecConstr(
- specConstrProgram
-#ifdef GHCI
- , SpecConstrAnnotation(..)
-#endif
+ specConstrProgram,
+ SpecConstrAnnotation(..)
) where
#include "HsVersions.h"
@@ -61,12 +59,9 @@ import PrelNames ( specTyConName )
import Module
-- See Note [Forcing specialisation]
-#ifndef GHCI
-type SpecConstrAnnotation = ()
-#else
+
import TyCon ( TyCon )
import GHC.Exts( SpecConstrAnnotation(..) )
-#endif
{-
-----------------------------------------------------
@@ -954,11 +949,6 @@ ignoreType :: ScEnv -> Type -> Bool
ignoreDataCon :: ScEnv -> DataCon -> Bool
forceSpecBndr :: ScEnv -> Var -> Bool
-#ifndef GHCI
-ignoreType _ _ = False
-ignoreDataCon _ _ = False
-#else /* GHCI */
-
ignoreDataCon env dc = ignoreTyCon env (dataConTyCon dc)
ignoreType env ty
@@ -969,7 +959,6 @@ ignoreType env ty
ignoreTyCon :: ScEnv -> TyCon -> Bool
ignoreTyCon env tycon
= lookupUFM (sc_annotations env) tycon == Just NoSpecConstr
-#endif /* GHCI */
forceSpecBndr env var = forceSpecFunTy env . snd . splitForAllTys . varType $ var
@@ -984,9 +973,7 @@ forceSpecArgTy env ty
| Just (tycon, tys) <- splitTyConApp_maybe ty
, tycon /= funTyCon
= tyConName tycon == specTyConName
-#ifdef GHCI
|| lookupUFM (sc_annotations env) tycon == Just ForceSpecConstr
-#endif
|| any (forceSpecArgTy env) tys
forceSpecArgTy _ _ = False
diff --git a/compiler/typecheck/TcAnnotations.hs b/compiler/typecheck/TcAnnotations.hs
index 33eb83b401..7b3cc65dd1 100644
--- a/compiler/typecheck/TcAnnotations.hs
+++ b/compiler/typecheck/TcAnnotations.hs
@@ -10,14 +10,10 @@
module TcAnnotations ( tcAnnotations, annCtxt ) where
-#ifdef GHCI
import {-# SOURCE #-} TcSplice ( runAnnotation )
import Module
import DynFlags
import Control.Monad ( when )
-#else
-import DynFlags ( WarnReason(NoReason) )
-#endif
import HsSyn
import Annotations
@@ -26,21 +22,7 @@ import TcRnMonad
import SrcLoc
import Outputable
-#ifndef GHCI
-
-tcAnnotations :: [LAnnDecl Name] -> TcM [Annotation]
--- No GHCI; emit a warning (not an error) and ignore. cf Trac #4268
-tcAnnotations [] = return []
-tcAnnotations anns@(L loc _ : _)
- = do { setSrcSpan loc $ addWarnTc NoReason $
- (text "Ignoring ANN annotation" <> plural anns <> comma
- <+> text "because this is a stage-1 compiler or doesn't support GHCi")
- ; return [] }
-
-#else
-
tcAnnotations :: [LAnnDecl Name] -> TcM [Annotation]
--- GHCI exists, typecheck the annotations
tcAnnotations anns = mapM tcAnnotation anns
tcAnnotation :: LAnnDecl Name -> TcM Annotation
@@ -63,7 +45,6 @@ annProvenanceToTarget :: Module -> AnnProvenance Name -> AnnTarget Name
annProvenanceToTarget _ (ValueAnnProvenance (L _ name)) = NamedTarget name
annProvenanceToTarget _ (TypeAnnProvenance (L _ name)) = NamedTarget name
annProvenanceToTarget mod ModuleAnnProvenance = ModuleTarget mod
-#endif
annCtxt :: (OutputableBndrId id) => AnnDecl id -> SDoc
annCtxt ann
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index 0aa2924966..ad49ca0601 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -14,7 +14,6 @@ https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/TypeChecker
{-# LANGUAGE ScopedTypeVariables #-}
module TcRnDriver (
-#ifdef GHCI
tcRnStmt, tcRnExpr, TcRnExprMode(..), tcRnType,
tcRnImportDecls,
tcRnLookupRdrName,
@@ -22,7 +21,6 @@ module TcRnDriver (
tcRnDeclsi,
isGHCiMonad,
runTcInteractive, -- Used by GHC API clients (Trac #8878)
-#endif
tcRnLookupName,
tcRnGetInfo,
tcRnModule, tcRnModuleTcRnM,
@@ -42,7 +40,6 @@ module TcRnDriver (
missingBootThing,
) where
-#ifdef GHCI
import {-# SOURCE #-} TcSplice ( finishTH )
import RnSplice ( rnTopSpliceDecls, traceSplice, SpliceInfo(..) )
import IfaceEnv( externaliseName )
@@ -54,6 +51,7 @@ import RnExpr
import MkId
import TidyPgm ( globaliseAndTidyId )
import TysWiredIn ( unitTy, mkListTy )
+#ifdef GHCI
import DynamicLoading ( loadPlugins )
import Plugins ( tcPlugin )
#endif
@@ -392,14 +390,12 @@ tcRnSrcDecls explicit_mod_hdr decls
; new_ev_binds <- {-# SCC "simplifyTop" #-}
simplifyTop lie
-#ifdef GHCI
-- Finalizers must run after constraints are simplified, or some types
-- might not be complete when using reify (see #12777).
; (tcg_env, tcl_env) <- run_th_modfinalizers
; setEnvs (tcg_env, tcl_env) $ do {
; finishTH
-#endif /* GHCI */
; traceTc "Tc9" empty
@@ -436,12 +432,9 @@ tcRnSrcDecls explicit_mod_hdr decls
; setGlobalTypeEnv tcg_env' final_type_env
-#ifdef GHCI
}
-#endif /* GHCI */
} }
-#ifdef GHCI
-- | Runs TH finalizers and renames and typechecks the top-level declarations
-- that they could introduce.
run_th_modfinalizers :: TcM (TcGblEnv, TcLclEnv)
@@ -467,7 +460,6 @@ run_th_modfinalizers = do
)
-- addTopDecls can add declarations which add new finalizers.
run_th_modfinalizers
-#endif /* GHCI */
tc_rn_src_decls :: [LHsDecl RdrName]
-> TcM (TcGblEnv, TcLclEnv)
@@ -482,7 +474,6 @@ tc_rn_src_decls ds
; (tcg_env, rn_decls) <- rnTopSrcDecls first_group
-- rnTopSrcDecls fails if there are any errors
-#ifdef GHCI
-- Get TH-generated top-level declarations and make sure they don't
-- contain any splices since we don't handle that at the moment
--
@@ -515,7 +506,6 @@ tc_rn_src_decls ds
; return (tcg_env, appendGroups rn_decls th_rn_decls)
}
-#endif /* GHCI */
-- Type check all declarations
; (tcg_env, tcl_env) <- setGblEnv tcg_env $
@@ -526,12 +516,6 @@ tc_rn_src_decls ds
case group_tail of
{ Nothing -> return (tcg_env, tcl_env)
-#ifndef GHCI
- -- There shouldn't be a splice
- ; Just (SpliceDecl {}, _) ->
- failWithTc (text "Can't do a top-level splice; need a bootstrapped compiler")
- }
-#else
-- If there's a splice, we must carry on
; Just (SpliceDecl (L loc splice) _, rest_ds) ->
do { recordTopLevelSpliceLoc loc
@@ -545,7 +529,6 @@ tc_rn_src_decls ds
tc_rn_src_decls (spliced_decls ++ rest_ds)
}
}
-#endif /* GHCI */
}
{-
@@ -1758,7 +1741,6 @@ lead to duplicate "perhaps you meant..." suggestions (e.g. T5564).
We don't bother with the tcl_th_bndrs environment either.
-}
-#ifdef GHCI
-- | The returned [Id] is the list of new Ids bound by this statement. It can
-- be used to extend the InteractiveContext via extendInteractiveContext.
--
@@ -2260,7 +2242,6 @@ externaliseAndTidyId this_mod id
= do { name' <- externaliseName this_mod (idName id)
; return (globaliseAndTidyId (setIdName id name')) }
-#endif /* GHCi */
{-
************************************************************************
@@ -2270,7 +2251,6 @@ externaliseAndTidyId this_mod id
************************************************************************
-}
-#ifdef GHCI
-- | ASSUMES that the module is either in the 'HomePackageTable' or is
-- a package module with an interface on disk. If neither of these is
-- true, then the result will be an error indicating the interface
@@ -2294,7 +2274,6 @@ tcRnLookupRdrName hsc_env (L loc rdr_name)
; let names = concat names_s
; when (null names) (addErrTc (text "Not in scope:" <+> quotes (ppr rdr_name)))
; return names }
-#endif
tcRnLookupName :: HscEnv -> Name -> IO (Messages, Maybe TyThing)
tcRnLookupName hsc_env name
diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs
index a77541cf3a..8c117f0936 100644
--- a/compiler/typecheck/TcRnMonad.hs
+++ b/compiler/typecheck/TcRnMonad.hs
@@ -177,10 +177,8 @@ import Control.Monad
import Data.Set ( Set )
import qualified Data.Set as Set
-#ifdef GHCI
import {-# SOURCE #-} TcSplice ( runRemoteModFinalizers )
import qualified Data.Map as Map
-#endif
{-
************************************************************************
@@ -218,13 +216,11 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this
dependent_files_var <- newIORef [] ;
static_wc_var <- newIORef emptyWC ;
-#ifdef GHCI
th_topdecls_var <- newIORef [] ;
th_topnames_var <- newIORef emptyNameSet ;
th_modfinalizers_var <- newIORef [] ;
th_state_var <- newIORef Map.empty ;
th_remote_state_var <- newIORef Nothing ;
-#endif /* GHCI */
let {
dflags = hsc_dflags hsc_env ;
@@ -234,13 +230,11 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this
| otherwise = Nothing ;
gbl_env = TcGblEnv {
-#ifdef GHCI
tcg_th_topdecls = th_topdecls_var,
tcg_th_topnames = th_topnames_var,
tcg_th_modfinalizers = th_modfinalizers_var,
tcg_th_state = th_state_var,
tcg_th_remote_state = th_remote_state_var,
-#endif /* GHCI */
tcg_mod = mod,
tcg_semantic_mod =
@@ -1084,13 +1078,8 @@ failIfErrsM :: TcRn ()
-- Useful to avoid error cascades
failIfErrsM = ifErrsM failM (return ())
-#ifdef GHCI
checkTH :: a -> String -> TcRn ()
checkTH _ _ = return () -- OK
-#else
-checkTH :: Outputable a => a -> String -> TcRn ()
-checkTH e what = failTH e what -- Raise an error in a stage-1 compiler
-#endif
failTH :: Outputable a => a -> String -> TcRn x
failTH e what -- Raise an error in a stage-1 compiler
@@ -1611,7 +1600,6 @@ getStageAndBindLevel name
setStage :: ThStage -> TcM a -> TcRn a
setStage s = updLclEnv (\ env -> env { tcl_th_ctxt = s })
-#ifdef GHCI
-- | Adds the given modFinalizers to the global environment and set them to use
-- the current local environment.
addModFinalizersWithLclEnv :: ThModFinalizers -> TcM ()
@@ -1621,10 +1609,6 @@ addModFinalizersWithLclEnv mod_finalizers
updTcRef th_modfinalizers_var $ \fins ->
setLclEnv lcl_env (runRemoteModFinalizers mod_finalizers)
: fins
-#else
-addModFinalizersWithLclEnv :: ThModFinalizers -> TcM ()
-addModFinalizersWithLclEnv ThModFinalizers = return ()
-#endif
{-
************************************************************************
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index ef94fb6310..6d902b32e0 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -181,7 +181,6 @@ import qualified Control.Monad.Fail as MonadFail
#endif
import Data.Set ( Set )
-#ifdef GHCI
import Data.Map ( Map )
import Data.Dynamic ( Dynamic )
import Data.Typeable ( TypeRep )
@@ -189,7 +188,6 @@ import GHCi.Message
import GHCi.RemoteTypes
import qualified Language.Haskell.TH as TH
-#endif
-- | A 'NameShape' is a substitution on 'Name's that can be used
-- to refine the identities of a hole while we are renaming interfaces
@@ -587,7 +585,6 @@ data TcGblEnv
tcg_dependent_files :: TcRef [FilePath], -- ^ dependencies from addDependentFile
-#ifdef GHCI
tcg_th_topdecls :: TcRef [LHsDecl RdrName],
-- ^ Top-level declarations from addTopDecls
@@ -603,7 +600,6 @@ data TcGblEnv
tcg_th_state :: TcRef (Map TypeRep Dynamic),
tcg_th_remote_state :: TcRef (Maybe (ForeignRef (IORef QState))),
-- ^ Template Haskell state
-#endif /* GHCI */
tcg_ev_binds :: Bag EvBind, -- Top-level evidence bindings
@@ -869,7 +865,6 @@ data ThStage -- See Note [Template Haskell state diagram] in TcSplice
-- the result replaces the splice
-- Binding level = 0
-#ifdef GHCI
| RunSplice (TcRef [ForeignRef (TH.Q ())])
-- Set when running a splice, i.e. NOT when renaming or typechecking the
-- Haskell code for the splice. See Note [RunSplice ThLevel].
@@ -884,9 +879,6 @@ data ThStage -- See Note [Template Haskell state diagram] in TcSplice
-- inserts them in the list of finalizers in the global environment.
--
-- See Note [Collecting modFinalizers in typed splices] in "TcSplice".
-#else
- | RunSplice ()
-#endif
| Comp -- Ordinary Haskell code
-- Binding level = 1
diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs
index 1e35eec144..9942107c45 100644
--- a/compiler/typecheck/TcSplice.hs
+++ b/compiler/typecheck/TcSplice.hs
@@ -17,21 +17,15 @@ TcSplice: Template Haskell splices
{-# OPTIONS_GHC -fno-warn-orphans #-}
module TcSplice(
- -- These functions are defined in stage1 and stage2
- -- The raise civilised errors in stage1
tcSpliceExpr, tcTypedBracket, tcUntypedBracket,
-- runQuasiQuoteExpr, runQuasiQuotePat,
-- runQuasiQuoteDecl, runQuasiQuoteType,
runAnnotation,
-#ifdef GHCI
- -- These ones are defined only in stage2, and are
- -- called only in stage2 (ie GHCI is on)
runMetaE, runMetaP, runMetaT, runMetaD, runQuasi,
tcTopSpliceExpr, lookupThName_maybe,
defaultRunMeta, runMeta', runRemoteModFinalizers,
finishTH
-#endif
) where
#include "HsVersions.h"
@@ -51,7 +45,6 @@ import TcEnv
import Control.Monad
-#ifdef GHCI
import GHCi.Message
import GHCi.RemoteTypes
import GHCi
@@ -130,7 +123,6 @@ import Data.Typeable ( typeOf, Typeable, TypeRep, typeRep )
import Data.Data (Data)
import Data.Proxy ( Proxy (..) )
import GHC.Exts ( unsafeCoerce# )
-#endif
{-
************************************************************************
@@ -238,16 +230,6 @@ quotationCtxtDoc br_body
2 (ppr br_body)
-#ifndef GHCI
-tcSpliceExpr e _ = failTH e "Template Haskell splice"
-
--- runQuasiQuoteExpr q = failTH q "quasiquote"
--- runQuasiQuotePat q = failTH q "pattern quasiquote"
--- runQuasiQuoteType q = failTH q "type quasiquote"
--- runQuasiQuoteDecl q = failTH q "declaration quasiquote"
-runAnnotation _ q = failTH q "annotation"
-
-#else
-- The whole of the rest of the file is the else-branch (ie stage2 only)
{-
@@ -2015,5 +1997,3 @@ such fields defined in the module (see the test case
overloadedrecflds/should_fail/T11103.hs). The "proper" fix requires changes to
the TH AST to make it able to represent duplicate record fields.
-}
-
-#endif /* GHCI */
diff --git a/compiler/typecheck/TcSplice.hs-boot b/compiler/typecheck/TcSplice.hs-boot
index 14e479a04e..db75436d4d 100644
--- a/compiler/typecheck/TcSplice.hs-boot
+++ b/compiler/typecheck/TcSplice.hs-boot
@@ -8,12 +8,10 @@ import TcRnTypes( TcM, TcId )
import TcType ( ExpRhoType )
import Annotations ( Annotation, CoreAnnTarget )
-#ifdef GHCI
import HsSyn ( LHsType, LPat, LHsDecl, ThModFinalizers )
import RdrName ( RdrName )
import TcRnTypes ( SpliceType )
import qualified Language.Haskell.TH as TH
-#endif
tcSpliceExpr :: HsSplice Name
-> ExpRhoType
@@ -29,7 +27,6 @@ tcTypedBracket :: HsBracket Name
runAnnotation :: CoreAnnTarget -> LHsExpr Name -> TcM Annotation
-#ifdef GHCI
tcTopSpliceExpr :: SpliceType -> TcM (LHsExpr TcId) -> TcM (LHsExpr TcId)
runMetaE :: LHsExpr TcId -> TcM (LHsExpr RdrName)
@@ -41,4 +38,3 @@ lookupThName_maybe :: TH.Name -> TcM (Maybe Name)
runQuasi :: TH.Q a -> TcM a
runRemoteModFinalizers :: ThModFinalizers -> TcM ()
finishTH :: TcM ()
-#endif
diff --git a/ghc.mk b/ghc.mk
index a06c4a7fae..e52c4c4091 100644
--- a/ghc.mk
+++ b/ghc.mk
@@ -430,7 +430,7 @@ else # CLEANING
# programs such as GHC and ghc-pkg, that we do not assume the stage0
# compiler already has installed (or up-to-date enough).
-PACKAGES_STAGE0 = binary Cabal/Cabal hpc ghc-boot-th ghc-boot hoopl transformers template-haskell
+PACKAGES_STAGE0 = binary Cabal/Cabal hpc ghc-boot-th ghc-boot hoopl transformers template-haskell ghci
ifeq "$(Windows_Host)" "NO"
PACKAGES_STAGE0 += terminfo
endif
@@ -589,6 +589,9 @@ ALL_STAGE1_LIBS += $(foreach lib,$(PACKAGES_STAGE1),$(libraries/$(lib)_dist-inst
endif
BOOT_LIBS = $(foreach lib,$(PACKAGES_STAGE0),$(libraries/$(lib)_dist-boot_v_LIB))
+# Only build internal interpreter support for the stage2 ghci lib
+libraries/ghci_dist-install_CONFIGURE_OPTS += --flags=ghci
+
# ----------------------------------------
# Special magic for the ghc-prim package
diff --git a/libraries/ghci/GHCi/BreakArray.hs b/libraries/ghci/GHCi/BreakArray.hs
index 311bbd6c5e..bece43bdb9 100644
--- a/libraries/ghci/GHCi/BreakArray.hs
+++ b/libraries/ghci/GHCi/BreakArray.hs
@@ -19,14 +19,17 @@
module GHCi.BreakArray
(
BreakArray
+#ifdef GHCI
(BA) -- constructor is exported only for ByteCodeGen
, newBreakArray
, getBreak
, setBreakOn
, setBreakOff
, showBreakArray
+#endif
) where
+#ifdef GHCI
import Control.Monad
import Data.Word
import GHC.Word
@@ -112,3 +115,6 @@ readBA# array i = IO $ \s ->
readBreakArray :: BreakArray -> Int -> IO Word8
readBreakArray (BA array) (I# i) = readBA# array i
+#else
+data BreakArray
+#endif
diff --git a/libraries/ghci/GHCi/InfoTable.hsc b/libraries/ghci/GHCi/InfoTable.hsc
index e4deb3b6ff..8a9dfc2fa0 100644
--- a/libraries/ghci/GHCi/InfoTable.hsc
+++ b/libraries/ghci/GHCi/InfoTable.hsc
@@ -6,9 +6,11 @@
-- We use the RTS data structures directly via hsc2hs.
--
module GHCi.InfoTable
- ( mkConInfoTable
- , peekItbl, StgInfoTable(..)
+ ( peekItbl, StgInfoTable(..)
, conInfoPtr
+#ifdef GHCI
+ , mkConInfoTable
+#endif
) where
#if !defined(TABLES_NEXT_TO_CODE)
@@ -20,6 +22,66 @@ import GHC.Ptr
import GHC.Exts
import System.IO.Unsafe
+type ItblCodes = Either [Word8] [Word32]
+
+-- Get definitions for the structs, constants & config etc.
+#include "Rts.h"
+
+-- Ultra-minimalist version specially for constructors
+#if SIZEOF_VOID_P == 8
+type HalfWord = Word32
+#elif SIZEOF_VOID_P == 4
+type HalfWord = Word16
+#else
+#error Uknown SIZEOF_VOID_P
+#endif
+
+type EntryFunPtr = FunPtr (Ptr () -> IO (Ptr ()))
+
+data StgInfoTable = StgInfoTable {
+ entry :: Maybe EntryFunPtr, -- Just <=> not ghciTablesNextToCode
+ ptrs :: HalfWord,
+ nptrs :: HalfWord,
+ tipe :: HalfWord,
+ srtlen :: HalfWord,
+ code :: Maybe ItblCodes -- Just <=> ghciTablesNextToCode
+ }
+
+peekItbl :: Ptr StgInfoTable -> IO StgInfoTable
+peekItbl a0 = do
+#if defined(TABLES_NEXT_TO_CODE)
+ let entry' = Nothing
+#else
+ entry' <- Just <$> (#peek StgInfoTable, entry) a0
+#endif
+ ptrs' <- (#peek StgInfoTable, layout.payload.ptrs) a0
+ nptrs' <- (#peek StgInfoTable, layout.payload.nptrs) a0
+ tipe' <- (#peek StgInfoTable, type) a0
+ srtlen' <- (#peek StgInfoTable, srt_bitmap) a0
+ return StgInfoTable
+ { entry = entry'
+ , ptrs = ptrs'
+ , nptrs = nptrs'
+ , tipe = tipe'
+ , srtlen = srtlen'
+ , code = Nothing
+ }
+
+-- | Convert a pointer to an StgConInfo into an info pointer that can be
+-- used in the header of a closure.
+conInfoPtr :: Ptr () -> Ptr ()
+conInfoPtr ptr
+ | ghciTablesNextToCode = ptr `plusPtr` (#size StgConInfoTable)
+ | otherwise = ptr
+
+ghciTablesNextToCode :: Bool
+#ifdef TABLES_NEXT_TO_CODE
+ghciTablesNextToCode = True
+#else
+ghciTablesNextToCode = False
+#endif
+
+#ifdef GHCI /* To end */
mkConInfoTable
:: Int -- ptr words
-> Int -- non-ptr words
@@ -52,8 +114,6 @@ mkConInfoTable ptr_words nonptr_words tag ptrtag con_desc =
-- -----------------------------------------------------------------------------
-- Building machine code fragments for a constructor's entry code
-type ItblCodes = Either [Word8] [Word32]
-
funPtrToInt :: FunPtr a -> Int
funPtrToInt (FunPtr a) = I## (addr2Int## a)
@@ -280,9 +340,6 @@ byte7 w = fromIntegral (w `shiftR` 56)
-- -----------------------------------------------------------------------------
-- read & write intfo tables
--- Get definitions for the structs, constants & config etc.
-#include "Rts.h"
-
-- entry point for direct returns for created constr itbls
foreign import ccall "&stg_interp_constr1_entry" stg_interp_constr1_entry :: EntryFunPtr
foreign import ccall "&stg_interp_constr2_entry" stg_interp_constr2_entry :: EntryFunPtr
@@ -302,30 +359,11 @@ interpConstrEntry = [ error "pointer tag 0"
, stg_interp_constr6_entry
, stg_interp_constr7_entry ]
--- Ultra-minimalist version specially for constructors
-#if SIZEOF_VOID_P == 8
-type HalfWord = Word32
-#elif SIZEOF_VOID_P == 4
-type HalfWord = Word16
-#else
-#error Uknown SIZEOF_VOID_P
-#endif
-
data StgConInfoTable = StgConInfoTable {
conDesc :: Ptr Word8,
infoTable :: StgInfoTable
}
-type EntryFunPtr = FunPtr (Ptr () -> IO (Ptr ()))
-
-data StgInfoTable = StgInfoTable {
- entry :: Maybe EntryFunPtr, -- Just <=> not ghciTablesNextToCode
- ptrs :: HalfWord,
- nptrs :: HalfWord,
- tipe :: HalfWord,
- srtlen :: HalfWord,
- code :: Maybe ItblCodes -- Just <=> ghciTablesNextToCode
- }
pokeConItbl
:: Ptr StgConInfoTable -> Ptr StgConInfoTable -> StgConInfoTable
@@ -364,26 +402,6 @@ pokeItbl a0 itbl = do
Just (Right xs) -> pokeArray code_offset xs
#endif
-peekItbl :: Ptr StgInfoTable -> IO StgInfoTable
-peekItbl a0 = do
-#if defined(TABLES_NEXT_TO_CODE)
- let entry' = Nothing
-#else
- entry' <- Just <$> (#peek StgInfoTable, entry) a0
-#endif
- ptrs' <- (#peek StgInfoTable, layout.payload.ptrs) a0
- nptrs' <- (#peek StgInfoTable, layout.payload.nptrs) a0
- tipe' <- (#peek StgInfoTable, type) a0
- srtlen' <- (#peek StgInfoTable, srt_bitmap) a0
- return StgInfoTable
- { entry = entry'
- , ptrs = ptrs'
- , nptrs = nptrs'
- , tipe = tipe'
- , srtlen = srtlen'
- , code = Nothing
- }
-
newExecConItbl :: StgInfoTable -> [Word8] -> IO (FunPtr ())
newExecConItbl obj con_desc
= alloca $ \pcode -> do
@@ -408,13 +426,6 @@ foreign import ccall unsafe "allocateExec"
foreign import ccall unsafe "flushExec"
_flushExec :: CUInt -> Ptr a -> IO ()
--- | Convert a pointer to an StgConInfo into an info pointer that can be
--- used in the header of a closure.
-conInfoPtr :: Ptr () -> Ptr ()
-conInfoPtr ptr
- | ghciTablesNextToCode = ptr `plusPtr` (#size StgConInfoTable)
- | otherwise = ptr
-
-- -----------------------------------------------------------------------------
-- Constants and config
@@ -443,10 +454,4 @@ rtsIsProfiled = unsafeDupablePerformIO rtsIsProfiledIO /= 0
cONSTR :: Int -- Defined in ClosureTypes.h
cONSTR = (#const CONSTR)
-
-ghciTablesNextToCode :: Bool
-#ifdef TABLES_NEXT_TO_CODE
-ghciTablesNextToCode = True
-#else
-ghciTablesNextToCode = False
-#endif
+#endif /* GHCI */
diff --git a/libraries/ghci/GHCi/Message.hs b/libraries/ghci/GHCi/Message.hs
index 4d0417e2da..fe4e95eb9e 100644
--- a/libraries/ghci/GHCi/Message.hs
+++ b/libraries/ghci/GHCi/Message.hs
@@ -1,5 +1,6 @@
-{-# LANGUAGE GADTs, DeriveGeneric, StandaloneDeriving,
- GeneralizedNewtypeDeriving, ExistentialQuantification, RecordWildCards #-}
+{-# LANGUAGE GADTs, DeriveGeneric, StandaloneDeriving, ScopedTypeVariables,
+ GeneralizedNewtypeDeriving, ExistentialQuantification, RecordWildCards,
+ CPP #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-orphans #-}
-- |
@@ -14,6 +15,7 @@ module GHCi.Message
, QResult(..)
, EvalStatus_(..), EvalStatus, EvalResult(..), EvalOpts(..), EvalExpr(..)
, SerializableException(..)
+ , toSerializableException, fromSerializableException
, THResult(..), THResultType(..)
, ResumeContext(..)
, QState(..)
@@ -40,7 +42,11 @@ import Data.Dynamic
import Data.IORef
import Data.Map (Map)
import GHC.Generics
+#if MIN_VERSION_base(4,9,0)
import GHC.Stack.CCS
+#else
+import GHC.Stack as GHC.Stack.CCS
+#endif
import qualified Language.Haskell.TH as TH
import qualified Language.Haskell.TH.Syntax as TH
import System.Exit
@@ -352,7 +358,28 @@ data SerializableException
| EOtherException String
deriving (Generic, Show)
-instance Binary ExitCode
+toSerializableException :: SomeException -> SerializableException
+toSerializableException ex
+ | Just UserInterrupt <- fromException ex = EUserInterrupt
+ | Just (ec::ExitCode) <- fromException ex = (EExitCode ec)
+ | otherwise = EOtherException (show (ex :: SomeException))
+
+fromSerializableException :: SerializableException -> SomeException
+fromSerializableException EUserInterrupt = toException UserInterrupt
+fromSerializableException (EExitCode c) = toException c
+fromSerializableException (EOtherException str) = toException (ErrorCall str)
+
+-- NB: Replace this with a derived instance once we depend on GHC 8.0
+-- as the minimum
+instance Binary ExitCode where
+ put ExitSuccess = putWord8 0
+ put (ExitFailure ec) = putWord8 1 `mappend` put ec
+ get = do
+ w <- getWord8
+ case w of
+ 0 -> pure ExitSuccess
+ _ -> ExitFailure <$> get
+
instance Binary SerializableException
data THResult a
diff --git a/libraries/ghci/GHCi/Run.hs b/libraries/ghci/GHCi/Run.hs
index fefbdc32c1..858b247f65 100644
--- a/libraries/ghci/GHCi/Run.hs
+++ b/libraries/ghci/GHCi/Run.hs
@@ -10,7 +10,6 @@
--
module GHCi.Run
( run, redirectInterrupts
- , toSerializableException, fromSerializableException
) where
import GHCi.CreateBCO
@@ -36,7 +35,6 @@ import Foreign
import Foreign.C
import GHC.Conc.Sync
import GHC.IO hiding ( bracket )
-import System.Exit
import System.Mem.Weak ( deRefWeak )
import Unsafe.Coerce
@@ -223,17 +221,6 @@ tryEval io = do
Left ex -> return (EvalException (toSerializableException ex))
Right a -> return (EvalSuccess a)
-toSerializableException :: SomeException -> SerializableException
-toSerializableException ex
- | Just UserInterrupt <- fromException ex = EUserInterrupt
- | Just (ec::ExitCode) <- fromException ex = (EExitCode ec)
- | otherwise = EOtherException (show (ex :: SomeException))
-
-fromSerializableException :: SerializableException -> SomeException
-fromSerializableException EUserInterrupt = toException UserInterrupt
-fromSerializableException (EExitCode c) = toException c
-fromSerializableException (EOtherException str) = toException (ErrorCall str)
-
-- This function sets up the interpreter for catching breakpoints, and
-- resets everything when the computation has stopped running. This
-- is a not-very-good way to ensure that only the interactive
diff --git a/libraries/ghci/ghci.cabal.in b/libraries/ghci/ghci.cabal.in
index 9b622e1107..87b2c4e2fd 100644
--- a/libraries/ghci/ghci.cabal.in
+++ b/libraries/ghci/ghci.cabal.in
@@ -17,6 +17,11 @@ cabal-version: >=1.10
build-type: Simple
extra-source-files: changelog.md
+Flag ghci
+ Description: Build GHCi support.
+ Default: False
+ Manual: True
+
source-repository head
type: git
location: http://git.haskell.org/ghc.git
@@ -41,24 +46,28 @@ library
TupleSections
UnboxedTuples
+ if flag(ghci)
+ CPP-Options: -DGHCI
+ exposed-modules:
+ GHCi.Run
+ GHCi.CreateBCO
+ GHCi.ObjLink
+ GHCi.Signals
+ GHCi.TH
+
exposed-modules:
GHCi.BreakArray
GHCi.Message
GHCi.ResolvedBCO
GHCi.RemoteTypes
- GHCi.ObjLink
- GHCi.CreateBCO
GHCi.FFI
GHCi.InfoTable
- GHCi.Run
- GHCi.Signals
- GHCi.TH
GHCi.TH.Binary
SizedSeq
Build-Depends:
array == 0.5.*,
- base == 4.10.*,
+ base >= 4.8 && < 4.11,
binary == 0.8.*,
bytestring == 0.10.*,
containers == 0.5.*,