Make GHC.Runtime.Interpreter independent of GHC.Driver

9 files changed, 36 insertions, 32 deletions

diff --git a/compiler/GHC/Driver/Env.hs b/compiler/GHC/Driver/Env.hs
index 219e66106b..79d9e47088 100644
--- a/compiler/GHC/Driver/Env.hs
+++ b/compiler/GHC/Driver/Env.hs
@@ -11,6 +11,7 @@ module GHC.Driver.Env
    , mkInteractiveHscEnv
    , runInteractiveHsc
    , hscEPS
+   , hscInterp
    , hptCompleteSigs
    , hptInstances
    , hptAnns
@@ -33,6 +34,7 @@ import GHC.Driver.Session
 import GHC.Driver.Errors ( printOrThrowDiagnostics )
 
 import GHC.Runtime.Context
+import GHC.Runtime.Interpreter.Types (Interp)
 import GHC.Driver.Env.Types ( Hsc(..), HscEnv(..) )
 
 import GHC.Unit
@@ -59,6 +61,7 @@ import GHC.Builtin.Names ( gHC_PRIM )
 
 import GHC.Data.Maybe
 
+import GHC.Utils.Exception as Ex
 import GHC.Utils.Outputable
 import GHC.Utils.Monad
 import GHC.Utils.Panic
@@ -293,3 +296,11 @@ lookupIfaceByModule hpt pit mod
 
 mainModIs :: HscEnv -> Module
 mainModIs hsc_env = mkHomeModule (hsc_home_unit hsc_env) (mainModuleNameIs (hsc_dflags hsc_env))
+
+-- | Retrieve the target code interpreter
+--
+-- Fails if no target code interpreter is available
+hscInterp :: HscEnv -> Interp
+hscInterp hsc_env = case hsc_interp hsc_env of
+   Nothing -> throw (InstallationError "Couldn't find a target code interpreter. Try with -fexternal-interpreter")
+   Just i  -> i
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index c147733bb3..3f4844b57c 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -101,7 +101,7 @@ import GHC.Driver.Config
 import GHC.Driver.Hooks
 
 import GHC.Runtime.Context
-import GHC.Runtime.Interpreter ( addSptEntry, hscInterp )
+import GHC.Runtime.Interpreter ( addSptEntry )
 import GHC.Runtime.Loader      ( initializePlugins )
 import GHCi.RemoteTypes        ( ForeignHValue )
 import GHC.ByteCode.Types
diff --git a/compiler/GHC/Driver/Ppr.hs b/compiler/GHC/Driver/Ppr.hs
index 186992065f..b6dee0f8e3 100644
--- a/compiler/GHC/Driver/Ppr.hs
+++ b/compiler/GHC/Driver/Ppr.hs
@@ -41,15 +41,9 @@ import Control.Monad.IO.Class
 showSDoc :: DynFlags -> SDoc -> String
 showSDoc dflags sdoc = renderWithContext (initSDocContext dflags defaultUserStyle) sdoc
 
-showSDocUnsafe :: SDoc -> String
-showSDocUnsafe sdoc = renderWithContext defaultSDocContext sdoc
-
 showPpr :: Outputable a => DynFlags -> a -> String
 showPpr dflags thing = showSDoc dflags (ppr thing)
 
-showPprUnsafe :: Outputable a => a -> String
-showPprUnsafe a = renderWithContext defaultSDocContext (ppr a)
-
 -- | Allows caller to specify the PrintUnqualified to use
 showSDocForUser :: DynFlags -> UnitState -> PrintUnqualified -> SDoc -> String
 showSDocForUser dflags unit_state unqual doc = renderWithContext (initSDocContext dflags sty) doc'
diff --git a/compiler/GHC/Runtime/Heap/Inspect.hs b/compiler/GHC/Runtime/Heap/Inspect.hs
index dc01a161af..0ec936265e 100644
--- a/compiler/GHC/Runtime/Heap/Inspect.hs
+++ b/compiler/GHC/Runtime/Heap/Inspect.hs
@@ -731,6 +731,7 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do
    return term
     where
   interp = hscInterp hsc_env
+  unit_env = hsc_unit_env hsc_env
 
   go :: Int -> Type -> Type -> ForeignHValue -> TcM Term
    -- I believe that my_ty should not have any enclosing
