Commit 27f79255 authored by shlevy's avatar shlevy Committed by Tamar Christina

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
parent c0c1f801
...@@ -7,12 +7,14 @@ ...@@ -7,12 +7,14 @@
module Coverage (addTicksToBinds, hpcInitCode) where module Coverage (addTicksToBinds, hpcInitCode) where
#ifdef GHCI
import qualified GHCi import qualified GHCi
import GHCi.RemoteTypes import GHCi.RemoteTypes
import Data.Array import Data.Array
import ByteCodeTypes import ByteCodeTypes
#if MIN_VERSION_base(4,9,0)
import GHC.Stack.CCS import GHC.Stack.CCS
#else
import GHC.Stack as GHC.Stack.CCS
#endif #endif
import Type import Type
import HsSyn import HsSyn
...@@ -129,9 +131,6 @@ guessSourceFile binds orig_file = ...@@ -129,9 +131,6 @@ guessSourceFile binds orig_file =
mkModBreaks :: HscEnv -> Module -> Int -> [MixEntry_] -> IO ModBreaks mkModBreaks :: HscEnv -> Module -> Int -> [MixEntry_] -> IO ModBreaks
#ifndef GHCI
mkModBreaks _hsc_env _mod _count _entries = return emptyModBreaks
#else
mkModBreaks hsc_env mod count entries mkModBreaks hsc_env mod count entries
| HscInterpreted <- hscTarget (hsc_dflags hsc_env) = do | HscInterpreted <- hscTarget (hsc_dflags hsc_env) = do
breakArray <- GHCi.newBreakArray hsc_env (length entries) breakArray <- GHCi.newBreakArray hsc_env (length entries)
...@@ -165,7 +164,6 @@ mkCCSArray hsc_env modul count entries = do ...@@ -165,7 +164,6 @@ mkCCSArray hsc_env modul count entries = do
mk_one (srcspan, decl_path, _, _) = (name, src) mk_one (srcspan, decl_path, _, _) = (name, src)
where name = concat (intersperse "." decl_path) where name = concat (intersperse "." decl_path)
src = showSDoc dflags (ppr srcspan) src = showSDoc dflags (ppr srcspan)
#endif
writeMixEntries writeMixEntries
......
...@@ -64,6 +64,7 @@ Library ...@@ -64,6 +64,7 @@ Library
transformers == 0.5.*, transformers == 0.5.*,
ghc-boot == @ProjectVersionMunged@, ghc-boot == @ProjectVersionMunged@,
ghc-boot-th == @ProjectVersionMunged@, ghc-boot-th == @ProjectVersionMunged@,
ghci == @ProjectVersionMunged@,
hoopl >= 3.10.2 && < 3.11 hoopl >= 3.10.2 && < 3.11
if os(windows) if os(windows)
...@@ -73,9 +74,6 @@ Library ...@@ -73,9 +74,6 @@ Library
Build-Depends: terminfo == 0.4.* Build-Depends: terminfo == 0.4.*
Build-Depends: unix == 2.7.* Build-Depends: unix == 2.7.*
if flag(ghci)
Build-Depends: ghci == @ProjectVersionMunged@
GHC-Options: -Wall -fno-warn-name-shadowing GHC-Options: -Wall -fno-warn-name-shadowing
if flag(ghci) if flag(ghci)
...@@ -605,16 +603,6 @@ Library ...@@ -605,16 +603,6 @@ Library
Dwarf Dwarf
Dwarf.Types Dwarf.Types
Dwarf.Constants 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 Convert
ByteCodeTypes ByteCodeTypes
ByteCodeAsm ByteCodeAsm
...@@ -627,3 +615,10 @@ Library ...@@ -627,3 +615,10 @@ Library
RtClosureInspect RtClosureInspect
DebuggerUtils DebuggerUtils
GHCi 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
...@@ -66,7 +66,11 @@ import qualified Data.Map as Map ...@@ -66,7 +66,11 @@ import qualified Data.Map as Map
import qualified Data.IntMap as IntMap import qualified Data.IntMap as IntMap
import qualified FiniteMap as Map import qualified FiniteMap as Map
import Data.Ord import Data.Ord
#if MIN_VERSION_base(4,9,0)
import GHC.Stack.CCS import GHC.Stack.CCS
#else
import GHC.Stack as GHC.Stack.CCS
#endif
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
-- Generating byte code for a complete module -- Generating byte code for a complete module
......
...@@ -30,7 +30,11 @@ import PrimOp ...@@ -30,7 +30,11 @@ import PrimOp
import SMRep import SMRep
import Data.Word import Data.Word
#if MIN_VERSION_base(4,9,0)
import GHC.Stack.CCS (CostCentre) import GHC.Stack.CCS (CostCentre)
#else
import GHC.Stack (CostCentre)
#endif
-- ---------------------------------------------------------------------------- -- ----------------------------------------------------------------------------
-- Bytecode instructions -- Bytecode instructions
......
{-# LANGUAGE MagicHash, RecordWildCards, GeneralizedNewtypeDeriving #-} {-# LANGUAGE CPP, MagicHash, RecordWildCards, GeneralizedNewtypeDeriving #-}
-- --
-- (c) The University of Glasgow 2002-2006 -- (c) The University of Glasgow 2002-2006
-- --
...@@ -34,7 +34,11 @@ import Data.Array.Base ( UArray(..) ) ...@@ -34,7 +34,11 @@ import Data.Array.Base ( UArray(..) )
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import Data.IntMap (IntMap) import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap import qualified Data.IntMap as IntMap
#if MIN_VERSION_base(4,9,0)
import GHC.Stack.CCS import GHC.Stack.CCS
#else
import GHC.Stack as GHC.Stack.CCS
#endif
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
-- Compiled Byte Code -- Compiled Byte Code
......
...@@ -46,7 +46,9 @@ module GHCi ...@@ -46,7 +46,9 @@ module GHCi
) where ) where
import GHCi.Message import GHCi.Message
#ifdef GHCI
import GHCi.Run import GHCi.Run
#endif
import GHCi.RemoteTypes import GHCi.RemoteTypes
import GHCi.ResolvedBCO import GHCi.ResolvedBCO
import GHCi.BreakArray (BreakArray) import GHCi.BreakArray (BreakArray)
...@@ -71,13 +73,23 @@ import Data.ByteString (ByteString) ...@@ -71,13 +73,23 @@ import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as LB import qualified Data.ByteString.Lazy as LB
import Data.IORef import Data.IORef
import Foreign hiding (void) import Foreign hiding (void)
#if MIN_VERSION_base(4,9,0)
import GHC.Stack.CCS (CostCentre,CostCentreStack) import GHC.Stack.CCS (CostCentre,CostCentreStack)
#else
import GHC.Stack (CostCentre,CostCentreStack)
#endif
import System.Exit import System.Exit
import Data.Maybe import Data.Maybe
import GHC.IO.Handle.Types (Handle) import GHC.IO.Handle.Types (Handle)
#ifdef mingw32_HOST_OS #ifdef mingw32_HOST_OS
import Foreign.C import Foreign.C
import GHC.IO.Handle.FD (fdToHandle) 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 #else
import System.Posix as Posix import System.Posix as Posix
#endif #endif
...@@ -148,6 +160,12 @@ Other Notes on Remote GHCi ...@@ -148,6 +160,12 @@ Other Notes on Remote GHCi
* Note [Remote Template Haskell] in libraries/ghci/GHCi/TH.hs * 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 -- | Run a command in the interpreter's context. With
-- @-fexternal-interpreter@, the command is serialized and sent to an -- @-fexternal-interpreter@, the command is serialized and sent to an
-- external iserv process, and the response is deserialized (hence the -- external iserv process, and the response is deserialized (hence the
...@@ -160,8 +178,11 @@ iservCmd hsc_env@HscEnv{..} msg ...@@ -160,8 +178,11 @@ iservCmd hsc_env@HscEnv{..} msg
uninterruptibleMask_ $ do -- Note [uninterruptibleMask_] uninterruptibleMask_ $ do -- Note [uninterruptibleMask_]
iservCall iserv msg iservCall iserv msg
| otherwise = -- Just run it directly | otherwise = -- Just run it directly
#ifdef GHCI
run msg run msg
#else
needExtInt
#endif
-- Note [uninterruptibleMask_ and iservCmd] -- Note [uninterruptibleMask_ and iservCmd]
-- --
...@@ -357,7 +378,11 @@ lookupSymbol hsc_env@HscEnv{..} str ...@@ -357,7 +378,11 @@ lookupSymbol hsc_env@HscEnv{..} str
writeIORef iservLookupSymbolCache $! addToUFM cache str p writeIORef iservLookupSymbolCache $! addToUFM cache str p
return (Just p) return (Just p)
| otherwise = | otherwise =
#ifdef GHCI
fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str)) fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str))
#else
needExtInt
#endif
lookupClosure :: HscEnv -> String -> IO (Maybe HValueRef) lookupClosure :: HscEnv -> String -> IO (Maybe HValueRef)
lookupClosure hsc_env str = lookupClosure hsc_env str =
...@@ -512,6 +537,23 @@ runWithPipes createProc prog opts = do ...@@ -512,6 +537,23 @@ runWithPipes createProc prog opts = do
return (ph, rh, wh) return (ph, rh, wh)
where mkHandle :: CInt -> IO Handle where mkHandle :: CInt -> IO Handle
mkHandle fd = (fdToHandle fd) `onException` (c__close fd) 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 #else
runWithPipes createProc prog opts = do runWithPipes createProc prog opts = do
(rfd1, wfd1) <- Posix.createPipe -- we read on rfd1 (rfd1, wfd1) <- Posix.createPipe -- we read on rfd1
...@@ -603,8 +645,14 @@ wormholeRef dflags r ...@@ -603,8 +645,14 @@ wormholeRef dflags r
| gopt Opt_ExternalInterpreter dflags | gopt Opt_ExternalInterpreter dflags
= throwIO (InstallationError = throwIO (InstallationError
"this operation requires -fno-external-interpreter") "this operation requires -fno-external-interpreter")
#ifdef GHCI
| otherwise | otherwise
= localRef r = localRef r
#else
| otherwise
= throwIO (InstallationError
"can't wormhole a value in a stage1 compiler")
#endif
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
-- Misc utils -- Misc utils
......
...@@ -709,6 +709,16 @@ getLinkDeps hsc_env hpt pls replace_osuf span mods ...@@ -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 _ (DotA fp) = panic ("adjust_ul DotA " ++ show fp)
adjust_ul _ (DotDLL fp) = panic ("adjust_ul DotDLL " ++ show fp) adjust_ul _ (DotDLL fp) = panic ("adjust_ul DotDLL " ++ show fp)
adjust_ul _ l@(BCOs {}) = return l 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
{- ********************************************************************** {- **********************************************************************
......
...@@ -48,10 +48,8 @@ import Data.Data hiding (Fixity(..)) ...@@ -48,10 +48,8 @@ import Data.Data hiding (Fixity(..))
import qualified Data.Data as Data (Fixity(..)) import qualified Data.Data as Data (Fixity(..))
import Data.Maybe (isNothing) import Data.Maybe (isNothing)
#ifdef GHCI
import GHCi.RemoteTypes ( ForeignRef ) import GHCi.RemoteTypes ( ForeignRef )
import qualified Language.Haskell.TH as TH (Q) import qualified Language.Haskell.TH as TH (Q)
#endif
{- {-
************************************************************************ ************************************************************************
...@@ -2047,24 +2045,13 @@ isTypedSplice _ = False -- Quasi-quotes are untyped splices ...@@ -2047,24 +2045,13 @@ isTypedSplice _ = False -- Quasi-quotes are untyped splices
-- See Note [Delaying modFinalizers in untyped splices] in RnSplice. For how -- See Note [Delaying modFinalizers in untyped splices] in RnSplice. For how
-- this is used. -- this is used.
-- --
#ifdef GHCI
newtype ThModFinalizers = ThModFinalizers [ForeignRef (TH.Q ())] newtype ThModFinalizers = ThModFinalizers [ForeignRef (TH.Q ())]
#else
data ThModFinalizers = ThModFinalizers
#endif
-- A Data instance which ignores the argument of 'ThModFinalizers'. -- A Data instance which ignores the argument of 'ThModFinalizers'.
#ifdef GHCI
instance Data ThModFinalizers where instance Data ThModFinalizers where
gunfold _ z _ = z $ ThModFinalizers [] gunfold _ z _ = z $ ThModFinalizers []
toConstr a = mkConstr (dataTypeOf a) "ThModFinalizers" [] Data.Prefix toConstr a = mkConstr (dataTypeOf a) "ThModFinalizers" [] Data.Prefix
dataTypeOf a = mkDataType "HsExpr.ThModFinalizers" [toConstr a] 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 -- | Haskell Spliced Thing
-- --
......
...@@ -2054,11 +2054,7 @@ doCpp dflags raw input_fn output_fn = do ...@@ -2054,11 +2054,7 @@ doCpp dflags raw input_fn output_fn = do
backend_defs <- getBackendDefs dflags backend_defs <- getBackendDefs dflags
#ifdef GHCI
let th_defs = [ "-D__GLASGOW_HASKELL_TH__" ] let th_defs = [ "-D__GLASGOW_HASKELL_TH__" ]
#else
let th_defs = [ "-D__GLASGOW_HASKELL_TH__=0" ]
#endif
-- Default CPP defines in Haskell source -- Default CPP defines in Haskell source
ghcVersionH <- getGhcVersionPathName dflags ghcVersionH <- getGhcVersionPathName dflags
let hsSourceCppOpts = [ "-include", ghcVersionH ] let hsSourceCppOpts = [ "-include", ghcVersionH ]
......
...@@ -124,9 +124,7 @@ module DynFlags ( ...@@ -124,9 +124,7 @@ module DynFlags (
-- * Compiler configuration suitable for display to the user -- * Compiler configuration suitable for display to the user
compilerInfo, compilerInfo,
#ifdef GHCI
rtsIsProfiled, rtsIsProfiled,
#endif
dynamicGhc, dynamicGhc,
#include "GHCConstantsHaskellExports.hs" #include "GHCConstantsHaskellExports.hs"
...@@ -3613,12 +3611,6 @@ supportedExtensions :: [String] ...@@ -3613,12 +3611,6 @@ supportedExtensions :: [String]
supportedExtensions = concatMap toFlagSpecNamePair xFlags supportedExtensions = concatMap toFlagSpecNamePair xFlags
where where
toFlagSpecNamePair flg 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] | otherwise = [name, noName]
where where
noName = "No" ++ name noName = "No" ++ name
...@@ -4155,7 +4147,6 @@ foreign import ccall unsafe "rts_isProfiled" rtsIsProfiledIO :: IO CInt ...@@ -4155,7 +4147,6 @@ foreign import ccall unsafe "rts_isProfiled" rtsIsProfiledIO :: IO CInt
rtsIsProfiled :: Bool rtsIsProfiled :: Bool
rtsIsProfiled = unsafeDupablePerformIO rtsIsProfiledIO /= 0 rtsIsProfiled = unsafeDupablePerformIO rtsIsProfiledIO /= 0
#ifdef GHCI
-- Consult the RTS to find whether GHC itself has been built with -- Consult the RTS to find whether GHC itself has been built with
-- dynamic linking. This can't be statically known at compile-time, -- dynamic linking. This can't be statically known at compile-time,
-- because we build both the static and dynamic versions together with -- because we build both the static and dynamic versions together with
...@@ -4164,10 +4155,6 @@ foreign import ccall unsafe "rts_isDynamic" rtsIsDynamicIO :: IO CInt ...@@ -4164,10 +4155,6 @@ foreign import ccall unsafe "rts_isDynamic" rtsIsDynamicIO :: IO CInt
dynamicGhc :: Bool dynamicGhc :: Bool
dynamicGhc = unsafeDupablePerformIO rtsIsDynamicIO /= 0 dynamicGhc = unsafeDupablePerformIO rtsIsDynamicIO /= 0
#else
dynamicGhc :: Bool
dynamicGhc = False
#endif
setWarnSafe :: Bool -> DynP () setWarnSafe :: Bool -> DynP ()
setWarnSafe True = getCurLoc >>= \l -> upd (\d -> d { warnSafeOnLoc = l }) setWarnSafe True = getCurLoc >>= \l -> upd (\d -> d { warnSafeOnLoc = l })
...@@ -4200,24 +4187,8 @@ setIncoherentInsts True = do ...@@ -4200,24 +4187,8 @@ setIncoherentInsts True = do
upd (\d -> d { incoherentOnLoc = l }) upd (\d -> d { incoherentOnLoc = l })
checkTemplateHaskellOk :: TurnOnFlag -> DynP () checkTemplateHaskellOk :: TurnOnFlag -> DynP ()
#ifdef GHCI
checkTemplateHaskellOk _turn_on checkTemplateHaskellOk _turn_on
= getCurLoc >>= \l -> upd (\d -> d { thOnLoc = l }) = 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
{- ********************************************************************** {- **********************************************************************
%* * %* *
......
...@@ -91,7 +91,6 @@ module GHC ( ...@@ -91,7 +91,6 @@ module GHC (
-- * Interactive evaluation -- * Interactive evaluation
#ifdef GHCI
-- ** Executing statements -- ** Executing statements
execStmt, ExecOptions(..), execOptions, ExecResult(..), execStmt, ExecOptions(..), execOptions, ExecResult(..),
resumeExec, resumeExec,
...@@ -103,11 +102,10 @@ module GHC ( ...@@ -103,11 +102,10 @@ module GHC (
parseImportDecl, parseImportDecl,
setContext, getContext, setContext, getContext,
setGHCiMonad, getGHCiMonad, setGHCiMonad, getGHCiMonad,
#endif
-- ** Inspecting the current context -- ** Inspecting the current context
getBindings, getInsts, getPrintUnqual, getBindings, getInsts, getPrintUnqual,
findModule, lookupModule, findModule, lookupModule,
#ifdef GHCI
isModuleTrusted, moduleTrustReqs, isModuleTrusted, moduleTrustReqs,
getNamesInScope, getNamesInScope,
getRdrNamesInScope, getRdrNamesInScope,
...@@ -123,9 +121,8 @@ module GHC ( ...@@ -123,9 +121,8 @@ module GHC (
-- ** Looking up a Name -- ** Looking up a Name
parseName, parseName,
#endif
lookupName, lookupName,
#ifdef GHCI
-- ** Compiling expressions -- ** Compiling expressions
HValue, parseExpr, compileParsedExpr, HValue, parseExpr, compileParsedExpr,
InteractiveEval.compileExpr, dynCompileExpr, InteractiveEval.compileExpr, dynCompileExpr,
...@@ -154,7 +151,6 @@ module GHC ( ...@@ -154,7 +151,6 @@ module GHC (
RunResult(..), RunResult(..),
runStmt, runStmtWithLocation, runStmt, runStmtWithLocation,
resume, resume,
#endif
-- * Abstract syntax elements -- * Abstract syntax elements
...@@ -290,14 +286,12 @@ module GHC ( ...@@ -290,14 +286,12 @@ module GHC (
#include "HsVersions.h" #include "HsVersions.h"
#ifdef GHCI
import ByteCodeTypes import ByteCodeTypes
import InteractiveEval import InteractiveEval
import InteractiveEvalTypes import InteractiveEvalTypes
import TcRnDriver ( runTcInteractive ) import TcRnDriver ( runTcInteractive )
import GHCi import GHCi
import GHCi.RemoteTypes import GHCi.RemoteTypes
#endif
import PprTyThing ( pprFamInst ) import PprTyThing ( pprFamInst )
import HscMain import HscMain
...@@ -469,9 +463,7 @@ withCleanupSession ghc = ghc `gfinally` cleanup ...@@ -469,9 +463,7 @@ withCleanupSession ghc = ghc `gfinally` cleanup
liftIO $ do liftIO $ do
cleanTempFiles dflags cleanTempFiles dflags
cleanTempDirs dflags cleanTempDirs dflags
#ifdef GHCI
stopIServ hsc_env -- shut down the IServ stopIServ hsc_env -- shut down the IServ
#endif
-- exceptions will be blocked while we clean the temporary files, -- exceptions will be blocked while we clean the temporary files,
-- so there shouldn't be any difficulty if we receive further -- so there shouldn't be any difficulty if we receive further
-- signals. -- signals.
...@@ -889,10 +881,8 @@ typecheckModule pmod = do ...@@ -889,10 +881,8 @@ typecheckModule pmod = do
minf_rdr_env = Just (tcg_rdr_env tc_gbl_env), minf_rdr_env = Just (tcg_rdr_env tc_gbl_env),
minf_instances = fixSafeInstances safe $ md_insts details, minf_instances = fixSafeInstances safe $ md_insts details,
minf_iface = Nothing, minf_iface = Nothing,
minf_safe = safe minf_safe = safe,
#ifdef GHCI minf_modBreaks = emptyModBreaks
,minf_modBreaks = emptyModBreaks
#endif
}} }}
-- | Desugar a typechecked module. -- | Desugar a typechecked module.
...@@ -1080,10 +1070,8 @@ data ModuleInfo = ModuleInfo { ...@@ -1080,10 +1070,8 @@ data ModuleInfo = ModuleInfo {
minf_rdr_env :: Maybe GlobalRdrEnv, -- Nothing for a compiled/package mod minf_rdr_env :: Maybe GlobalRdrEnv, -- Nothing for a compiled/package mod
minf_instances :: [ClsInst], minf_instances :: [ClsInst],
minf_iface :: Maybe ModIface, minf_iface :: Maybe ModIface,
minf_safe :: SafeHaskellMode minf_safe :: SafeHaskellMode,
#ifdef GHCI minf_modBreaks :: ModBreaks
,minf_modBreaks :: ModBreaks
#endif
} }
-- We don't want HomeModInfo here, because a ModuleInfo applies -- We don't want HomeModInfo here, because a ModuleInfo applies
-- to package modules too. -- to package modules too.
...@@ -1106,7 +1094,6 @@ getModuleInfo mdl = withSession $ \hsc_env -> do ...@@ -1106,7 +1094,6 @@ getModuleInfo mdl = withSession $ \hsc_env -> do
-- exist... hence the isHomeModule test here. (ToDo: reinstate) -- exist... hence the isHomeModule test here. (ToDo: reinstate)
getPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo) getPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
#ifdef GHCI
getPackageModuleInfo hsc_env mdl getPackageModuleInfo hsc_env mdl
= do eps <- hscEPS hsc_env = do eps <- hscEPS hsc_env
iface <- hscGetModuleInterface hsc_env mdl iface <- hscGetModuleInterface hsc_env mdl
...@@ -1125,11 +1112,6 @@ getPackageModuleInfo hsc_env mdl ...@@ -1125,11 +1112,6 @@ getPackageModuleInfo hsc_env mdl
minf_safe = getSafeMode $ mi_trust iface, minf_safe = getSafeMode $ mi_trust iface,
minf_modBreaks = emptyModBreaks 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 :: HscEnv -> Module -> IO (Maybe ModuleInfo)
getHomeModuleInfo hsc_env mdl = getHomeModuleInfo hsc_env mdl =
...@@ -1145,9 +1127,7 @@ getHomeModuleInfo hsc_env mdl = ...@@ -1145,9 +1127,7 @@ getHomeModuleInfo hsc_env mdl =
minf_instances = md_insts details, minf_instances = md_insts details,
minf_iface = Just iface, minf_iface = Just iface,
minf_safe = getSafeMode $ mi_trust iface minf_safe = getSafeMode $ mi_trust iface
#ifdef GHCI
,minf_modBreaks = getModBreaks hmi ,minf_modBreaks = getModBreaks hmi
#endif
})) }))
-- | The list of top-level entities defined in a module -- | The list of top-level entities defined in a module
...@@ -1196,10 +1176,8 @@ modInfoIface = minf_iface ...@@ -1196,10 +1176,8 @@ modInfoIface = minf_iface
modInfoSafe :: ModuleInfo -> SafeHaskellMode modInfoSafe :: ModuleInfo -> SafeHaskellMode
modInfoSafe = minf_safe modInfoSafe = minf_safe
#ifdef GHCI
modInfoModBreaks :: ModuleInfo -> ModBreaks modInfoModBreaks :: ModuleInfo -> ModBreaks
modInfoModBreaks = minf_modBreaks modInfoModBreaks = minf_modBreaks
#endif
isDictonaryId :: Id -> Bool isDictonaryId :: Id -> Bool
isDictonaryId id isDictonaryId id
...@@ -1219,11 +1197,9 @@ findGlobalAnns deserialize target = withSession $ \hsc_env -> do ...@@ -1219,11 +1197,9 @@ findGlobalAnns deserialize target = withSession $ \hsc_env -> do
ann_env <- liftIO $ prepareAnnotations hsc_env Nothing ann_env <- liftIO $ prepareAnnotations hsc_env Nothing
return (findAnns deserialize ann_env target) return (findAnns deserialize ann_env target)
#ifdef GHCI
-- | get the GlobalRdrEnv for a session -- | get the GlobalRdrEnv for a session
getGRE :: GhcMonad m => m GlobalRdrEnv getGRE :: GhcMonad m => m GlobalRdrEnv
getGRE = withSession $ \hsc_env-> return $ ic_rn_gbl_env (hsc_IC hsc_env) getGRE = withSession $ \hsc_env-> return $ ic_rn_gbl_env (hsc_IC hsc_env)
#endif
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
...@@ -1422,7 +1398,6 @@ lookupLoadedHomeModule mod_name = withSession $ \hsc_env -> ...@@ -1422,7 +1398,6 @@ lookupLoadedHomeModule mod_name = withSession $ \hsc_env ->
Just mod_info -> return (Just (mi_module (hm_iface mod_info))) Just mod_info -> return (Just (mi_module (hm_iface mod_info)))
_not_a_home_module -> return Nothing _not_a_home_module -> return Nothing