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

5 files changed, 72 insertions, 2 deletions

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
+
 
 
 {- **********************************************************************