@@ -753,7 +754,7 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do
 -- Thunks we may want to force
       t | isThunk t && force -> do
          traceTR (text "Forcing a " <> text (show (fmap (const ()) t)))
-         evalRslt <- liftIO $ GHCi.seqHValue interp hsc_env a
+         evalRslt <- liftIO $ GHCi.seqHValue interp unit_env a
          case evalRslt of                                            -- #2950
            EvalSuccess _ -> go (pred max_depth) my_ty old_ty a
            EvalException ex -> do
diff --git a/compiler/GHC/Runtime/Interpreter.hs b/compiler/GHC/Runtime/Interpreter.hs
index 6b6576ed5b..0bd9f1a0c5 100644
--- a/compiler/GHC/Runtime/Interpreter.hs
+++ b/compiler/GHC/Runtime/Interpreter.hs
@@ -48,7 +48,7 @@ module GHC.Runtime.Interpreter
 
   -- * Lower-level API using messages
   , interpCmd, Message(..), withIServ, withIServ_
-  , hscInterp, stopInterp
+  , stopInterp
   , iservCall, readIServ, writeIServ
   , purgeLookupSymbolCache
   , freeHValueRefs
@@ -60,8 +60,6 @@ module GHC.Runtime.Interpreter
 import GHC.Prelude
 
 import GHC.IO (catchException)
-import GHC.Driver.Ppr (showSDoc)
-import GHC.Driver.Env
 
 import GHC.Runtime.Interpreter.Types
 import GHCi.Message
@@ -83,13 +81,14 @@ import GHC.Types.Basic
 
 import GHC.Utils.Panic
 import GHC.Utils.Exception as Ex
-import GHC.Utils.Outputable(brackets, ppr)
+import GHC.Utils.Outputable(brackets, ppr, showSDocUnsafe)
 import GHC.Utils.Fingerprint
 import GHC.Utils.Misc
 
 import GHC.Unit.Module
 import GHC.Unit.Module.ModIface
 import GHC.Unit.Home.ModInfo
+import GHC.Unit.Env
 
 #if defined(HAVE_INTERNAL_INTERPRETER)
 import GHCi.Run
@@ -200,14 +199,6 @@ interpCmd interp msg = case interpInstance interp of
       iservCall iserv msg
 
 
--- | Retrieve the target code interpreter
---
--- Fails if no target code interpreter is available
-hscInterp :: HscEnv -> Interp
-hscInterp hsc_env = case hsc_interp hsc_env of
-   Nothing -> throw (InstallationError "Couldn't find a target code interpreter. Try with -fexternal-interpreter")
-   Just i  -> i
-
 -- Note [uninterruptibleMask_ and interpCmd]
 --
 -- If we receive an async exception, such as ^C, while communicating
@@ -402,33 +393,33 @@ getClosure interp ref =
     mapM (mkFinalizedHValue interp) mb
 
 -- | Send a Seq message to the iserv process to force a value      #2950
-seqHValue :: Interp -> HscEnv -> ForeignHValue -> IO (EvalResult ())
-seqHValue interp hsc_env ref =
+seqHValue :: Interp -> UnitEnv -> ForeignHValue -> IO (EvalResult ())
+seqHValue interp unit_env ref =
   withForeignRef ref $ \hval -> do
     status <- interpCmd interp (Seq hval)
-    handleSeqHValueStatus interp hsc_env status
+    handleSeqHValueStatus interp unit_env status
 
 -- | Process the result of a Seq or ResumeSeq message.             #2950
-handleSeqHValueStatus :: Interp -> HscEnv -> EvalStatus () -> IO (EvalResult ())
-handleSeqHValueStatus interp hsc_env eval_status =
+handleSeqHValueStatus :: Interp -> UnitEnv -> EvalStatus () -> IO (EvalResult ())
+handleSeqHValueStatus interp unit_env eval_status =
   case eval_status of
     (EvalBreak is_exception _ ix mod_uniq resume_ctxt _) -> do
       -- A breakpoint was hit; inform the user and tell them
       -- which breakpoint was hit.
       resume_ctxt_fhv <- liftIO $ mkFinalizedHValue interp resume_ctxt
       let hmi = expectJust "handleRunStatus" $
