Allow use of the external interpreter in stage1.
authorShea Levy <shea@shealevy.com>
Tue, 20 Dec 2016 01:19:18 +0000 (01:19 +0000)
committerTamar Christina <tamar@zhox.com>
Tue, 20 Dec 2016 01:25:48 +0000 (01:25 +0000)
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

33 files changed:
compiler/deSugar/Coverage.hs
compiler/ghc.cabal.in
compiler/ghci/ByteCodeGen.hs
compiler/ghci/ByteCodeInstr.hs
compiler/ghci/ByteCodeTypes.hs
compiler/ghci/GHCi.hsc [moved from compiler/ghci/GHCi.hs with 95% similarity]
compiler/ghci/Linker.hs
compiler/hsSyn/HsExpr.hs
compiler/main/DriverPipeline.hs
compiler/main/DynFlags.hs
compiler/main/GHC.hs
compiler/main/GhcMake.hs
compiler/main/Hooks.hs
compiler/main/HscMain.hs
compiler/main/HscTypes.hs
compiler/main/InteractiveEval.hs
compiler/main/InteractiveEvalTypes.hs
compiler/rename/RnEnv.hs
compiler/rename/RnSplice.hs
compiler/simplCore/CoreMonad.hs
compiler/specialise/SpecConstr.hs
compiler/typecheck/TcAnnotations.hs
compiler/typecheck/TcRnDriver.hs
compiler/typecheck/TcRnMonad.hs
compiler/typecheck/TcRnTypes.hs
compiler/typecheck/TcSplice.hs
compiler/typecheck/TcSplice.hs-boot
ghc.mk
libraries/ghci/GHCi/BreakArray.hs
libraries/ghci/GHCi/InfoTable.hsc
libraries/ghci/GHCi/Message.hs
libraries/ghci/GHCi/Run.hs
libraries/ghci/ghci.cabal.in

index 51bfb18..1f6effa 100644 (file)
@@ -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
index 4875753..99bb463 100644 (file)
@@ -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
index 0e7aea4..9a5e414 100644 (file)
@@ -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
index f1f6f70..4344432 100644 (file)
@@ -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
index 3537a2b..ec962c8 100644 (file)
@@ -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
similarity index 95%
rename from compiler/ghci/GHCi.hs
rename to compiler/ghci/GHCi.hsc
index 472251d..4503034 100644 (file)
@@ -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
index 7379c46..6a0483c 100644 (file)
@@ -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
+
 
 
 {- **********************************************************************
index 8cead39..d695d8e 100644 (file)
@@ -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
 --
index ea0c6ed..133bdde 100644 (file)
@@ -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 ]
index aee5edc..6ecf8ca 100644 (file)
@@ -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
 
 {- **********************************************************************
 %*                                                                      *
index cf066d0..59e42f9 100644 (file)
@@ -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'.
index 6b103c9..be6510b 100644 (file)
@@ -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 ()
 
 -- -----------------------------------------------------------------------------
index 8d706d8..eefdde4 100644 (file)
@@ -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
index 9a64794..7d80912 100644 (file)
@@ -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
 
 
 {- **********************************************************************
index e5f824f..5b3c058 100644 (file)
@@ -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
index a421c72..3cb1856 100644 (file)
@@ -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 */
index 34ae2cc..cb01219 100644 (file)
@@ -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
index f8969a8..97718f8 100644 (file)
@@ -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]
        }
index 0c41ed3..ccfd002 100644 (file)
@@ -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
index 03c990a..ea94d9b 100644 (file)
@@ -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
index 6063225..2f2087c 100644 (file)
@@ -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
index 33eb83b..7b3cc65 100644 (file)
 
 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
index 0aa2924..ad49ca0 100644 (file)
@@ -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
index a77541c..8c117f0 100644 (file)
@@ -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
 
 {-
 ************************************************************************
index ef94fb6..6d902b3 100644 (file)
@@ -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
index 1e35eec..9942107 100644 (file)
@@ -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 */
index 14e479a..db75436 100644 (file)
@@ -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 a06c4a7..e52c4c4 100644 (file)
--- 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
 
index 311bbd6..bece43b 100644 (file)
 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
index e4deb3b..8a9dfc2 100644 (file)
@@ -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 */
index 4d0417e..fe4e95e 100644 (file)
@@ -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
index fefbdc3..858b247 100644 (file)
@@ -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
index 9b622e1..87b2c4e 100644 (file)
@@ -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.*,