-                  lookupHptDirectly (hsc_HPT hsc_env)
+                  lookupHptDirectly (ue_hpt unit_env)
                     (mkUniqueGrimily mod_uniq)
           modl = mi_module (hm_iface hmi)
           bp | is_exception = Nothing
              | otherwise = Just (BreakInfo modl ix)
           sdocBpLoc = brackets . ppr . getSeqBpSpan
       putStrLn ("*** Ignoring breakpoint " ++
-            (showSDoc (hsc_dflags hsc_env) $ sdocBpLoc bp))
+            (showSDocUnsafe $ sdocBpLoc bp))
       -- resume the seq (:force) processing in the iserv process
       withForeignRef resume_ctxt_fhv $ \hval -> do
         status <- interpCmd interp (ResumeSeq hval)
-        handleSeqHValueStatus interp hsc_env status
+        handleSeqHValueStatus interp unit_env status
     (EvalComplete _ r) -> return r
   where
     getSeqBpSpan :: Maybe BreakInfo -> SrcSpan
@@ -440,7 +431,7 @@ handleSeqHValueStatus interp hsc_env eval_status =
     -- Reason: Setting of flags in libraries/ghci/GHCi/Run.hs:evalOptsSeq
     getSeqBpSpan Nothing = mkGeneralSrcSpan (fsLit "<unknown>")
     breaks mod = getModBreaks $ expectJust "getSeqBpSpan" $
-      lookupHpt (hsc_HPT hsc_env) (moduleName mod)
+      lookupHpt (ue_hpt unit_env) (moduleName mod)
 
 
 -- -----------------------------------------------------------------------------
diff --git a/compiler/GHC/Runtime/Loader.hs b/compiler/GHC/Runtime/Loader.hs
index 648f80c571..b0a3c2aded 100644
--- a/compiler/GHC/Runtime/Loader.hs
+++ b/compiler/GHC/Runtime/Loader.hs
@@ -28,7 +28,7 @@ import GHC.Driver.Hooks
 import GHC.Driver.Plugins
 
 import GHC.Linker.Loader       ( loadModule, loadName )
-import GHC.Runtime.Interpreter ( wormhole, hscInterp )
+import GHC.Runtime.Interpreter ( wormhole )
 import GHC.Runtime.Interpreter.Types
 
 import GHC.Tc.Utils.Monad      ( initTcInteractive, initIfaceTcRn )
diff --git a/compiler/GHC/Utils/Outputable.hs b/compiler/GHC/Utils/Outputable.hs
index 6f04ba9ad4..d6c79895d5 100644
--- a/compiler/GHC/Utils/Outputable.hs
+++ b/compiler/GHC/Utils/Outputable.hs
@@ -54,6 +54,8 @@ module GHC.Utils.Outputable (
         bufLeftRenderSDoc,
         pprCode,
         showSDocOneLine,
+        showSDocUnsafe,
+        showPprUnsafe,
         renderWithContext,
 
         pprInfixVar, pprPrefixVar,
@@ -596,6 +598,13 @@ showSDocOneLine ctx d
    Pretty.renderStyle s $
       runSDoc d ctx
 
+showSDocUnsafe :: SDoc -> String
+showSDocUnsafe sdoc = renderWithContext defaultSDocContext sdoc
+
+showPprUnsafe :: Outputable a => a -> String
+showPprUnsafe a = renderWithContext defaultSDocContext (ppr a)
+
+
 isEmpty :: SDocContext -> SDoc -> Bool
 isEmpty ctx sdoc = Pretty.isEmpty $ runSDoc sdoc (ctx {sdocPprDebug = True})
 
diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index 9f093c7faf..79511e9d34 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -27,7 +27,6 @@ import GHC.Types.Fixity
 import GHC.Types.ForeignCall
 import GHC.Types.SourceText
 import GHC.Utils.Outputable hiding ( (<>) )
-import GHC.Driver.Ppr
 import GHC.Unit.Module.Warnings
 import GHC.Utils.Misc
 import GHC.Utils.Panic
diff --git a/utils/check-exact/Types.hs b/utils/check-exact/Types.hs
index ac9ae10375..ef08421583 100644
--- a/utils/check-exact/Types.hs
+++ b/utils/check-exact/Types.hs
@@ -13,7 +13,6 @@ module Types
 
 import GHC hiding (EpaComment)
 import GHC.Utils.Outputable hiding ( (<>) )
-import GHC.Driver.Ppr
 import Data.Data (Data, toConstr,cast)
 
 import qualified Data.Map as Map