Module hierarchy: ByteCode and Runtime (cf #13009)

Update haddock submodule

9 files changed, 5731 insertions, 1 deletions

diff --git a/compiler/GHC/Runtime/Debugger.hs b/compiler/GHC/Runtime/Debugger.hs
new file mode 100644
index 0000000000..9443ff9421
--- /dev/null
+++ b/compiler/GHC/Runtime/Debugger.hs
@@ -0,0 +1,237 @@
+{-# LANGUAGE MagicHash #-}
+
+-----------------------------------------------------------------------------
+--
+-- GHCi Interactive debugging commands
+--
+-- Pepe Iborra (supported by Google SoC) 2006
+--
+-- ToDo: lots of violation of layering here.  This module should
+-- decide whether it is above the GHC API (import GHC and nothing
+-- else) or below it.
+--
+-----------------------------------------------------------------------------
+
+module GHC.Runtime.Debugger (pprintClosureCommand, showTerm, pprTypeAndContents) where
+
+import GhcPrelude
+
+import GHC.Runtime.Linker
+import GHC.Runtime.Heap.Inspect
+
+import GHC.Runtime.Interpreter
+import GHCi.RemoteTypes
+import GhcMonad
+import HscTypes
+import Id
+import GHC.Iface.Syntax ( showToHeader )
+import GHC.Iface.Env    ( newInteractiveBinder )
+import Name
+import Var hiding ( varName )
+import VarSet
+import UniqSet
+import Type
+import GHC
+import Outputable
+import PprTyThing
+import ErrUtils
+import MonadUtils
+import DynFlags
+import Exception
+
+import Control.Monad
+import Data.List ( (\\) )
+import Data.Maybe
+import Data.IORef
+
+-------------------------------------
+-- | The :print & friends commands
+-------------------------------------
+pprintClosureCommand :: GhcMonad m => Bool -> Bool -> String -> m ()
+pprintClosureCommand bindThings force str = do
+  tythings <- (catMaybes . concat) `liftM`
+                 mapM (\w -> GHC.parseName w >>=
+                                mapM GHC.lookupName)
+                      (words str)
+  let ids = [id | AnId id <- tythings]
+
+  -- Obtain the terms and the recovered type information
+  (subst, terms) <- mapAccumLM go emptyTCvSubst ids
+
+  -- Apply the substitutions obtained after recovering the types
+  modifySession $ \hsc_env ->
+    hsc_env{hsc_IC = substInteractiveContext (hsc_IC hsc_env) subst}
+
+  -- Finally, print the Terms
+  unqual  <- GHC.getPrintUnqual
+  docterms <- mapM showTerm terms
+  dflags <- getDynFlags
+  liftIO $ (printOutputForUser dflags unqual . vcat)
+           (zipWith (\id docterm -> ppr id <+> char '=' <+> docterm)
+                    ids
+                    docterms)
+ where
+   -- Do the obtainTerm--bindSuspensions-computeSubstitution dance
+   go :: GhcMonad m => TCvSubst -> Id -> m (TCvSubst, Term)
+   go subst id = do
+       let id_ty' = substTy subst (idType id)
+           id'    = id `setIdType` id_ty'
+       term_    <- GHC.obtainTermFromId maxBound force id'
+       term     <- tidyTermTyVars term_
+       term'    <- if bindThings
+                     then bindSuspensions term
+                     else return term
+     -- Before leaving, we compare the type obtained to see if it's more specific
+     --  Then, we extract a substitution,
+     --  mapping the old tyvars to the reconstructed types.
+       let reconstructed_type = termType term
+       hsc_env <- getSession
+       case (improveRTTIType hsc_env id_ty' reconstructed_type) of
+         Nothing     -> return (subst, term')
+         Just subst' -> do { dflags <- GHC.getSessionDynFlags
+                           ; liftIO $
+                               dumpIfSet_dyn dflags Opt_D_dump_rtti "RTTI"
+                                 FormatText
+                                 (fsep $ [text "RTTI Improvement for", ppr id,
+                                  text "old substitution:" , ppr subst,
+                                  text "new substitution:" , ppr subst'])
+                           ; return (subst `unionTCvSubst` subst', term')}
+
+   tidyTermTyVars :: GhcMonad m => Term -> m Term
+   tidyTermTyVars t =
+     withSession $ \hsc_env -> do
+     let env_tvs      = tyThingsTyCoVars $ ic_tythings $ hsc_IC hsc_env
+         my_tvs       = termTyCoVars t
+         tvs          = env_tvs `minusVarSet` my_tvs
+         tyvarOccName = nameOccName . tyVarName
+         tidyEnv      = (initTidyOccEnv (map tyvarOccName (nonDetEltsUniqSet tvs))
+           -- It's OK to use nonDetEltsUniqSet here because initTidyOccEnv
+           -- forgets the ordering immediately by creating an env
+                        , getUniqSet $ env_tvs `intersectVarSet` my_tvs)
+     return $ mapTermType (snd . tidyOpenType tidyEnv) t
+
+-- | Give names, and bind in the interactive environment, to all the suspensions
+--   included (inductively) in a term
+bindSuspensions :: GhcMonad m => Term -> m Term
+bindSuspensions t = do
+      hsc_env <- getSession
+      inScope <- GHC.getBindings
+      let ictxt        = hsc_IC hsc_env
+          prefix       = "_t"
+          alreadyUsedNames = map (occNameString . nameOccName . getName) inScope
+          availNames   = map ((prefix++) . show) [(1::Int)..] \\ alreadyUsedNames
+      availNames_var  <- liftIO $ newIORef availNames
+      (t', stuff)     <- liftIO $ foldTerm (nameSuspensionsAndGetInfos hsc_env availNames_var) t
+      let (names, tys, fhvs) = unzip3 stuff
+      let ids = [ mkVanillaGlobal name ty
+                | (name,ty) <- zip names tys]
+          new_ic = extendInteractiveContextWithIds ictxt ids
+          dl = hsc_dynLinker hsc_env
+      liftIO $ extendLinkEnv dl (zip names fhvs)
+      setSession hsc_env {hsc_IC = new_ic }
+      return t'
+     where
+
+--    Processing suspensions. Give names and recopilate info
+        nameSuspensionsAndGetInfos :: HscEnv -> IORef [String]
+                                   -> TermFold (IO (Term, [(Name,Type,ForeignHValue)]))
+        nameSuspensionsAndGetInfos hsc_env freeNames = TermFold
+                      {
+                        fSuspension = doSuspension hsc_env freeNames
+                      , fTerm = \ty dc v tt -> do
+                                    tt' <- sequence tt
+                                    let (terms,names) = unzip tt'
+                                    return (Term ty dc v terms, concat names)
+                      , fPrim    = \ty n ->return (Prim ty n,[])
+                      , fNewtypeWrap  =
+                                \ty dc t -> do
+                                    (term, names) <- t
+                                    return (NewtypeWrap ty dc term, names)
+                      , fRefWrap = \ty t -> do
+                                    (term, names) <- t
+                                    return (RefWrap ty term, names)
+                      }
+        doSuspension hsc_env freeNames ct ty hval _name = do
+          name <- atomicModifyIORef' freeNames (\x->(tail x, head x))
+          n <- newGrimName hsc_env name
+          return (Suspension ct ty hval (Just n), [(n,ty,hval)])
+
+
+--  A custom Term printer to enable the use of Show instances
+showTerm :: GhcMonad m => Term -> m SDoc
+showTerm term = do
+    dflags       <- GHC.getSessionDynFlags
+    if gopt Opt_PrintEvldWithShow dflags
+       then cPprTerm (liftM2 (++) (\_y->[cPprShowable]) cPprTermBase) term
+       else cPprTerm cPprTermBase term
+ where
+  cPprShowable prec t@Term{ty=ty, val=fhv} =
+    if not (isFullyEvaluatedTerm t)
+     then return Nothing
+     else do
+        hsc_env <- getSession
+        dflags  <- GHC.getSessionDynFlags
+        do
+           (new_env, bname) <- bindToFreshName hsc_env ty "showme"
+           setSession new_env
+                      -- XXX: this tries to disable logging of errors
+                      -- does this still do what it is intended to do
+                      -- with the changed error handling and logging?
+           let noop_log _ _ _ _ _ _ = return ()
+               expr = "Prelude.return (Prelude.show " ++
+                         showPpr dflags bname ++
+                      ") :: Prelude.IO Prelude.String"
+               dl   = hsc_dynLinker hsc_env
+           _ <- GHC.setSessionDynFlags dflags{log_action=noop_log}
+           txt_ <- withExtendedLinkEnv dl
+                                       [(bname, fhv)]
+                                       (GHC.compileExprRemote expr)
+           let myprec = 10 -- application precedence. TODO Infix constructors
+           txt <- liftIO $ evalString hsc_env txt_
+           if not (null txt) then
+             return $ Just $ cparen (prec >= myprec && needsParens txt)
+                                    (text txt)
+            else return Nothing
+         `gfinally` do
+           setSession hsc_env
+           GHC.setSessionDynFlags dflags
+  cPprShowable prec NewtypeWrap{ty=new_ty,wrapped_term=t} =
+      cPprShowable prec t{ty=new_ty}
+  cPprShowable _ _ = return Nothing
+
+  needsParens ('"':_) = False   -- some simple heuristics to see whether parens
+                                -- are redundant in an arbitrary Show output
+  needsParens ('(':_) = False
+  needsParens txt = ' ' `elem` txt
+
+
+  bindToFreshName hsc_env ty userName = do
+    name <- newGrimName hsc_env userName
+    let id       = mkVanillaGlobal name ty
+        new_ic   = extendInteractiveContextWithIds (hsc_IC hsc_env) [id]
+    return (hsc_env {hsc_IC = new_ic }, name)
+
+--    Create new uniques and give them sequentially numbered names
+newGrimName :: MonadIO m => HscEnv -> String -> m Name
+newGrimName hsc_env userName
+  = liftIO (newInteractiveBinder hsc_env occ noSrcSpan)
+  where
+    occ = mkOccName varName userName
+
+pprTypeAndContents :: GhcMonad m => Id -> m SDoc
+pprTypeAndContents id = do
+  dflags  <- GHC.getSessionDynFlags
+  let pcontents = gopt Opt_PrintBindContents dflags
+      pprdId    = (pprTyThing showToHeader . AnId) id
+  if pcontents
+    then do
+      let depthBound = 100
+      -- If the value is an exception, make sure we catch it and
+      -- show the exception, rather than propagating the exception out.
+      e_term <- gtry $ GHC.obtainTermFromId depthBound False id
+      docs_term <- case e_term of
+                      Right term -> showTerm term
+                      Left  exn  -> return (text "*** Exception:" <+>
+                                            text (show (exn :: SomeException)))
+      return $ pprdId <+> equals <+> docs_term
+    else return pprdId
diff --git a/compiler/GHC/Runtime/Eval.hs b/compiler/GHC/Runtime/Eval.hs
new file mode 100644
index 0000000000..d43c5be7b8
--- /dev/null
+++ b/compiler/GHC/Runtime/Eval.hs
@@ -0,0 +1,1271 @@
+{-# LANGUAGE CPP, MagicHash, NondecreasingIndentation,
+    RecordWildCards, BangPatterns #-}
+
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+
+-- -----------------------------------------------------------------------------
+--
+-- (c) The University of Glasgow, 2005-2007
+--
+-- Running statements interactively
+--
+-- -----------------------------------------------------------------------------
+
+module GHC.Runtime.Eval (
+        Resume(..), History(..),
+        execStmt, execStmt', ExecOptions(..), execOptions, ExecResult(..), resumeExec,
+        runDecls, runDeclsWithLocation, runParsedDecls,
+        isStmt, hasImport, isImport, isDecl,
+        parseImportDecl, SingleStep(..),
+        abandon, abandonAll,
+        getResumeContext,
+        getHistorySpan,
+        getModBreaks,
+        getHistoryModule,
+        back, forward,
+        setContext, getContext,
+        availsToGlobalRdrEnv,
+        getNamesInScope,
+        getRdrNamesInScope,
+        moduleIsInterpreted,
+        getInfo,
+        exprType,
+        typeKind,
+        parseName,
+        parseInstanceHead,
+        getInstancesForType,
+        getDocs,
+        GetDocsFailure(..),
+        showModule,
+        moduleIsBootOrNotObjectLinkable,
+        parseExpr, compileParsedExpr,
+        compileExpr, dynCompileExpr,
+        compileExprRemote, compileParsedExprRemote,
+        Term(..), obtainTermFromId, obtainTermFromVal, reconstructType
+        ) where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import GHC.Runtime.Eval.Types
+
+import GHC.Runtime.Interpreter as GHCi
+import GHCi.Message
+import GHCi.RemoteTypes
+import GhcMonad
+import HscMain
+import GHC.Hs
+import HscTypes
+import InstEnv
+import GHC.Iface.Env   ( newInteractiveBinder )
+import FamInstEnv      ( FamInst )
+import CoreFVs         ( orphNamesOfFamInst )
+import TyCon
+import Type             hiding( typeKind )
+import GHC.Types.RepType
+import TcType
+import Constraint
+import TcOrigin
+import Predicate
+import Var
+import Id
+import Name             hiding ( varName )
+import NameSet
+import Avail
+import RdrName
+import VarEnv
+import GHC.ByteCode.Types
+import GHC.Runtime.Linker as Linker
+import DynFlags
+import Unique
+import UniqSupply
+import MonadUtils
+import Module
+import PrelNames  ( toDynName, pretendNameIsInScope )
+import TysWiredIn ( isCTupleTyConName )
+import Panic
+import Maybes
+import ErrUtils
+import SrcLoc
+import GHC.Runtime.Heap.Inspect
+import Outputable
+import FastString
+import Bag
+import Util
+import qualified Lexer (P (..), ParseResult(..), unP, mkPState)
+import qualified Parser (parseStmt, parseModule, parseDeclaration, parseImport)
+
+import System.Directory
+import Data.Dynamic
+import Data.Either
+import qualified Data.IntMap as IntMap
+import Data.List (find,intercalate)
+import Data.Map (Map)
+import qualified Data.Map as Map
+import StringBuffer (stringToStringBuffer)
+import Control.Monad
+import GHC.Exts
+import Data.Array
+import Exception
+
+import TcRnDriver ( runTcInteractive, tcRnType, loadUnqualIfaces )
+import TcHsSyn          ( ZonkFlexi (SkolemiseFlexi) )
+
+import TcEnv (tcGetInstEnvs)
+
+import Inst (instDFunType)
+import TcSimplify (solveWanteds)
+import TcRnMonad
+import TcEvidence
+import Data.Bifunctor (second)
+
+import TcSMonad (runTcS)
+
+-- -----------------------------------------------------------------------------
+-- running a statement interactively
+
+getResumeContext :: GhcMonad m => m [Resume]
+getResumeContext = withSession (return . ic_resume . hsc_IC)
+
+mkHistory :: HscEnv -> ForeignHValue -> BreakInfo -> History
+mkHistory hsc_env hval bi = History hval bi (findEnclosingDecls hsc_env bi)
+
+getHistoryModule :: History -> Module
+getHistoryModule = breakInfo_module . historyBreakInfo
+
+getHistorySpan :: HscEnv -> History -> SrcSpan
+getHistorySpan hsc_env History{..} =
+  let BreakInfo{..} = historyBreakInfo in
+  case lookupHpt (hsc_HPT hsc_env) (moduleName breakInfo_module) of
+    Just hmi -> modBreaks_locs (getModBreaks hmi) ! breakInfo_number
+    _ -> panic "getHistorySpan"
+
+getModBreaks :: HomeModInfo -> ModBreaks
+getModBreaks hmi
+  | Just linkable <- hm_linkable hmi,
+    [BCOs cbc _] <- linkableUnlinked linkable
+  = fromMaybe emptyModBreaks (bc_breaks cbc)
+  | otherwise
+  = emptyModBreaks -- probably object code
+
+{- | Finds the enclosing top level function name -}
+-- ToDo: a better way to do this would be to keep hold of the decl_path computed
+-- by the coverage pass, which gives the list of lexically-enclosing bindings
+-- for each tick.
+findEnclosingDecls :: HscEnv -> BreakInfo -> [String]
+findEnclosingDecls hsc_env (BreakInfo modl ix) =
+   let hmi = expectJust "findEnclosingDecls" $
+             lookupHpt (hsc_HPT hsc_env) (moduleName modl)
+       mb = getModBreaks hmi
+   in modBreaks_decls mb ! ix
+
+-- | Update fixity environment in the current interactive context.
+updateFixityEnv :: GhcMonad m => FixityEnv -> m ()
+updateFixityEnv fix_env = do
+  hsc_env <- getSession
+  let ic = hsc_IC hsc_env
+  setSession $ hsc_env { hsc_IC = ic { ic_fix_env = fix_env } }
+
+-- -----------------------------------------------------------------------------
+-- execStmt
+
+-- | default ExecOptions
+execOptions :: ExecOptions
+execOptions = ExecOptions
+  { execSingleStep = RunToCompletion
+  , execSourceFile = "<interactive>"
+  , execLineNumber = 1
+  , execWrap = EvalThis -- just run the statement, don't wrap it in anything
+  }
+
+-- | Run a statement in the current interactive context.
+execStmt
+  :: GhcMonad m
+  => String             -- ^ a statement (bind or expression)
+  -> ExecOptions
+  -> m ExecResult
+execStmt input exec_opts@ExecOptions{..} = do
+    hsc_env <- getSession
+
+    mb_stmt <-
+      liftIO $
+      runInteractiveHsc hsc_env $
+      hscParseStmtWithLocation execSourceFile execLineNumber input
+
+    case mb_stmt of
+      -- empty statement / comment
+      Nothing -> return (ExecComplete (Right []) 0)
+      Just stmt -> execStmt' stmt input exec_opts
+
+-- | Like `execStmt`, but takes a parsed statement as argument. Useful when
+-- doing preprocessing on the AST before execution, e.g. in GHCi (see
+-- GHCi.UI.runStmt).
+execStmt' :: GhcMonad m => GhciLStmt GhcPs -> String -> ExecOptions -> m ExecResult
+execStmt' stmt stmt_text ExecOptions{..} = do
+    hsc_env <- getSession
+
+    -- Turn off -fwarn-unused-local-binds when running a statement, to hide
+    -- warnings about the implicit bindings we introduce.
+    -- (This is basically `mkInteractiveHscEnv hsc_env`, except we unset
+    -- -wwarn-unused-local-binds)
+    let ic       = hsc_IC hsc_env -- use the interactive dflags
+        idflags' = ic_dflags ic `wopt_unset` Opt_WarnUnusedLocalBinds
+        hsc_env' = mkInteractiveHscEnv (hsc_env{ hsc_IC = ic{ ic_dflags = idflags' } })
+
+    r <- liftIO $ hscParsedStmt hsc_env' stmt
+
+    case r of
+      Nothing ->
+        -- empty statement / comment
+        return (ExecComplete (Right []) 0)
+      Just (ids, hval, fix_env) -> do
+        updateFixityEnv fix_env
+
+        status <-
+          withVirtualCWD $
+            liftIO $
+              evalStmt hsc_env' (isStep execSingleStep) (execWrap hval)
+
+        let ic = hsc_IC hsc_env
+            bindings = (ic_tythings ic, ic_rn_gbl_env ic)
+
+            size = ghciHistSize idflags'
+
+        handleRunStatus execSingleStep stmt_text bindings ids
+                        status (emptyHistory size)
+
+runDecls :: GhcMonad m => String -> m [Name]
+runDecls = runDeclsWithLocation "<interactive>" 1
+
+-- | Run some declarations and return any user-visible names that were brought
+-- into scope.
+runDeclsWithLocation :: GhcMonad m => String -> Int -> String -> m [Name]
+runDeclsWithLocation source line_num input = do
+    hsc_env <- getSession
+    decls <- liftIO (hscParseDeclsWithLocation hsc_env source line_num input)
+    runParsedDecls decls
+
+-- | Like `runDeclsWithLocation`, but takes parsed declarations as argument.
+-- Useful when doing preprocessing on the AST before execution, e.g. in GHCi
+-- (see GHCi.UI.runStmt).
+runParsedDecls :: GhcMonad m => [LHsDecl GhcPs] -> m [Name]
+runParsedDecls decls = do
+    hsc_env <- getSession
+    (tyThings, ic) <- liftIO (hscParsedDecls hsc_env decls)
+
+    setSession $ hsc_env { hsc_IC = ic }
+    hsc_env <- getSession
+    hsc_env' <- liftIO $ rttiEnvironment hsc_env
+    setSession hsc_env'
+    return $ filter (not . isDerivedOccName . nameOccName)
+             -- For this filter, see Note [What to show to users]
+           $ map getName tyThings
+
+{- Note [What to show to users]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We don't want to display internally-generated bindings to users.
+Things like the coercion axiom for newtypes. These bindings all get
+OccNames that users can't write, to avoid the possibility of name
+clashes (in linker symbols).  That gives a convenient way to suppress
+them. The relevant predicate is OccName.isDerivedOccName.
+See #11051 for more background and examples.
+-}
+
+withVirtualCWD :: GhcMonad m => m a -> m a
+withVirtualCWD m = do
+  hsc_env <- getSession
+
+    -- a virtual CWD is only necessary when we're running interpreted code in
+    -- the same process as the compiler.
+  if gopt Opt_ExternalInterpreter (hsc_dflags hsc_env) then m else do
+
+  let ic = hsc_IC hsc_env
+  let set_cwd = do
+        dir <- liftIO $ getCurrentDirectory
+        case ic_cwd ic of
+           Just dir -> liftIO $ setCurrentDirectory dir
+           Nothing  -> return ()
+        return dir
+
+      reset_cwd orig_dir = do
+        virt_dir <- liftIO $ getCurrentDirectory
+        hsc_env <- getSession
+        let old_IC = hsc_IC hsc_env
+        setSession hsc_env{  hsc_IC = old_IC{ ic_cwd = Just virt_dir } }
+        liftIO $ setCurrentDirectory orig_dir
+
+  gbracket set_cwd reset_cwd $ \_ -> m
+
+parseImportDecl :: GhcMonad m => String -> m (ImportDecl GhcPs)
+parseImportDecl expr = withSession $ \hsc_env -> liftIO $ hscImport hsc_env expr
+
+emptyHistory :: Int -> BoundedList History
+emptyHistory size = nilBL size
+
+handleRunStatus :: GhcMonad m
+                => SingleStep -> String-> ([TyThing],GlobalRdrEnv) -> [Id]
+                -> EvalStatus_ [ForeignHValue] [HValueRef]
+                -> BoundedList History
+                -> m ExecResult
+
+handleRunStatus step expr bindings final_ids status history
+  | RunAndLogSteps <- step = tracing
+  | otherwise              = not_tracing
+ where
+  tracing
+    | EvalBreak is_exception apStack_ref ix mod_uniq resume_ctxt _ccs <- status
+    , not is_exception
+    = do
+       hsc_env <- getSession
+       let hmi = expectJust "handleRunStatus" $
+                   lookupHptDirectly (hsc_HPT hsc_env)
+                                     (mkUniqueGrimily mod_uniq)
+           modl = mi_module (hm_iface hmi)
+           breaks = getModBreaks hmi
+
+       b <- liftIO $
+              breakpointStatus hsc_env (modBreaks_flags breaks) ix
+       if b
+         then not_tracing
+           -- This breakpoint is explicitly enabled; we want to stop
+           -- instead of just logging it.
+         else do
+           apStack_fhv <- liftIO $ mkFinalizedHValue hsc_env apStack_ref
+           let bi = BreakInfo modl ix
+               !history' = mkHistory hsc_env apStack_fhv bi `consBL` history
+                 -- history is strict, otherwise our BoundedList is pointless.
+           fhv <- liftIO $ mkFinalizedHValue hsc_env resume_ctxt
+           status <- liftIO $ GHCi.resumeStmt hsc_env True fhv
+           handleRunStatus RunAndLogSteps expr bindings final_ids
+                           status history'
+    | otherwise
+    = not_tracing
+
+  not_tracing
+    -- Hit a breakpoint
+    | EvalBreak is_exception apStack_ref ix mod_uniq resume_ctxt ccs <- status
+    = do
+         hsc_env <- getSession
+         resume_ctxt_fhv <- liftIO $ mkFinalizedHValue hsc_env resume_ctxt
+         apStack_fhv <- liftIO $ mkFinalizedHValue hsc_env apStack_ref
+         let hmi = expectJust "handleRunStatus" $
+                     lookupHptDirectly (hsc_HPT hsc_env)
+                                       (mkUniqueGrimily mod_uniq)
+             modl = mi_module (hm_iface hmi)
+             bp | is_exception = Nothing
+                | otherwise = Just (BreakInfo modl ix)
+         (hsc_env1, names, span, decl) <- liftIO $
+           bindLocalsAtBreakpoint hsc_env apStack_fhv bp
+         let
+           resume = Resume
+             { resumeStmt = expr, resumeContext = resume_ctxt_fhv
+             , resumeBindings = bindings, resumeFinalIds = final_ids
+             , resumeApStack = apStack_fhv
+             , resumeBreakInfo = bp
+             , resumeSpan = span, resumeHistory = toListBL history
+             , resumeDecl = decl
+             , resumeCCS = ccs
+             , resumeHistoryIx = 0 }
+           hsc_env2 = pushResume hsc_env1 resume
+
+         setSession hsc_env2
+         return (ExecBreak names bp)
+
+    -- Completed successfully
+    | EvalComplete allocs (EvalSuccess hvals) <- status
+    = do hsc_env <- getSession
+         let final_ic = extendInteractiveContextWithIds (hsc_IC hsc_env) final_ids
+             final_names = map getName final_ids
+             dl = hsc_dynLinker hsc_env
+         liftIO $ Linker.extendLinkEnv dl (zip final_names hvals)
+         hsc_env' <- liftIO $ rttiEnvironment hsc_env{hsc_IC=final_ic}
+         setSession hsc_env'
+         return (ExecComplete (Right final_names) allocs)
+
+    -- Completed with an exception
+    | EvalComplete alloc (EvalException e) <- status
+    = return (ExecComplete (Left (fromSerializableException e)) alloc)
+
+#if __GLASGOW_HASKELL__ <= 810
+    | otherwise
+    = panic "not_tracing" -- actually exhaustive, but GHC can't tell
+#endif
+
+
+resumeExec :: GhcMonad m => (SrcSpan->Bool) -> SingleStep -> m ExecResult
+resumeExec canLogSpan step
+ = do
+   hsc_env <- getSession
+   let ic = hsc_IC hsc_env
+       resume = ic_resume ic
+
+   case resume of
+     [] -> liftIO $
+           throwGhcExceptionIO (ProgramError "not stopped at a breakpoint")
+     (r:rs) -> do
+        -- unbind the temporary locals by restoring the TypeEnv from
+        -- before the breakpoint, and drop this Resume from the
+        -- InteractiveContext.
+        let (resume_tmp_te,resume_rdr_env) = resumeBindings r
+            ic' = ic { ic_tythings = resume_tmp_te,
+                       ic_rn_gbl_env = resume_rdr_env,
+                       ic_resume   = rs }
+        setSession hsc_env{ hsc_IC = ic' }
+
+        -- remove any bindings created since the breakpoint from the
+        -- linker's environment
+        let old_names = map getName resume_tmp_te
+            new_names = [ n | thing <- ic_tythings ic
+                            , let n = getName thing
+                            , not (n `elem` old_names) ]
+            dl        = hsc_dynLinker hsc_env
+        liftIO $ Linker.deleteFromLinkEnv dl new_names
+
+        case r of
+          Resume { resumeStmt = expr, resumeContext = fhv
+                 , resumeBindings = bindings, resumeFinalIds = final_ids
+                 , resumeApStack = apStack, resumeBreakInfo = mb_brkpt
+                 , resumeSpan = span
+                 , resumeHistory = hist } -> do
+               withVirtualCWD $ do
+                status <- liftIO $ GHCi.resumeStmt hsc_env (isStep step) fhv
+                let prevHistoryLst = fromListBL 50 hist
+                    hist' = case mb_brkpt of
+                       Nothing -> prevHistoryLst
+                       Just bi
+                         | not $canLogSpan span -> prevHistoryLst
+                         | otherwise -> mkHistory hsc_env apStack bi `consBL`
+                                                        fromListBL 50 hist
+                handleRunStatus step expr bindings final_ids status hist'
+
+back :: GhcMonad m => Int -> m ([Name], Int, SrcSpan, String)
+back n = moveHist (+n)
+
+forward :: GhcMonad m => Int -> m ([Name], Int, SrcSpan, String)
+forward n = moveHist (subtract n)
+
+moveHist :: GhcMonad m => (Int -> Int) -> m ([Name], Int, SrcSpan, String)
+moveHist fn = do
+  hsc_env <- getSession
+  case ic_resume (hsc_IC hsc_env) of
+     [] -> liftIO $
+           throwGhcExceptionIO (ProgramError "not stopped at a breakpoint")
+     (r:rs) -> do
+        let ix = resumeHistoryIx r
+            history = resumeHistory r
+            new_ix = fn ix
+        --
+        when (history `lengthLessThan` new_ix) $ liftIO $
+           throwGhcExceptionIO (ProgramError "no more logged breakpoints")
+        when (new_ix < 0) $ liftIO $
+           throwGhcExceptionIO (ProgramError "already at the beginning of the history")
+
+        let
+          update_ic apStack mb_info = do
+            (hsc_env1, names, span, decl) <-
+              liftIO $ bindLocalsAtBreakpoint hsc_env apStack mb_info
+            let ic = hsc_IC hsc_env1
+                r' = r { resumeHistoryIx = new_ix }
+                ic' = ic { ic_resume = r':rs }
+
+            setSession hsc_env1{ hsc_IC = ic' }
+
+            return (names, new_ix, span, decl)
+
+        -- careful: we want apStack to be the AP_STACK itself, not a thunk
+        -- around it, hence the cases are carefully constructed below to
+        -- make this the case.  ToDo: this is v. fragile, do something better.
+        if new_ix == 0
+           then case r of
+                   Resume { resumeApStack = apStack,
+                            resumeBreakInfo = mb_brkpt } ->
+                          update_ic apStack mb_brkpt
+           else case history !! (new_ix - 1) of
+                   History{..} ->
+                     update_ic historyApStack (Just historyBreakInfo)
+
+
+-- -----------------------------------------------------------------------------
+-- After stopping at a breakpoint, add free variables to the environment
+
+result_fs :: FastString
+result_fs = fsLit "_result"
+
+bindLocalsAtBreakpoint
+        :: HscEnv
+        -> ForeignHValue
+        -> Maybe BreakInfo
+        -> IO (HscEnv, [Name], SrcSpan, String)
+
+-- Nothing case: we stopped when an exception was raised, not at a
+-- breakpoint.  We have no location information or local variables to
+-- bind, all we can do is bind a local variable to the exception
+-- value.
+bindLocalsAtBreakpoint hsc_env apStack Nothing = do
+   let exn_occ = mkVarOccFS (fsLit "_exception")
+       span    = mkGeneralSrcSpan (fsLit "<unknown>")
+   exn_name <- newInteractiveBinder hsc_env exn_occ span
+
+   let e_fs    = fsLit "e"
+       e_name  = mkInternalName (getUnique e_fs) (mkTyVarOccFS e_fs) span
+       e_tyvar = mkRuntimeUnkTyVar e_name liftedTypeKind
+       exn_id  = Id.mkVanillaGlobal exn_name (mkTyVarTy e_tyvar)
+
+       ictxt0 = hsc_IC hsc_env
+       ictxt1 = extendInteractiveContextWithIds ictxt0 [exn_id]
+       dl     = hsc_dynLinker hsc_env
+   --
+   Linker.extendLinkEnv dl [(exn_name, apStack)]
+   return (hsc_env{ hsc_IC = ictxt1 }, [exn_name], span, "<exception thrown>")
+
+-- Just case: we stopped at a breakpoint, we have information about the location
+-- of the breakpoint and the free variables of the expression.
+bindLocalsAtBreakpoint hsc_env apStack_fhv (Just BreakInfo{..}) = do
+   let
+       hmi       = expectJust "bindLocalsAtBreakpoint" $
+                     lookupHpt (hsc_HPT hsc_env) (moduleName breakInfo_module)
+       breaks    = getModBreaks hmi
+       info      = expectJust "bindLocalsAtBreakpoint2" $
+                     IntMap.lookup breakInfo_number (modBreaks_breakInfo breaks)
+       mbVars    = cgb_vars info
+       result_ty = cgb_resty info
+       occs      = modBreaks_vars breaks ! breakInfo_number
+       span      = modBreaks_locs breaks ! breakInfo_number
+       decl      = intercalate "." $ modBreaks_decls breaks ! breakInfo_number
+
+           -- Filter out any unboxed ids by changing them to Nothings;
+           -- we can't bind these at the prompt
+       mbPointers = nullUnboxed <$> mbVars
+
+       (ids, offsets, occs') = syncOccs mbPointers occs
+
+       free_tvs = tyCoVarsOfTypesList (result_ty:map idType ids)
+
+   -- It might be that getIdValFromApStack fails, because the AP_STACK
+   -- has been accidentally evaluated, or something else has gone wrong.
+   -- So that we don't fall over in a heap when this happens, just don't
+   -- bind any free variables instead, and we emit a warning.
+   mb_hValues <-
+      mapM (getBreakpointVar hsc_env apStack_fhv . fromIntegral) offsets
+   when (any isNothing mb_hValues) $
+      debugTraceMsg (hsc_dflags hsc_env) 1 $
+          text "Warning: _result has been evaluated, some bindings have been lost"
+
+   us <- mkSplitUniqSupply 'I'   -- Dodgy; will give the same uniques every time
+   let tv_subst     = newTyVars us free_tvs
+       (filtered_ids, occs'') = unzip         -- again, sync the occ-names
+          [ (id, occ) | (id, Just _hv, occ) <- zip3 ids mb_hValues occs' ]
+       (_,tidy_tys) = tidyOpenTypes emptyTidyEnv $
+                      map (substTy tv_subst . idType) filtered_ids
+
+   new_ids     <- zipWith3M mkNewId occs'' tidy_tys filtered_ids
+   result_name <- newInteractiveBinder hsc_env (mkVarOccFS result_fs) span
+
+   let result_id = Id.mkVanillaGlobal result_name
+                     (substTy tv_subst result_ty)
+       result_ok = isPointer result_id
+
+       final_ids | result_ok = result_id : new_ids
+                 | otherwise = new_ids
+       ictxt0 = hsc_IC hsc_env
+       ictxt1 = extendInteractiveContextWithIds ictxt0 final_ids
+       names  = map idName new_ids
+       dl     = hsc_dynLinker hsc_env
+
+   let fhvs = catMaybes mb_hValues
+   Linker.extendLinkEnv dl (zip names fhvs)
+   when result_ok $ Linker.extendLinkEnv dl [(result_name, apStack_fhv)]
+   hsc_env1 <- rttiEnvironment hsc_env{ hsc_IC = ictxt1 }
+   return (hsc_env1, if result_ok then result_name:names else names, span, decl)
+  where
+        -- We need a fresh Unique for each Id we bind, because the linker
+        -- state is single-threaded and otherwise we'd spam old bindings
+        -- whenever we stop at a breakpoint.  The InteractveContext is properly
+        -- saved/restored, but not the linker state.  See #1743, test break026.
+   mkNewId :: OccName -> Type -> Id -> IO Id
+   mkNewId occ ty old_id
+     = do { name <- newInteractiveBinder hsc_env occ (getSrcSpan old_id)
+          ; return (Id.mkVanillaGlobalWithInfo name ty (idInfo old_id)) }
+
+   newTyVars :: UniqSupply -> [TcTyVar] -> TCvSubst
+     -- Similarly, clone the type variables mentioned in the types
+     -- we have here, *and* make them all RuntimeUnk tyvars
+   newTyVars us tvs
+     = mkTvSubstPrs [ (tv, mkTyVarTy (mkRuntimeUnkTyVar name (tyVarKind tv)))
+                    | (tv, uniq) <- tvs `zip` uniqsFromSupply us
+                    , let name = setNameUnique (tyVarName tv) uniq ]
+
+   isPointer id | [rep] <- typePrimRep (idType id)
+                , isGcPtrRep rep                   = True
+                | otherwise                        = False
+
+   -- Convert unboxed Id's to Nothings
+   nullUnboxed (Just (fv@(id, _)))
+     | isPointer id          = Just fv
+     | otherwise             = Nothing
+   nullUnboxed Nothing       = Nothing
+
+   -- See Note [Syncing breakpoint info]
+   syncOccs :: [Maybe (a,b)] -> [c] -> ([a], [b], [c])
+   syncOccs mbVs ocs = unzip3 $ catMaybes $ joinOccs mbVs ocs
+     where
+       joinOccs :: [Maybe (a,b)] -> [c] -> [Maybe (a,b,c)]
+       joinOccs = zipWith joinOcc
+       joinOcc mbV oc = (\(a,b) c -> (a,b,c)) <$> mbV <*> pure oc
+
+rttiEnvironment :: HscEnv -> IO HscEnv
+rttiEnvironment hsc_env@HscEnv{hsc_IC=ic} = do
+   let tmp_ids = [id | AnId id <- ic_tythings ic]
+       incompletelyTypedIds =
+           [id | id <- tmp_ids
+               , not $ noSkolems id
+               , (occNameFS.nameOccName.idName) id /= result_fs]
+   hsc_env' <- foldM improveTypes hsc_env (map idName incompletelyTypedIds)
+   return hsc_env'
+    where
+     noSkolems = noFreeVarsOfType . idType
+     improveTypes hsc_env@HscEnv{hsc_IC=ic} name = do
+      let tmp_ids = [id | AnId id <- ic_tythings ic]
+          Just id = find (\i -> idName i == name) tmp_ids
+      if noSkolems id
+         then return hsc_env
+         else do
+           mb_new_ty <- reconstructType hsc_env 10 id
+           let old_ty = idType id
+           case mb_new_ty of
+             Nothing -> return hsc_env
+             Just new_ty -> do
+              case improveRTTIType hsc_env old_ty new_ty of
+               Nothing -> return $
+                        WARN(True, text (":print failed to calculate the "
+                                           ++ "improvement for a type")) hsc_env
+               Just subst -> do
+                 let dflags = hsc_dflags hsc_env
+                 dumpIfSet_dyn dflags Opt_D_dump_rtti "RTTI"
+                   FormatText
+                   (fsep [text "RTTI Improvement for", ppr id, equals,
+                          ppr subst])
+
+                 let ic' = substInteractiveContext ic subst
+                 return hsc_env{hsc_IC=ic'}
+
+pushResume :: HscEnv -> Resume -> HscEnv
+pushResume hsc_env resume = hsc_env { hsc_IC = ictxt1 }
+  where
+        ictxt0 = hsc_IC hsc_env
+        ictxt1 = ictxt0 { ic_resume = resume : ic_resume ictxt0 }
+
+
+  {-
+  Note [Syncing breakpoint info]
+
+  To display the values of the free variables for a single breakpoint, the
+  function `GHC.Runtime.Eval.bindLocalsAtBreakpoint` pulls
+  out the information from the fields `modBreaks_breakInfo` and
+  `modBreaks_vars` of the `ModBreaks` data structure.
+  For a specific breakpoint this gives 2 lists of type `Id` (or `Var`)
+  and `OccName`.
+  They are used to create the Id's for the free variables and must be kept
+  in sync!
+
+  There are 3 situations where items are removed from the Id list
+  (or replaced with `Nothing`):
+  1.) If function `GHC.CoreToByteCode.schemeER_wrk` (which creates
+      the Id list) doesn't find an Id in the ByteCode environement.
+  2.) If function `GHC.Runtime.Eval.bindLocalsAtBreakpoint`
+      filters out unboxed elements from the Id list, because GHCi cannot
+      yet handle them.
+  3.) If the GHCi interpreter doesn't find the reference to a free variable
+      of our breakpoint. This also happens in the function
+      bindLocalsAtBreakpoint.
+
+  If an element is removed from the Id list, then the corresponding element
+  must also be removed from the Occ list. Otherwise GHCi will confuse
+  variable names as in #8487.
+  -}
+
+-- -----------------------------------------------------------------------------
+-- Abandoning a resume context
+
+abandon :: GhcMonad m => m Bool
+abandon = do
+   hsc_env <- getSession
+   let ic = hsc_IC hsc_env
+       resume = ic_resume ic
+   case resume of
+      []    -> return False
+      r:rs  -> do
+         setSession hsc_env{ hsc_IC = ic { ic_resume = rs } }
+         liftIO $ abandonStmt hsc_env (resumeContext r)
+         return True
+
+abandonAll :: GhcMonad m => m Bool
+abandonAll = do
+   hsc_env <- getSession
+   let ic = hsc_IC hsc_env
+       resume = ic_resume ic
+   case resume of
+      []  -> return False
+      rs  -> do
+         setSession hsc_env{ hsc_IC = ic { ic_resume = [] } }
+         liftIO $ mapM_ (abandonStmt hsc_env. resumeContext) rs
+         return True
+
+-- -----------------------------------------------------------------------------
+-- Bounded list, optimised for repeated cons
+
+data BoundedList a = BL
+                        {-# UNPACK #-} !Int  -- length
+                        {-# UNPACK #-} !Int  -- bound
+                        [a] -- left
+                        [a] -- right,  list is (left ++ reverse right)
+
+nilBL :: Int -> BoundedList a
+nilBL bound = BL 0 bound [] []
+
+consBL :: a -> BoundedList a -> BoundedList a
+consBL a (BL len bound left right)
+  | len < bound = BL (len+1) bound (a:left) right
+  | null right  = BL len     bound [a]      $! tail (reverse left)
+  | otherwise   = BL len     bound (a:left) $! tail right
+
+toListBL :: BoundedList a -> [a]
+toListBL (BL _ _ left right) = left ++ reverse right
+
+fromListBL :: Int -> [a] -> BoundedList a
+fromListBL bound l = BL (length l) bound l []
+
+-- lenBL (BL len _ _ _) = len
+
+-- -----------------------------------------------------------------------------
+-- | Set the interactive evaluation context.
+--
+-- (setContext imports) sets the ic_imports field (which in turn
+-- determines what is in scope at the prompt) to 'imports', and
+-- constructs the ic_rn_glb_env environment to reflect it.
+--
+-- We retain in scope all the things defined at the prompt, and kept
+-- in ic_tythings.  (Indeed, they shadow stuff from ic_imports.)
+
+setContext :: GhcMonad m => [InteractiveImport] -> m ()
+setContext imports
+  = do { hsc_env <- getSession
+       ; let dflags = hsc_dflags hsc_env
+       ; all_env_err <- liftIO $ findGlobalRdrEnv hsc_env imports
+       ; case all_env_err of
+           Left (mod, err) ->
+               liftIO $ throwGhcExceptionIO (formatError dflags mod err)
+           Right all_env -> do {
+       ; let old_ic         = hsc_IC hsc_env
+             !final_rdr_env = all_env `icExtendGblRdrEnv` ic_tythings old_ic
+       ; setSession
+         hsc_env{ hsc_IC = old_ic { ic_imports    = imports
+                                  , ic_rn_gbl_env = final_rdr_env }}}}
+  where
+    formatError dflags mod err = ProgramError . showSDoc dflags $
+      text "Cannot add module" <+> ppr mod <+>
+      text "to context:" <+> text err
+
+findGlobalRdrEnv :: HscEnv -> [InteractiveImport]
+                 -> IO (Either (ModuleName, String) GlobalRdrEnv)
+-- Compute the GlobalRdrEnv for the interactive context
+findGlobalRdrEnv hsc_env imports
+  = do { idecls_env <- hscRnImportDecls hsc_env idecls
+                    -- This call also loads any orphan modules
+       ; return $ case partitionEithers (map mkEnv imods) of
+           ([], imods_env) -> Right (foldr plusGlobalRdrEnv idecls_env imods_env)
+           (err : _, _)    -> Left err }
+  where
+    idecls :: [LImportDecl GhcPs]
+    idecls = [noLoc d | IIDecl d <- imports]
+
+    imods :: [ModuleName]
+    imods = [m | IIModule m <- imports]
+
+    mkEnv mod = case mkTopLevEnv (hsc_HPT hsc_env) mod of
+      Left err -> Left (mod, err)
+      Right env -> Right env
+
+availsToGlobalRdrEnv :: ModuleName -> [AvailInfo] -> GlobalRdrEnv
+availsToGlobalRdrEnv mod_name avails
+  = mkGlobalRdrEnv (gresFromAvails (Just imp_spec) avails)
+  where
+      -- We're building a GlobalRdrEnv as if the user imported
+      -- all the specified modules into the global interactive module
+    imp_spec = ImpSpec { is_decl = decl, is_item = ImpAll}
+    decl = ImpDeclSpec { is_mod = mod_name, is_as = mod_name,
+                         is_qual = False,
+                         is_dloc = srcLocSpan interactiveSrcLoc }
+
+mkTopLevEnv :: HomePackageTable -> ModuleName -> Either String GlobalRdrEnv
+mkTopLevEnv hpt modl
+  = case lookupHpt hpt modl of
+      Nothing -> Left "not a home module"
+      Just details ->
+         case mi_globals (hm_iface details) of
+                Nothing  -> Left "not interpreted"
+                Just env -> Right env
+
+-- | Get the interactive evaluation context, consisting of a pair of the
+-- set of modules from which we take the full top-level scope, and the set
+-- of modules from which we take just the exports respectively.
+getContext :: GhcMonad m => m [InteractiveImport]
+getContext = withSession $ \HscEnv{ hsc_IC=ic } ->
+             return (ic_imports ic)
+
+-- | Returns @True@ if the specified module is interpreted, and hence has
+-- its full top-level scope available.
+moduleIsInterpreted :: GhcMonad m => Module -> m Bool
+moduleIsInterpreted modl = withSession $ \h ->
+ if moduleUnitId modl /= thisPackage (hsc_dflags h)
+        then return False
+        else case lookupHpt (hsc_HPT h) (moduleName modl) of
+                Just details       -> return (isJust (mi_globals (hm_iface details)))
+                _not_a_home_module -> return False
+
+-- | Looks up an identifier in the current interactive context (for :info)
+-- Filter the instances by the ones whose tycons (or clases resp)
+-- are in scope (qualified or otherwise).  Otherwise we list a whole lot too many!
+-- The exact choice of which ones to show, and which to hide, is a judgement call.
+--      (see #1581)
+getInfo :: GhcMonad m => Bool -> Name
+        -> m (Maybe (TyThing,Fixity,[ClsInst],[FamInst], SDoc))
+getInfo allInfo name
+  = withSession $ \hsc_env ->
+    do mb_stuff <- liftIO $ hscTcRnGetInfo hsc_env name
+       case mb_stuff of
+         Nothing -> return Nothing
+         Just (thing, fixity, cls_insts, fam_insts, docs) -> do
+           let rdr_env = ic_rn_gbl_env (hsc_IC hsc_env)
+
+           -- Filter the instances based on whether the constituent names of their
+           -- instance heads are all in scope.
+           let cls_insts' = filter (plausible rdr_env . orphNamesOfClsInst) cls_insts
+               fam_insts' = filter (plausible rdr_env . orphNamesOfFamInst) fam_insts
+           return (Just (thing, fixity, cls_insts', fam_insts', docs))
+  where
+    plausible rdr_env names
+          -- Dfun involving only names that are in ic_rn_glb_env
+        = allInfo
+       || nameSetAll ok names
+        where   -- A name is ok if it's in the rdr_env,
+                -- whether qualified or not
+          ok n | n == name              = True
+                       -- The one we looked for in the first place!
+               | pretendNameIsInScope n = True
+               | isBuiltInSyntax n      = True
+               | isCTupleTyConName n    = True
+               | isExternalName n       = isJust (lookupGRE_Name rdr_env n)
+               | otherwise              = True
+
+-- | Returns all names in scope in the current interactive context
+getNamesInScope :: GhcMonad m => m [Name]
+getNamesInScope = withSession $ \hsc_env -> do
+  return (map gre_name (globalRdrEnvElts (ic_rn_gbl_env (hsc_IC hsc_env))))
+
+-- | Returns all 'RdrName's in scope in the current interactive
+-- context, excluding any that are internally-generated.
+getRdrNamesInScope :: GhcMonad m => m [RdrName]
+getRdrNamesInScope = withSession $ \hsc_env -> do
+  let
+      ic = hsc_IC hsc_env
+      gbl_rdrenv = ic_rn_gbl_env ic
+      gbl_names = concatMap greRdrNames $ globalRdrEnvElts gbl_rdrenv
+  -- Exclude internally generated names; see e.g. #11328
+  return (filter (not . isDerivedOccName . rdrNameOcc) gbl_names)
+
+
+-- | Parses a string as an identifier, and returns the list of 'Name's that
+-- the identifier can refer to in the current interactive context.
+parseName :: GhcMonad m => String -> m [Name]
+parseName str = withSession $ \hsc_env -> liftIO $
+   do { lrdr_name <- hscParseIdentifier hsc_env str
+      ; hscTcRnLookupRdrName hsc_env lrdr_name }
+
+-- | Returns @True@ if passed string is a statement.
+isStmt :: DynFlags -> String -> Bool
+isStmt dflags stmt =
+  case parseThing Parser.parseStmt dflags stmt of
+    Lexer.POk _ _ -> True
+    Lexer.PFailed _ -> False
+
+-- | Returns @True@ if passed string has an import declaration.
+hasImport :: DynFlags -> String -> Bool
+hasImport dflags stmt =
+  case parseThing Parser.parseModule dflags stmt of
+    Lexer.POk _ thing -> hasImports thing
+    Lexer.PFailed _ -> False
+  where
+    hasImports = not . null . hsmodImports . unLoc
+
+-- | Returns @True@ if passed string is an import declaration.
+isImport :: DynFlags -> String -> Bool
+isImport dflags stmt =
+  case parseThing Parser.parseImport dflags stmt of
+    Lexer.POk _ _ -> True
+    Lexer.PFailed _ -> False
+
+-- | Returns @True@ if passed string is a declaration but __/not a splice/__.
+isDecl :: DynFlags -> String -> Bool
+isDecl dflags stmt = do
+  case parseThing Parser.parseDeclaration dflags stmt of
+    Lexer.POk _ thing ->
+      case unLoc thing of
+        SpliceD _ _ -> False
+        _ -> True
+    Lexer.PFailed _ -> False
+
+parseThing :: Lexer.P thing -> DynFlags -> String -> Lexer.ParseResult thing
+parseThing parser dflags stmt = do
+  let buf = stringToStringBuffer stmt
+      loc = mkRealSrcLoc (fsLit "<interactive>") 1 1
+
+  Lexer.unP parser (Lexer.mkPState dflags buf loc)
+
+getDocs :: GhcMonad m
+        => Name
+        -> m (Either GetDocsFailure (Maybe HsDocString, Map Int HsDocString))
+           -- TODO: What about docs for constructors etc.?
+getDocs name =
+  withSession $ \hsc_env -> do
+     case nameModule_maybe name of
+       Nothing -> pure (Left (NameHasNoModule name))
+       Just mod -> do
+         if isInteractiveModule mod
+           then pure (Left InteractiveName)
+           else do
+             ModIface { mi_doc_hdr = mb_doc_hdr
+                      , mi_decl_docs = DeclDocMap dmap
+                      , mi_arg_docs = ArgDocMap amap
+                      } <- liftIO $ hscGetModuleInterface hsc_env mod
+             if isNothing mb_doc_hdr && Map.null dmap && Map.null amap
+               then pure (Left (NoDocsInIface mod compiled))
+               else pure (Right ( Map.lookup name dmap
+                                , Map.findWithDefault Map.empty name amap))
+  where
+    compiled =
+      -- TODO: Find a more direct indicator.
+      case nameSrcLoc name of
+        RealSrcLoc {} -> False
+        UnhelpfulLoc {} -> True
+
+-- | Failure modes for 'getDocs'.
+
+-- TODO: Find a way to differentiate between modules loaded without '-haddock'
+-- and modules that contain no docs.
+data GetDocsFailure
+
+    -- | 'nameModule_maybe' returned 'Nothing'.
+  = NameHasNoModule Name
+
+    -- | This is probably because the module was loaded without @-haddock@,
+    -- but it's also possible that the entire module contains no documentation.
+  | NoDocsInIface
+      Module
+      Bool -- ^ 'True': The module was compiled.
+           -- 'False': The module was :loaded.
+
+    -- | The 'Name' was defined interactively.
+  | InteractiveName
+
+instance Outputable GetDocsFailure where
+  ppr (NameHasNoModule name) =
+    quotes (ppr name) <+> text "has no module where we could look for docs."
+  ppr (NoDocsInIface mod compiled) = vcat
+    [ text "Can't find any documentation for" <+> ppr mod <> char '.'
+    , text "This is probably because the module was"
+        <+> text (if compiled then "compiled" else "loaded")
+        <+> text "without '-haddock',"
+    , text "but it's also possible that the module contains no documentation."
+    , text ""
+    , if compiled
+        then text "Try re-compiling with '-haddock'."
+        else text "Try running ':set -haddock' and :load the file again."
+        -- TODO: Figure out why :reload doesn't load the docs and maybe fix it.
+    ]
+  ppr InteractiveName =
+    text "Docs are unavailable for interactive declarations."
+
+-- -----------------------------------------------------------------------------
+-- Getting the type of an expression
+
+-- | Get the type of an expression
+-- Returns the type as described by 'TcRnExprMode'
+exprType :: GhcMonad m => TcRnExprMode -> String -> m Type
+exprType mode expr = withSession $ \hsc_env -> do
+   ty <- liftIO $ hscTcExpr hsc_env mode expr
+   return $ tidyType emptyTidyEnv ty
+
+-- -----------------------------------------------------------------------------
+-- Getting the kind of a type
+
+-- | Get the kind of a  type
+typeKind  :: GhcMonad m => Bool -> String -> m (Type, Kind)
+typeKind normalise str = withSession $ \hsc_env -> do
+   liftIO $ hscKcType hsc_env normalise str
+
+-- ----------------------------------------------------------------------------
+-- Getting the class instances for a type
+
+{-
+  Note [Querying instances for a type]
+
+  Here is the implementation of GHC proposal 41.
+  (https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0041-ghci-instances.rst)
+
+  The objective is to take a query string representing a (partial) type, and
+  report all the class single-parameter class instances available to that type.
+  Extending this feature to multi-parameter typeclasses is left as future work.
+
+  The general outline of how we solve this is:
+
+  1. Parse the type, leaving skolems in the place of type-holes.
+  2. For every class, get a list of all instances that match with the query type.
+  3. For every matching instance, ask GHC for the context the instance dictionary needs.
+  4. Format and present the results, substituting our query into the instance
+     and simplifying the context.
+
+  For example, given the query "Maybe Int", we want to return:
+
+  instance Show (Maybe Int)
+  instance Read (Maybe Int)
+  instance Eq   (Maybe Int)
+  ....
+
+  [Holes in queries]
+
+  Often times we want to know what instances are available for a polymorphic type,
+  like `Maybe a`, and we'd like to return instances such as:
+
+  instance Show a => Show (Maybe a)
+  ....
+
+  These queries are expressed using type holes, so instead of `Maybe a` the user writes
+  `Maybe _`, we parse the type and during zonking, we skolemise it, replacing the holes
+  with (un-named) type variables.
+
+  When zonking the type holes we have two real choices: replace them with Any or replace
+  them with skolem typevars. Using skolem type variables ensures that the output is more
+  intuitive to end users, and there is no difference in the results between Any and skolems.
+
+-}
+
+-- Find all instances that match a provided type
+getInstancesForType :: GhcMonad m => Type -> m [ClsInst]
+getInstancesForType ty = withSession $ \hsc_env -> do
+  liftIO $ runInteractiveHsc hsc_env $ do
+    ioMsgMaybe $ runTcInteractive hsc_env $ do
+      -- Bring class and instances from unqualified modules into scope, this fixes #16793.
+      loadUnqualIfaces hsc_env (hsc_IC hsc_env)
+      matches <- findMatchingInstances ty
+      fmap catMaybes . forM matches $ uncurry checkForExistence
+
+-- Parse a type string and turn any holes into skolems
+parseInstanceHead :: GhcMonad m => String -> m Type
+parseInstanceHead str = withSession $ \hsc_env0 -> do
+  (ty, _) <- liftIO $ runInteractiveHsc hsc_env0 $ do
+    hsc_env <- getHscEnv
+    ty <- hscParseType str
+    ioMsgMaybe $ tcRnType hsc_env SkolemiseFlexi True ty
+
+  return ty
+
+-- Get all the constraints required of a dictionary binding
+getDictionaryBindings :: PredType -> TcM WantedConstraints
+getDictionaryBindings theta = do
+  dictName <- newName (mkDictOcc (mkVarOcc "magic"))
+  let dict_var = mkVanillaGlobal dictName theta
+  loc <- getCtLocM (GivenOrigin UnkSkol) Nothing
+  let wCs = mkSimpleWC [CtDerived
+          { ctev_pred = varType dict_var
+          , ctev_loc = loc
+          }]
+
+  return wCs
+
+{-
+  When we've found an instance that a query matches against, we still need to
+  check that all the instance's constraints are satisfiable. checkForExistence
+  creates an instance dictionary and verifies that any unsolved constraints
+  mention a type-hole, meaning it is blocked on an unknown.
+
+  If the instance satisfies this condition, then we return it with the query
+  substituted into the instance and all constraints simplified, for example given:
+
+  instance D a => C (MyType a b) where
+
+  and the query `MyType _ String`
+
+  the unsolved constraints will be [D _] so we apply the substitution:
+
+  { a -> _; b -> String}
+
+  and return the instance:
+
+  instance D _ => C (MyType _ String)
+
+-}
+
+checkForExistence :: ClsInst -> [DFunInstType] -> TcM (Maybe ClsInst)
+checkForExistence res mb_inst_tys = do
+  (tys, thetas) <- instDFunType (is_dfun res) mb_inst_tys
+
+  wanteds <- forM thetas getDictionaryBindings
+  (residuals, _) <- second evBindMapBinds <$> runTcS (solveWanteds (unionsWC wanteds))
+
+  let all_residual_constraints = bagToList $ wc_simple residuals
+  let preds = map ctPred all_residual_constraints
+  if all isSatisfiablePred preds && (null $ wc_impl residuals)
+  then return . Just $ substInstArgs tys preds res
+  else return Nothing
+
+  where
+
+  -- Stricter version of isTyVarClassPred that requires all TyConApps to have at least
+  -- one argument or for the head to be a TyVar. The reason is that we want to ensure
+  -- that all residual constraints mention a type-hole somewhere in the constraint,
+  -- meaning that with the correct choice of a concrete type it could be possible for
+  -- the constraint to be discharged.
+  isSatisfiablePred :: PredType -> Bool
+  isSatisfiablePred ty = case getClassPredTys_maybe ty of
+      Just (_, tys@(_:_)) -> all isTyVarTy tys
+      _                   -> isTyVarTy ty
+
+  empty_subst = mkEmptyTCvSubst (mkInScopeSet (tyCoVarsOfType (idType $ is_dfun res)))
+
+  {- Create a ClsInst with instantiated arguments and constraints.
+
+     The thetas are the list of constraints that couldn't be solved because
+     they mention a type-hole.
+  -}
+  substInstArgs ::  [Type] -> [PredType] -> ClsInst -> ClsInst
+  substInstArgs tys thetas inst = let
+      subst = foldl' (\a b -> uncurry (extendTvSubstAndInScope a) b) empty_subst (zip dfun_tvs tys)
+      -- Build instance head with arguments substituted in
+      tau   = mkClassPred cls (substTheta subst args)
+      -- Constrain the instance with any residual constraints
+      phi   = mkPhiTy thetas tau
+      sigma = mkForAllTys (map (\v -> Bndr v Inferred) dfun_tvs) phi
+
+    in inst { is_dfun = (is_dfun inst) { varType = sigma }}
+    where
+    (dfun_tvs, _, cls, args) = instanceSig inst
+
+-- Find instances where the head unifies with the provided type
+findMatchingInstances :: Type -> TcM [(ClsInst, [DFunInstType])]
+findMatchingInstances ty = do
+  ies@(InstEnvs {ie_global = ie_global, ie_local = ie_local}) <- tcGetInstEnvs
+  let allClasses = instEnvClasses ie_global ++ instEnvClasses ie_local
+
+  concat <$> mapM (\cls -> do
+    let (matches, _, _) = lookupInstEnv True ies cls [ty]
+    return matches) allClasses
+
+-----------------------------------------------------------------------------
+-- Compile an expression, run it, and deliver the result
+
+-- | Parse an expression, the parsed expression can be further processed and
+-- passed to compileParsedExpr.
+parseExpr :: GhcMonad m => String -> m (LHsExpr GhcPs)
+parseExpr expr = withSession $ \hsc_env -> do
+  liftIO $ runInteractiveHsc hsc_env $ hscParseExpr expr
+
+-- | Compile an expression, run it, and deliver the resulting HValue.
+compileExpr :: GhcMonad m => String -> m HValue
+compileExpr expr = do
+  parsed_expr <- parseExpr expr
+  compileParsedExpr parsed_expr
+
+-- | Compile an expression, run it, and deliver the resulting HValue.
+compileExprRemote :: GhcMonad m => String -> m ForeignHValue
+compileExprRemote expr = do
+  parsed_expr <- parseExpr expr
+  compileParsedExprRemote parsed_expr
+
+-- | Compile a parsed expression (before renaming), run it, and deliver
+-- the resulting HValue.
+compileParsedExprRemote :: GhcMonad m => LHsExpr GhcPs -> m ForeignHValue
+compileParsedExprRemote expr@(L loc _) = withSession $ \hsc_env -> do
+  -- > let _compileParsedExpr = expr
+  -- Create let stmt from expr to make hscParsedStmt happy.
+  -- We will ignore the returned [Id], namely [expr_id], and not really
+  -- create a new binding.
+  let expr_fs = fsLit "_compileParsedExpr"
+      expr_name = mkInternalName (getUnique expr_fs) (mkTyVarOccFS expr_fs) loc
+      let_stmt = L loc . LetStmt noExtField . L loc . (HsValBinds noExtField) $
+        ValBinds noExtField
+                     (unitBag $ mkHsVarBind loc (getRdrName expr_name) expr) []
+
+  pstmt <- liftIO $ hscParsedStmt hsc_env let_stmt
+  let (hvals_io, fix_env) = case pstmt of
+        Just ([_id], hvals_io', fix_env') -> (hvals_io', fix_env')
+        _ -> panic "compileParsedExprRemote"
+
+  updateFixityEnv fix_env
+  status <- liftIO $ evalStmt hsc_env False (EvalThis hvals_io)
+  case status of
+    EvalComplete _ (EvalSuccess [hval]) -> return hval
+    EvalComplete _ (EvalException e) ->
+      liftIO $ throwIO (fromSerializableException e)
+    _ -> panic "compileParsedExpr"
+
+compileParsedExpr :: GhcMonad m => LHsExpr GhcPs -> m HValue
+compileParsedExpr expr = do
+   fhv <- compileParsedExprRemote expr
+   dflags <- getDynFlags
+   liftIO $ wormhole dflags fhv
+
+-- | Compile an expression, run it and return the result as a Dynamic.
+dynCompileExpr :: GhcMonad m => String -> m Dynamic
+dynCompileExpr expr = do
+  parsed_expr <- parseExpr expr
+  -- > Data.Dynamic.toDyn expr
+  let loc = getLoc parsed_expr
+      to_dyn_expr = mkHsApp (L loc . HsVar noExtField . L loc $ getRdrName toDynName)
+                            parsed_expr
+  hval <- compileParsedExpr to_dyn_expr
+  return (unsafeCoerce# hval :: Dynamic)
+
+-----------------------------------------------------------------------------
+-- show a module and it's source/object filenames
+
+showModule :: GhcMonad m => ModSummary -> m String
+showModule mod_summary =
+    withSession $ \hsc_env -> do
+        interpreted <- moduleIsBootOrNotObjectLinkable mod_summary
+        let dflags = hsc_dflags hsc_env
+        return (showModMsg dflags (hscTarget dflags) interpreted mod_summary)
+
+moduleIsBootOrNotObjectLinkable :: GhcMonad m => ModSummary -> m Bool
+moduleIsBootOrNotObjectLinkable mod_summary = withSession $ \hsc_env ->
+  case lookupHpt (hsc_HPT hsc_env) (ms_mod_name mod_summary) of
+        Nothing       -> panic "missing linkable"
+        Just mod_info -> return $ case hm_linkable mod_info of
+          Nothing       -> True
+          Just linkable -> not (isObjectLinkable linkable)
+
+----------------------------------------------------------------------------
+-- RTTI primitives
+
+obtainTermFromVal :: HscEnv -> Int -> Bool -> Type -> a -> IO Term
+obtainTermFromVal hsc_env bound force ty x
+  | gopt Opt_ExternalInterpreter (hsc_dflags hsc_env)
+  = throwIO (InstallationError
+      "this operation requires -fno-external-interpreter")
+  | otherwise
+  = cvObtainTerm hsc_env bound force ty (unsafeCoerce# x)
+
+obtainTermFromId :: HscEnv -> Int -> Bool -> Id -> IO Term
+obtainTermFromId hsc_env bound force id =  do
+  hv <- Linker.getHValue hsc_env (varName id)
+  cvObtainTerm hsc_env bound force (idType id) hv
+
+-- Uses RTTI to reconstruct the type of an Id, making it less polymorphic
+reconstructType :: HscEnv -> Int -> Id -> IO (Maybe Type)
+reconstructType hsc_env bound id = do
+  hv <- Linker.getHValue hsc_env (varName id)
+  cvReconstructType hsc_env bound (idType id) hv
+
+mkRuntimeUnkTyVar :: Name -> Kind -> TyVar
+mkRuntimeUnkTyVar name kind = mkTcTyVar name kind RuntimeUnk
diff --git a/compiler/GHC/Runtime/Eval/Types.hs b/compiler/GHC/Runtime/Eval/Types.hs
new file mode 100644
index 0000000000..93072075c0
--- /dev/null
+++ b/compiler/GHC/Runtime/Eval/Types.hs
@@ -0,0 +1,89 @@
+-- -----------------------------------------------------------------------------
+--
+-- (c) The University of Glasgow, 2005-2007
+--
+-- Running statements interactively
+--
+-- -----------------------------------------------------------------------------
+
+module GHC.Runtime.Eval.Types (
+        Resume(..), History(..), ExecResult(..),
+        SingleStep(..), isStep, ExecOptions(..),
+        BreakInfo(..)
+        ) where
+
+import GhcPrelude
+
+import GHCi.RemoteTypes
+import GHCi.Message (EvalExpr, ResumeContext)
+import Id
+import Name
+import Module
+import RdrName
+import Type
+import SrcLoc
+import Exception
+
+import Data.Word
+import GHC.Stack.CCS
+
+data ExecOptions
+ = ExecOptions
+     { execSingleStep :: SingleStep         -- ^ stepping mode
+     , execSourceFile :: String             -- ^ filename (for errors)
+     , execLineNumber :: Int                -- ^ line number (for errors)
+     , execWrap :: ForeignHValue -> EvalExpr ForeignHValue
+     }
+
+data SingleStep
+   = RunToCompletion
+   | SingleStep
+   | RunAndLogSteps
+
+isStep :: SingleStep -> Bool
+isStep RunToCompletion = False
+isStep _ = True
+
+data ExecResult
+  = ExecComplete
+       { execResult :: Either SomeException [Name]
+       , execAllocation :: Word64
+       }
+  | ExecBreak
+       { breakNames :: [Name]
+       , breakInfo :: Maybe BreakInfo
+       }
+
+data BreakInfo = BreakInfo
+  { breakInfo_module :: Module
+  , breakInfo_number :: Int
+  }
+
+data Resume = Resume
+       { resumeStmt      :: String       -- the original statement
+       , resumeContext   :: ForeignRef (ResumeContext [HValueRef])
+       , resumeBindings  :: ([TyThing], GlobalRdrEnv)
+       , resumeFinalIds  :: [Id]         -- [Id] to bind on completion
+       , resumeApStack   :: ForeignHValue -- The object from which we can get
+                                        -- value of the free variables.
+       , resumeBreakInfo :: Maybe BreakInfo
+                                        -- the breakpoint we stopped at
+                                        -- (module, index)
+                                        -- (Nothing <=> exception)
+       , resumeSpan      :: SrcSpan      -- just a copy of the SrcSpan
+                                        -- from the ModBreaks,
+                                        -- otherwise it's a pain to
+                                        -- fetch the ModDetails &
+                                        -- ModBreaks to get this.
+       , resumeDecl      :: String       -- ditto
+       , resumeCCS       :: RemotePtr CostCentreStack
+       , resumeHistory   :: [History]
+       , resumeHistoryIx :: Int           -- 0 <==> at the top of the history
+       }
+
+data History
+   = History {
+        historyApStack   :: ForeignHValue,
+        historyBreakInfo :: BreakInfo,
+        historyEnclosingDecls :: [String]  -- declarations enclosing the breakpoint
+   }
diff --git a/compiler/GHC/Runtime/Heap/Inspect.hs b/compiler/GHC/Runtime/Heap/Inspect.hs
new file mode 100644
index 0000000000..de6f9a7af3
--- /dev/null
+++ b/compiler/GHC/Runtime/Heap/Inspect.hs
@@ -0,0 +1,1355 @@
+{-# LANGUAGE BangPatterns, CPP, ScopedTypeVariables, MagicHash #-}
+
+-----------------------------------------------------------------------------
+--
+-- GHC Interactive support for inspecting arbitrary closures at runtime
+--
+-- Pepe Iborra (supported by Google SoC) 2006
+--
+-----------------------------------------------------------------------------
+module GHC.Runtime.Heap.Inspect(
+     -- * Entry points and types
+     cvObtainTerm,
+     cvReconstructType,
+     improveRTTIType,
+     Term(..),
+
+     -- * Utils
+     isFullyEvaluatedTerm,
+     termType, mapTermType, termTyCoVars,
+     foldTerm, TermFold(..),
+     cPprTerm, cPprTermBase,
+
+     constrClosToName -- exported to use in test T4891
+ ) where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import GHC.Runtime.Interpreter as GHCi
+import GHCi.RemoteTypes
+import HscTypes
+
+import DataCon
+import Type
+import GHC.Types.RepType
+import qualified Unify as U
+import Var
+import TcRnMonad
+import TcType
+import TcMType
+import TcHsSyn ( zonkTcTypeToTypeX, mkEmptyZonkEnv, ZonkFlexi( RuntimeUnkFlexi ) )
+import TcUnify
+import TcEnv
+
+import TyCon
+import Name
+import OccName
+import Module
+import GHC.Iface.Env
+import Util
+import VarSet
+import BasicTypes       ( Boxity(..) )
+import TysPrim
+import PrelNames
+import TysWiredIn
+import DynFlags
+import Outputable as Ppr
+import GHC.Char
+import GHC.Exts.Heap
+import GHC.Runtime.Heap.Layout ( roundUpTo )
+
+import Control.Monad
+import Data.Maybe
+import Data.List ((\\))
+#if defined(INTEGER_GMP)
+import GHC.Exts
+import Data.Array.Base
+import GHC.Integer.GMP.Internals
+#elif defined(INTEGER_SIMPLE)
+import GHC.Exts
+import GHC.Integer.Simple.Internals
+#endif
+import qualified Data.Sequence as Seq
+import Data.Sequence (viewl, ViewL(..))
+import Foreign
+import System.IO.Unsafe
+
+
+---------------------------------------------
+-- * A representation of semi evaluated Terms
+---------------------------------------------
+
+data Term = Term { ty        :: RttiType
+                 , dc        :: Either String DataCon
+                               -- Carries a text representation if the datacon is
+                               -- not exported by the .hi file, which is the case
+                               -- for private constructors in -O0 compiled libraries
+                 , val       :: ForeignHValue
+                 , subTerms  :: [Term] }
+
+          | Prim { ty        :: RttiType
+                 , valRaw    :: [Word] }
+
+          | Suspension { ctype    :: ClosureType
+                       , ty       :: RttiType
+                       , val      :: ForeignHValue
+                       , bound_to :: Maybe Name   -- Useful for printing
+                       }
+          | NewtypeWrap{       -- At runtime there are no newtypes, and hence no
+                               -- newtype constructors. A NewtypeWrap is just a
+                               -- made-up tag saying "heads up, there used to be
+                               -- a newtype constructor here".
+                         ty           :: RttiType
+                       , dc           :: Either String DataCon
+                       , wrapped_term :: Term }
+          | RefWrap    {       -- The contents of a reference
+                         ty           :: RttiType
+                       , wrapped_term :: Term }
+
+termType :: Term -> RttiType
+termType t = ty t
+
+isFullyEvaluatedTerm :: Term -> Bool
+isFullyEvaluatedTerm Term {subTerms=tt} = all isFullyEvaluatedTerm tt
+isFullyEvaluatedTerm Prim {}            = True
+isFullyEvaluatedTerm NewtypeWrap{wrapped_term=t} = isFullyEvaluatedTerm t
+isFullyEvaluatedTerm RefWrap{wrapped_term=t}     = isFullyEvaluatedTerm t
+isFullyEvaluatedTerm _                  = False
+
+instance Outputable (Term) where
+ ppr t | Just doc <- cPprTerm cPprTermBase t = doc
+       | otherwise = panic "Outputable Term instance"
+
+----------------------------------------
+-- Runtime Closure information functions
+----------------------------------------
+
+isThunk :: GenClosure a -> Bool
+isThunk ThunkClosure{} = True
+isThunk APClosure{} = True
+isThunk APStackClosure{} = True
+isThunk _             = False
+
+-- Lookup the name in a constructor closure
+constrClosToName :: HscEnv -> GenClosure a -> IO (Either String Name)
+constrClosToName hsc_env ConstrClosure{pkg=pkg,modl=mod,name=occ} = do
+   let occName = mkOccName OccName.dataName occ
+       modName = mkModule (stringToUnitId pkg) (mkModuleName mod)
+   Right `fmap` lookupOrigIO hsc_env modName occName
+constrClosToName _hsc_env clos =
+   return (Left ("conClosToName: Expected ConstrClosure, got " ++ show (fmap (const ()) clos)))
+
+-----------------------------------
+-- * Traversals for Terms
+-----------------------------------
+type TermProcessor a b = RttiType -> Either String DataCon -> ForeignHValue -> [a] -> b
+
+data TermFold a = TermFold { fTerm        :: TermProcessor a a
+                           , fPrim        :: RttiType -> [Word] -> a
+                           , fSuspension  :: ClosureType -> RttiType -> ForeignHValue
+                                            -> Maybe Name -> a
+                           , fNewtypeWrap :: RttiType -> Either String DataCon
+                                            -> a -> a
+                           , fRefWrap     :: RttiType -> a -> a
+                           }
+
+
+data TermFoldM m a =
+                   TermFoldM {fTermM        :: TermProcessor a (m a)
+                            , fPrimM        :: RttiType -> [Word] -> m a
+                            , fSuspensionM  :: ClosureType -> RttiType -> ForeignHValue
+                                             -> Maybe Name -> m a
+                            , fNewtypeWrapM :: RttiType -> Either String DataCon
+                                            -> a -> m a
+                            , fRefWrapM     :: RttiType -> a -> m a
+                           }
+
+foldTerm :: TermFold a -> Term -> a
+foldTerm tf (Term ty dc v tt) = fTerm tf ty dc v (map (foldTerm tf) tt)
+foldTerm tf (Prim ty    v   ) = fPrim tf ty v
+foldTerm tf (Suspension ct ty v b) = fSuspension tf ct ty v b
+foldTerm tf (NewtypeWrap ty dc t)  = fNewtypeWrap tf ty dc (foldTerm tf t)
+foldTerm tf (RefWrap ty t)         = fRefWrap tf ty (foldTerm tf t)
+
+
+foldTermM :: Monad m => TermFoldM m a -> Term -> m a
+foldTermM tf (Term ty dc v tt) = mapM (foldTermM tf) tt >>= fTermM tf ty dc v
+foldTermM tf (Prim ty    v   ) = fPrimM tf ty v
+foldTermM tf (Suspension ct ty v b) = fSuspensionM tf ct ty v b
+foldTermM tf (NewtypeWrap ty dc t)  = foldTermM tf t >>=  fNewtypeWrapM tf ty dc
+foldTermM tf (RefWrap ty t)         = foldTermM tf t >>= fRefWrapM tf ty
+
+idTermFold :: TermFold Term
+idTermFold = TermFold {
+              fTerm = Term,
+              fPrim = Prim,
+              fSuspension  = Suspension,
+              fNewtypeWrap = NewtypeWrap,
+              fRefWrap = RefWrap
+                      }
+
+mapTermType :: (RttiType -> Type) -> Term -> Term
+mapTermType f = foldTerm idTermFold {
+          fTerm       = \ty dc hval tt -> Term (f ty) dc hval tt,
+          fSuspension = \ct ty hval n ->
+                          Suspension ct (f ty) hval n,
+          fNewtypeWrap= \ty dc t -> NewtypeWrap (f ty) dc t,
+          fRefWrap    = \ty t -> RefWrap (f ty) t}
+
+mapTermTypeM :: Monad m =>  (RttiType -> m Type) -> Term -> m Term
+mapTermTypeM f = foldTermM TermFoldM {
+          fTermM       = \ty dc hval tt -> f ty >>= \ty' -> return $ Term ty'  dc hval tt,
+          fPrimM       = (return.) . Prim,
+          fSuspensionM = \ct ty hval n ->
+                          f ty >>= \ty' -> return $ Suspension ct ty' hval n,
+          fNewtypeWrapM= \ty dc t -> f ty >>= \ty' -> return $ NewtypeWrap ty' dc t,
+          fRefWrapM    = \ty t -> f ty >>= \ty' -> return $ RefWrap ty' t}
+
+termTyCoVars :: Term -> TyCoVarSet
+termTyCoVars = foldTerm TermFold {
+            fTerm       = \ty _ _ tt   ->
+                          tyCoVarsOfType ty `unionVarSet` concatVarEnv tt,
+            fSuspension = \_ ty _ _ -> tyCoVarsOfType ty,
+            fPrim       = \ _ _ -> emptyVarSet,
+            fNewtypeWrap= \ty _ t -> tyCoVarsOfType ty `unionVarSet` t,
+            fRefWrap    = \ty t -> tyCoVarsOfType ty `unionVarSet` t}
+    where concatVarEnv = foldr unionVarSet emptyVarSet
+
+----------------------------------
+-- Pretty printing of terms
+----------------------------------
+
+type Precedence        = Int
+type TermPrinterM m    = Precedence -> Term -> m SDoc
+
+app_prec,cons_prec, max_prec ::Int
+max_prec  = 10
+app_prec  = max_prec
+cons_prec = 5 -- TODO Extract this info from GHC itself
+
+pprTermM, ppr_termM, pprNewtypeWrap :: Monad m => TermPrinterM m -> TermPrinterM m
+pprTermM y p t = pprDeeper `liftM` ppr_termM y p t
+
+ppr_termM y p Term{dc=Left dc_tag, subTerms=tt} = do
+  tt_docs <- mapM (y app_prec) tt
+  return $ cparen (not (null tt) && p >= app_prec)
+                  (text dc_tag <+> pprDeeperList fsep tt_docs)
+
+ppr_termM y p Term{dc=Right dc, subTerms=tt}
+{-  | dataConIsInfix dc, (t1:t2:tt') <- tt  --TODO fixity
+  = parens (ppr_term1 True t1 <+> ppr dc <+> ppr_term1 True ppr t2)
+    <+> hsep (map (ppr_term1 True) tt)
+-} -- TODO Printing infix constructors properly
+  = do { tt_docs' <- mapM (y app_prec) tt
+       ; return $ ifPprDebug (show_tm tt_docs')
+                             (show_tm (dropList (dataConTheta dc) tt_docs'))
+                  -- Don't show the dictionary arguments to
+                  -- constructors unless -dppr-debug is on
+       }
+  where
+    show_tm tt_docs
+      | null tt_docs = ppr dc
+      | otherwise    = cparen (p >= app_prec) $
+                       sep [ppr dc, nest 2 (pprDeeperList fsep tt_docs)]
+
+ppr_termM y p t@NewtypeWrap{} = pprNewtypeWrap y p t
+ppr_termM y p RefWrap{wrapped_term=t}  = do
+  contents <- y app_prec t
+  return$ cparen (p >= app_prec) (text "GHC.Prim.MutVar#" <+> contents)
+  -- The constructor name is wired in here ^^^ for the sake of simplicity.
+  -- I don't think mutvars are going to change in a near future.
+  -- In any case this is solely a presentation matter: MutVar# is
+  -- a datatype with no constructors, implemented by the RTS
+  -- (hence there is no way to obtain a datacon and print it).
+ppr_termM _ _ t = ppr_termM1 t
+
+
+ppr_termM1 :: Monad m => Term -> m SDoc
+ppr_termM1 Prim{valRaw=words, ty=ty} =
+    return $ repPrim (tyConAppTyCon ty) words
+ppr_termM1 Suspension{ty=ty, bound_to=Nothing} =
+    return (char '_' <+> whenPprDebug (text "::" <> ppr ty))
+ppr_termM1 Suspension{ty=ty, bound_to=Just n}
+--  | Just _ <- splitFunTy_maybe ty = return$ ptext (sLit("<function>")
+  | otherwise = return$ parens$ ppr n <> text "::" <> ppr ty
+ppr_termM1 Term{}        = panic "ppr_termM1 - Term"
+ppr_termM1 RefWrap{}     = panic "ppr_termM1 - RefWrap"
+ppr_termM1 NewtypeWrap{} = panic "ppr_termM1 - NewtypeWrap"
+
+pprNewtypeWrap y p NewtypeWrap{ty=ty, wrapped_term=t}
+  | Just (tc,_) <- tcSplitTyConApp_maybe ty
+  , ASSERT(isNewTyCon tc) True
+  , Just new_dc <- tyConSingleDataCon_maybe tc = do
+             real_term <- y max_prec t
+             return $ cparen (p >= app_prec) (ppr new_dc <+> real_term)
+pprNewtypeWrap _ _ _ = panic "pprNewtypeWrap"
+
+-------------------------------------------------------
+-- Custom Term Pretty Printers
+-------------------------------------------------------
+
+-- We can want to customize the representation of a
+--  term depending on its type.
+-- However, note that custom printers have to work with
+--  type representations, instead of directly with types.
+-- We cannot use type classes here, unless we employ some
+--  typerep trickery (e.g. Weirich's RepLib tricks),
+--  which I didn't. Therefore, this code replicates a lot
+--  of what type classes provide for free.
+
+type CustomTermPrinter m = TermPrinterM m
+                         -> [Precedence -> Term -> (m (Maybe SDoc))]
+
+-- | Takes a list of custom printers with a explicit recursion knot and a term,
+-- and returns the output of the first successful printer, or the default printer
+cPprTerm :: Monad m => CustomTermPrinter m -> Term -> m SDoc
+cPprTerm printers_ = go 0 where
+  printers = printers_ go
+  go prec t = do
+    let default_ = Just `liftM` pprTermM go prec t
+        mb_customDocs = [pp prec t | pp <- printers] ++ [default_]
+    mdoc <- firstJustM mb_customDocs
+    case mdoc of
+      Nothing -> panic "cPprTerm"
+      Just doc -> return $ cparen (prec>app_prec+1) doc
+
+  firstJustM (mb:mbs) = mb >>= maybe (firstJustM mbs) (return . Just)
+  firstJustM [] = return Nothing
+
+-- Default set of custom printers. Note that the recursion knot is explicit
+cPprTermBase :: forall m. Monad m => CustomTermPrinter m
+cPprTermBase y =
+  [ ifTerm (isTupleTy.ty) (\_p -> liftM (parens . hcat . punctuate comma)
+                                      . mapM (y (-1))
+                                      . subTerms)
+  , ifTerm (\t -> isTyCon listTyCon (ty t) && subTerms t `lengthIs` 2)
+           ppr_list
+  , ifTerm' (isTyCon intTyCon    . ty) ppr_int
+  , ifTerm' (isTyCon charTyCon   . ty) ppr_char
+  , ifTerm' (isTyCon floatTyCon  . ty) ppr_float
+  , ifTerm' (isTyCon doubleTyCon . ty) ppr_double
+  , ifTerm' (isIntegerTy         . ty) ppr_integer
+  ]
+ where
+   ifTerm :: (Term -> Bool)
+          -> (Precedence -> Term -> m SDoc)
+          -> Precedence -> Term -> m (Maybe SDoc)
+   ifTerm pred f = ifTerm' pred (\prec t -> Just <$> f prec t)
+
+   ifTerm' :: (Term -> Bool)
+          -> (Precedence -> Term -> m (Maybe SDoc))
+          -> Precedence -> Term -> m (Maybe SDoc)
+   ifTerm' pred f prec t@Term{}
+       | pred t    = f prec t
+   ifTerm' _ _ _ _  = return Nothing
+
+   isTupleTy ty    = fromMaybe False $ do
+     (tc,_) <- tcSplitTyConApp_maybe ty
+     return (isBoxedTupleTyCon tc)
+
+   isTyCon a_tc ty = fromMaybe False $ do
+     (tc,_) <- tcSplitTyConApp_maybe ty
+     return (a_tc == tc)
+
+   isIntegerTy ty = fromMaybe False $ do
+     (tc,_) <- tcSplitTyConApp_maybe ty
+     return (tyConName tc == integerTyConName)
+
+   ppr_int, ppr_char, ppr_float, ppr_double
+      :: Precedence -> Term -> m (Maybe SDoc)
+   ppr_int _ Term{subTerms=[Prim{valRaw=[w]}]} =
+      return (Just (Ppr.int (fromIntegral w)))
+   ppr_int _ _ = return Nothing
+
+   ppr_char _ Term{subTerms=[Prim{valRaw=[w]}]} =
+      return (Just (Ppr.pprHsChar (chr (fromIntegral w))))
+   ppr_char _ _ = return Nothing
+
+   ppr_float   _ Term{subTerms=[Prim{valRaw=[w]}]} = do
+      let f = unsafeDupablePerformIO $
+                alloca $ \p -> poke p w >> peek (castPtr p)
+      return (Just (Ppr.float f))
+   ppr_float _ _ = return Nothing
+
+   ppr_double  _ Term{subTerms=[Prim{valRaw=[w]}]} = do
+      let f = unsafeDupablePerformIO $
+                alloca $ \p -> poke p w >> peek (castPtr p)
+      return (Just (Ppr.double f))
+   -- let's assume that if we get two words, we're on a 32-bit
+   -- machine. There's no good way to get a DynFlags to check the word
+   -- size here.
+   ppr_double  _ Term{subTerms=[Prim{valRaw=[w1,w2]}]} = do
+      let f = unsafeDupablePerformIO $
+                alloca $ \p -> do
+                  poke p (fromIntegral w1 :: Word32)
+                  poke (p `plusPtr` 4) (fromIntegral w2 :: Word32)
+                  peek (castPtr p)
+      return (Just (Ppr.double f))
+   ppr_double _ _ = return Nothing
+
+   ppr_integer :: Precedence -> Term -> m (Maybe SDoc)
+#if defined(INTEGER_GMP)
+   -- Reconstructing Integers is a bit of a pain. This depends deeply
+   -- on the integer-gmp representation, so it'll break if that
+   -- changes (but there are several tests in
+   -- tests/ghci.debugger/scripts that will tell us if this is wrong).
+   --
+   --   data Integer
+   --     = S# Int#
+   --     | Jp# {-# UNPACK #-} !BigNat
+   --     | Jn# {-# UNPACK #-} !BigNat
+   --
+   --   data BigNat = BN# ByteArray#
+   --
+   ppr_integer _ Term{subTerms=[Prim{valRaw=[W# w]}]} =
+      return (Just (Ppr.integer (S# (word2Int# w))))
+   ppr_integer _ Term{dc=Right con,
+                      subTerms=[Term{subTerms=[Prim{valRaw=ws}]}]} = do
+      -- We don't need to worry about sizes that are not an integral
+      -- number of words, because luckily GMP uses arrays of words
+      -- (see GMP_LIMB_SHIFT).
+      let
+        !(UArray _ _ _ arr#) = listArray (0,length ws-1) ws
+        constr
+          | "Jp#" <- getOccString (dataConName con) = Jp#
+          | otherwise = Jn#
+      return (Just (Ppr.integer (constr (BN# arr#))))
+#elif defined(INTEGER_SIMPLE)
+   -- As with the GMP case, this depends deeply on the integer-simple
+   -- representation.
+   --
+   -- @
+   -- data Integer = Positive !Digits | Negative !Digits | Naught
+   --
+   -- data Digits = Some !Word# !Digits
+   --             | None
+   -- @
+   --
+   -- NB: the above has some type synonyms expanded out for the sake of brevity
+   ppr_integer _ Term{subTerms=[]} =
+      return (Just (Ppr.integer Naught))
+   ppr_integer _ Term{dc=Right con, subTerms=[digitTerm]}
+        | Just digits <- get_digits digitTerm
+        = return (Just (Ppr.integer (constr digits)))
+      where
+        get_digits :: Term -> Maybe Digits
+        get_digits Term{subTerms=[]} = Just None
+        get_digits Term{subTerms=[Prim{valRaw=[W# w]},t]}
+          = Some w <$> get_digits t
+        get_digits _ = Nothing
+
+        constr
+          | "Positive" <- getOccString (dataConName con) = Positive
+          | otherwise = Negative
+#endif
+   ppr_integer _ _ = return Nothing
+
+   --Note pprinting of list terms is not lazy
+   ppr_list :: Precedence -> Term -> m SDoc
+   ppr_list p (Term{subTerms=[h,t]}) = do
+       let elems      = h : getListTerms t
+           isConsLast = not (termType (last elems) `eqType` termType h)
+           is_string  = all (isCharTy . ty) elems
+           chars = [ chr (fromIntegral w)
+                   | Term{subTerms=[Prim{valRaw=[w]}]} <- elems ]
+
+       print_elems <- mapM (y cons_prec) elems
+       if is_string
+        then return (Ppr.doubleQuotes (Ppr.text chars))
+        else if isConsLast
+        then return $ cparen (p >= cons_prec)
+                    $ pprDeeperList fsep
+                    $ punctuate (space<>colon) print_elems
+        else return $ brackets
+                    $ pprDeeperList fcat
+                    $ punctuate comma print_elems
+
+        where getListTerms Term{subTerms=[h,t]} = h : getListTerms t
+              getListTerms Term{subTerms=[]}    = []
+              getListTerms t@Suspension{}       = [t]
+              getListTerms t = pprPanic "getListTerms" (ppr t)
+   ppr_list _ _ = panic "doList"
+
+
+repPrim :: TyCon -> [Word] -> SDoc
+repPrim t = rep where
+   rep x
+    -- Char# uses native machine words, whereas Char's Storable instance uses
+    -- Int32, so we have to read it as an Int.
+    | t == charPrimTyCon             = text $ show (chr (build x :: Int))
+    | t == intPrimTyCon              = text $ show (build x :: Int)
+    | t == wordPrimTyCon             = text $ show (build x :: Word)
+    | t == floatPrimTyCon            = text $ show (build x :: Float)
+    | t == doublePrimTyCon           = text $ show (build x :: Double)
+    | t == int32PrimTyCon            = text $ show (build x :: Int32)
+    | t == word32PrimTyCon           = text $ show (build x :: Word32)
+    | t == int64PrimTyCon            = text $ show (build x :: Int64)
+    | t == word64PrimTyCon           = text $ show (build x :: Word64)
+    | t == addrPrimTyCon             = text $ show (nullPtr `plusPtr` build x)
+    | t == stablePtrPrimTyCon        = text "<stablePtr>"
+    | t == stableNamePrimTyCon       = text "<stableName>"
+    | t == statePrimTyCon            = text "<statethread>"
+    | t == proxyPrimTyCon            = text "<proxy>"
+    | t == realWorldTyCon            = text "<realworld>"
+    | t == threadIdPrimTyCon         = text "<ThreadId>"
+    | t == weakPrimTyCon             = text "<Weak>"
+    | t == arrayPrimTyCon            = text "<array>"
+    | t == smallArrayPrimTyCon       = text "<smallArray>"
+    | t == byteArrayPrimTyCon        = text "<bytearray>"
+    | t == mutableArrayPrimTyCon     = text "<mutableArray>"
+    | t == smallMutableArrayPrimTyCon = text "<smallMutableArray>"
+    | t == mutableByteArrayPrimTyCon = text "<mutableByteArray>"
+    | t == mutVarPrimTyCon           = text "<mutVar>"
+    | t == mVarPrimTyCon             = text "<mVar>"
+    | t == tVarPrimTyCon             = text "<tVar>"
+    | otherwise                      = char '<' <> ppr t <> char '>'
+    where build ww = unsafePerformIO $ withArray ww (peek . castPtr)
+--   This ^^^ relies on the representation of Haskell heap values being
+--   the same as in a C array.
+
+-----------------------------------
+-- Type Reconstruction
+-----------------------------------
+{-
+Type Reconstruction is type inference done on heap closures.
+The algorithm walks the heap generating a set of equations, which
+are solved with syntactic unification.
+A type reconstruction equation looks like:
+
+  <datacon reptype>  =  <actual heap contents>
+
+The full equation set is generated by traversing all the subterms, starting
+from a given term.
+
+The only difficult part is that newtypes are only found in the lhs of equations.
+Right hand sides are missing them. We can either (a) drop them from the lhs, or
+(b) reconstruct them in the rhs when possible.
+
+The function congruenceNewtypes takes a shot at (b)
+-}
+
+
+-- A (non-mutable) tau type containing
+-- existentially quantified tyvars.
+--    (since GHC type language currently does not support
+--     existentials, we leave these variables unquantified)
+type RttiType = Type
+
+-- An incomplete type as stored in GHCi:
+--  no polymorphism: no quantifiers & all tyvars are skolem.
+type GhciType = Type
+
+
+-- The Type Reconstruction monad
+--------------------------------
+type TR a = TcM a
+
+runTR :: HscEnv -> TR a -> IO a
+runTR hsc_env thing = do
+  mb_val <- runTR_maybe hsc_env thing
+  case mb_val of
+    Nothing -> error "unable to :print the term"
+    Just x  -> return x
+
+runTR_maybe :: HscEnv -> TR a -> IO (Maybe a)
+runTR_maybe hsc_env thing_inside
+  = do { (_errs, res) <- initTcInteractive hsc_env thing_inside
+       ; return res }
+
+-- | Term Reconstruction trace
+traceTR :: SDoc -> TR ()
+traceTR = liftTcM . traceOptTcRn Opt_D_dump_rtti
+
+
+-- Semantically different to recoverM in TcRnMonad
+-- recoverM retains the errors in the first action,
+--  whereas recoverTc here does not
+recoverTR :: TR a -> TR a -> TR a
+recoverTR = tryTcDiscardingErrs
+
+trIO :: IO a -> TR a
+trIO = liftTcM . liftIO
+
+liftTcM :: TcM a -> TR a
+liftTcM = id
+
+newVar :: Kind -> TR TcType
+newVar = liftTcM . newFlexiTyVarTy
+
+newOpenVar :: TR TcType
+newOpenVar = liftTcM newOpenFlexiTyVarTy
+
+instTyVars :: [TyVar] -> TR (TCvSubst, [TcTyVar])
+-- Instantiate fresh mutable type variables from some TyVars
+-- This function preserves the print-name, which helps error messages
+instTyVars tvs
+  = liftTcM $ fst <$> captureConstraints (newMetaTyVars tvs)
+
+type RttiInstantiation = [(TcTyVar, TyVar)]
+   -- Associates the typechecker-world meta type variables
+   -- (which are mutable and may be refined), to their
+   -- debugger-world RuntimeUnk counterparts.
+   -- If the TcTyVar has not been refined by the runtime type
+   -- elaboration, then we want to turn it back into the
+   -- original RuntimeUnk
+
+-- | Returns the instantiated type scheme ty', and the
+--   mapping from new (instantiated) -to- old (skolem) type variables
+instScheme :: QuantifiedType -> TR (TcType, RttiInstantiation)
+instScheme (tvs, ty)
+  = do { (subst, tvs') <- instTyVars tvs
+       ; let rtti_inst = [(tv',tv) | (tv',tv) <- tvs' `zip` tvs]
+       ; return (substTy subst ty, rtti_inst) }
+
+applyRevSubst :: RttiInstantiation -> TR ()
+-- Apply the *reverse* substitution in-place to any un-filled-in
+-- meta tyvars.  This recovers the original debugger-world variable
+-- unless it has been refined by new information from the heap
+applyRevSubst pairs = liftTcM (mapM_ do_pair pairs)
+  where
+    do_pair (tc_tv, rtti_tv)
+      = do { tc_ty <- zonkTcTyVar tc_tv
+           ; case tcGetTyVar_maybe tc_ty of
+               Just tv | isMetaTyVar tv -> writeMetaTyVar tv (mkTyVarTy rtti_tv)
+               _                        -> return () }
+
+-- Adds a constraint of the form t1 == t2
+-- t1 is expected to come from walking the heap
+-- t2 is expected to come from a datacon signature
+-- Before unification, congruenceNewtypes needs to
+-- do its magic.
+addConstraint :: TcType -> TcType -> TR ()
+addConstraint actual expected = do
+    traceTR (text "add constraint:" <+> fsep [ppr actual, equals, ppr expected])
+    recoverTR (traceTR $ fsep [text "Failed to unify", ppr actual,
+                                    text "with", ppr expected]) $
+      discardResult $
+      captureConstraints $
+      do { (ty1, ty2) <- congruenceNewtypes actual expected
+         ; unifyType Nothing ty1 ty2 }
+     -- TOMDO: what about the coercion?
+     -- we should consider family instances
+
+
+-- | Term reconstruction
+--
+-- Given a pointer to a heap object (`HValue`) and its type, build a `Term`
+-- representation of the object. Subterms (objects in the payload) are also
+-- built up to the given `max_depth`. After `max_depth` any subterms will appear
+-- as `Suspension`s. Any thunks found while traversing the object will be forced
+-- based on `force` parameter.
+--
+-- Types of terms will be refined based on constructors we find during term
+-- reconstruction. See `cvReconstructType` for an overview of how type
+-- reconstruction works.
+--
+cvObtainTerm
+    :: HscEnv
+    -> Int      -- ^ How many times to recurse for subterms
+    -> Bool     -- ^ Force thunks
+    -> RttiType -- ^ Type of the object to reconstruct
+    -> ForeignHValue   -- ^ Object to reconstruct
+    -> IO Term
+cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do
+  -- we quantify existential tyvars as universal,
+  -- as this is needed to be able to manipulate
+  -- them properly
+   let quant_old_ty@(old_tvs, old_tau) = quantifyType old_ty
+       sigma_old_ty = mkInvForAllTys old_tvs old_tau
+   traceTR (text "Term reconstruction started with initial type " <> ppr old_ty)
+   term <-
+     if null old_tvs
+      then do
+        term  <- go max_depth sigma_old_ty sigma_old_ty hval
+        term' <- zonkTerm term
+        return $ fixFunDictionaries $ expandNewtypes term'
+      else do
+              (old_ty', rev_subst) <- instScheme quant_old_ty
+              my_ty <- newOpenVar
+              when (check1 quant_old_ty) (traceTR (text "check1 passed") >>
+                                          addConstraint my_ty old_ty')
+              term  <- go max_depth my_ty sigma_old_ty hval
+              new_ty <- zonkTcType (termType term)
+              if isMonomorphic new_ty || check2 (quantifyType new_ty) quant_old_ty
+                 then do
+                      traceTR (text "check2 passed")
+                      addConstraint new_ty old_ty'
+                      applyRevSubst rev_subst
+                      zterm' <- zonkTerm term
+                      return ((fixFunDictionaries . expandNewtypes) zterm')
+                 else do
+                      traceTR (text "check2 failed" <+> parens
+                                       (ppr term <+> text "::" <+> ppr new_ty))
+                      -- we have unsound types. Replace constructor types in
+                      -- subterms with tyvars
+                      zterm' <- mapTermTypeM
+                                 (\ty -> case tcSplitTyConApp_maybe ty of
+                                           Just (tc, _:_) | tc /= funTyCon
+                                               -> newOpenVar
+                                           _   -> return ty)
+                                 term
+                      zonkTerm zterm'
+   traceTR (text "Term reconstruction completed." $$
+            text "Term obtained: " <> ppr term $$
+            text "Type obtained: " <> ppr (termType term))
+   return term
+    where
+  go :: Int -> Type -> Type -> ForeignHValue -> TcM Term
+   -- I believe that my_ty should not have any enclosing
+   -- foralls, nor any free RuntimeUnk skolems;
+   -- that is partly what the quantifyType stuff achieved
+   --
+   -- [SPJ May 11] I don't understand the difference between my_ty and old_ty
+
+  go 0 my_ty _old_ty a = do
+    traceTR (text "Gave up reconstructing a term after" <>
+                  int max_depth <> text " steps")
+    clos <- trIO $ GHCi.getClosure hsc_env a
+    return (Suspension (tipe (info clos)) my_ty a Nothing)
+  go !max_depth my_ty old_ty a = do
+    let monomorphic = not(isTyVarTy my_ty)
+    -- This ^^^ is a convention. The ancestor tests for
+    -- monomorphism and passes a type instead of a tv
+    clos <- trIO $ GHCi.getClosure hsc_env a
+    case clos of
+-- Thunks we may want to force
+      t | isThunk t && force -> do
+         traceTR (text "Forcing a " <> text (show (fmap (const ()) t)))
+         liftIO $ GHCi.seqHValue hsc_env a
+         go (pred max_depth) my_ty old_ty a
+-- Blackholes are indirections iff the payload is not TSO or BLOCKING_QUEUE. If
+-- the indirection is a TSO or BLOCKING_QUEUE, we return the BLACKHOLE itself as
+-- the suspension so that entering it in GHCi will enter the BLACKHOLE instead
+-- of entering the TSO or BLOCKING_QUEUE (which leads to runtime panic).
+      BlackholeClosure{indirectee=ind} -> do
+         traceTR (text "Following a BLACKHOLE")
+         ind_clos <- trIO (GHCi.getClosure hsc_env ind)
+         let return_bh_value = return (Suspension BLACKHOLE my_ty a Nothing)
+         case ind_clos of
+           -- TSO and BLOCKING_QUEUE cases
+           BlockingQueueClosure{} -> return_bh_value
+           OtherClosure info _ _
+             | tipe info == TSO -> return_bh_value
+           UnsupportedClosure info
+             | tipe info == TSO -> return_bh_value
+           -- Otherwise follow the indirectee
+           -- (NOTE: This code will break if we support TSO in ghc-heap one day)
+           _ -> go max_depth my_ty old_ty ind
+-- We always follow indirections
+      IndClosure{indirectee=ind} -> do
+         traceTR (text "Following an indirection" )
+         go max_depth my_ty old_ty ind
+-- We also follow references
+      MutVarClosure{var=contents}
+         | Just (tycon,[world,contents_ty]) <- tcSplitTyConApp_maybe old_ty
+             -> do
+                  -- Deal with the MutVar# primitive
+                  -- It does not have a constructor at all,
+                  -- so we simulate the following one
+                  -- MutVar# :: contents_ty -> MutVar# s contents_ty
+         traceTR (text "Following a MutVar")
+         contents_tv <- newVar liftedTypeKind
+         MASSERT(isUnliftedType my_ty)
+         (mutvar_ty,_) <- instScheme $ quantifyType $ mkVisFunTy
+                            contents_ty (mkTyConApp tycon [world,contents_ty])
+         addConstraint (mkVisFunTy contents_tv my_ty) mutvar_ty
+         x <- go (pred max_depth) contents_tv contents_ty contents
+         return (RefWrap my_ty x)
+
+ -- The interesting case
+      ConstrClosure{ptrArgs=pArgs,dataArgs=dArgs} -> do
+        traceTR (text "entering a constructor " <> ppr dArgs <+>
+                      if monomorphic
+                        then parens (text "already monomorphic: " <> ppr my_ty)
+                        else Ppr.empty)
+        Right dcname <- liftIO $ constrClosToName hsc_env clos
+        (mb_dc, _)   <- tryTc (tcLookupDataCon dcname)
+        case mb_dc of
+          Nothing -> do -- This can happen for private constructors compiled -O0
+                        -- where the .hi descriptor does not export them
+                        -- In such case, we return a best approximation:
+                        --  ignore the unpointed args, and recover the pointeds
+                        -- This preserves laziness, and should be safe.
+                       traceTR (text "Not constructor" <+> ppr dcname)
+                       let dflags = hsc_dflags hsc_env
+                           tag = showPpr dflags dcname
+                       vars     <- replicateM (length pArgs)
+                                              (newVar liftedTypeKind)
+                       subTerms <- sequence $ zipWith (\x tv ->
+                           go (pred max_depth) tv tv x) pArgs vars
+                       return (Term my_ty (Left ('<' : tag ++ ">")) a subTerms)
+          Just dc -> do
+            traceTR (text "Is constructor" <+> (ppr dc $$ ppr my_ty))
+            subTtypes <- getDataConArgTys dc my_ty
+            subTerms <- extractSubTerms (\ty -> go (pred max_depth) ty ty) clos subTtypes
+            return (Term my_ty (Right dc) a subTerms)
+
+      -- This is to support printing of Integers. It's not a general
+      -- mechanism by any means; in particular we lose the size in
+      -- bytes of the array.
+      ArrWordsClosure{bytes=b, arrWords=ws} -> do
+         traceTR (text "ByteArray# closure, size " <> ppr b)
+         return (Term my_ty (Left "ByteArray#") a [Prim my_ty ws])
+
+-- The otherwise case: can be a Thunk,AP,PAP,etc.
+      _ -> do
+         traceTR (text "Unknown closure:" <+>
+                  text (show (fmap (const ()) clos)))
+         return (Suspension (tipe (info clos)) my_ty a Nothing)
+
+  -- insert NewtypeWraps around newtypes
+  expandNewtypes = foldTerm idTermFold { fTerm = worker } where
+   worker ty dc hval tt
+     | Just (tc, args) <- tcSplitTyConApp_maybe ty
+     , isNewTyCon tc
+     , wrapped_type    <- newTyConInstRhs tc args
+     , Just dc'        <- tyConSingleDataCon_maybe tc
+     , t'              <- worker wrapped_type dc hval tt
+     = NewtypeWrap ty (Right dc') t'
+     | otherwise = Term ty dc hval tt
+
+
+   -- Avoid returning types where predicates have been expanded to dictionaries.
+  fixFunDictionaries = foldTerm idTermFold {fSuspension = worker} where
+      worker ct ty hval n | isFunTy ty = Suspension ct (dictsView ty) hval n
+                          | otherwise  = Suspension ct ty hval n
+
+extractSubTerms :: (Type -> ForeignHValue -> TcM Term)
+                -> GenClosure ForeignHValue -> [Type] -> TcM [Term]
+extractSubTerms recurse clos = liftM thdOf3 . go 0 0
+  where
+    array = dataArgs clos
+
+    go ptr_i arr_i [] = return (ptr_i, arr_i, [])
+    go ptr_i arr_i (ty:tys)
+      | Just (tc, elem_tys) <- tcSplitTyConApp_maybe ty
+      , isUnboxedTupleTyCon tc
+                -- See Note [Unboxed tuple RuntimeRep vars] in TyCon
+      = do (ptr_i, arr_i, terms0) <-
+               go ptr_i arr_i (dropRuntimeRepArgs elem_tys)
+           (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys
+           return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1)
+      | otherwise
+      = case typePrimRepArgs ty of
+          [rep_ty] ->  do
+            (ptr_i, arr_i, term0)  <- go_rep ptr_i arr_i ty rep_ty
+            (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys
+            return (ptr_i, arr_i, term0 : terms1)
+          rep_tys -> do
+           (ptr_i, arr_i, terms0) <- go_unary_types ptr_i arr_i rep_tys
+           (ptr_i, arr_i, terms1) <- go ptr_i arr_i tys
+           return (ptr_i, arr_i, unboxedTupleTerm ty terms0 : terms1)
+
+    go_unary_types ptr_i arr_i [] = return (ptr_i, arr_i, [])
+    go_unary_types ptr_i arr_i (rep_ty:rep_tys) = do
+      tv <- newVar liftedTypeKind
+      (ptr_i, arr_i, term0)  <- go_rep ptr_i arr_i tv rep_ty
+      (ptr_i, arr_i, terms1) <- go_unary_types ptr_i arr_i rep_tys
+      return (ptr_i, arr_i, term0 : terms1)
+
+    go_rep ptr_i arr_i ty rep
+      | isGcPtrRep rep = do
+          t <- recurse ty $ (ptrArgs clos)!!ptr_i
+          return (ptr_i + 1, arr_i, t)
+      | otherwise = do
+          -- This is a bit involved since we allow packing multiple fields
+          -- within a single word. See also
+          -- GHC.StgToCmm.Layout.mkVirtHeapOffsetsWithPadding
+          dflags <- getDynFlags
+          let word_size = wORD_SIZE dflags
+              big_endian = wORDS_BIGENDIAN dflags
+              size_b = primRepSizeB dflags rep
+              -- Align the start offset (eg, 2-byte value should be 2-byte
+              -- aligned). But not more than to a word. The offset calculation
+              -- should be the same with the offset calculation in
+              -- GHC.StgToCmm.Layout.mkVirtHeapOffsetsWithPadding.
+              !aligned_idx = roundUpTo arr_i (min word_size size_b)
+              !new_arr_i = aligned_idx + size_b
+              ws | size_b < word_size =
+                     [index size_b aligned_idx word_size big_endian]
+                 | otherwise =
+                     let (q, r) = size_b `quotRem` word_size
+                     in ASSERT( r == 0 )
+                        [ array!!i
+                        | o <- [0.. q - 1]
+                        , let i = (aligned_idx `quot` word_size) + o
+                        ]
+          return (ptr_i, new_arr_i, Prim ty ws)
+
+    unboxedTupleTerm ty terms
+      = Term ty (Right (tupleDataCon Unboxed (length terms)))
+                (error "unboxedTupleTerm: no HValue for unboxed tuple") terms
+
+    -- Extract a sub-word sized field from a word
+    index item_size_b index_b word_size big_endian =
+        (word .&. (mask `shiftL` moveBytes)) `shiftR` moveBytes
+      where
+        mask :: Word
+        mask = case item_size_b of
+            1 -> 0xFF
+            2 -> 0xFFFF
+            4 -> 0xFFFFFFFF
+            _ -> panic ("Weird byte-index: " ++ show index_b)
+        (q,r) = index_b `quotRem` word_size
+        word = array!!q
+        moveBytes = if big_endian
+                    then word_size - (r + item_size_b) * 8
+                    else r * 8
+
+
+-- | Fast, breadth-first Type reconstruction
+--
+-- Given a heap object (`HValue`) and its (possibly polymorphic) type (usually
+-- obtained in GHCi), try to reconstruct a more monomorphic type of the object.
+-- This is used for improving type information in debugger. For example, if we
+-- have a polymorphic function:
+--
+--     sumNumList :: Num a => [a] -> a
+--     sumNumList [] = 0
+--     sumNumList (x : xs) = x + sumList xs
+--
+-- and add a breakpoint to it:
+--
+--     ghci> break sumNumList
+--     ghci> sumNumList ([0 .. 9] :: [Int])
+--
+-- ghci shows us more precise types than just `a`s:
+--
+--     Stopped in Main.sumNumList, debugger.hs:3:23-39
+--     _result :: Int = _
+--     x :: Int = 0
+--     xs :: [Int] = _
+--
+cvReconstructType
+    :: HscEnv
+    -> Int       -- ^ How many times to recurse for subterms
+    -> GhciType  -- ^ Type to refine
+    -> ForeignHValue  -- ^ Refine the type using this value
+    -> IO (Maybe Type)
+cvReconstructType hsc_env max_depth old_ty hval = runTR_maybe hsc_env $ do
+   traceTR (text "RTTI started with initial type " <> ppr old_ty)
+   let sigma_old_ty@(old_tvs, _) = quantifyType old_ty
+   new_ty <-
+       if null old_tvs
+        then return old_ty
+        else do
+          (old_ty', rev_subst) <- instScheme sigma_old_ty
+          my_ty <- newOpenVar
+          when (check1 sigma_old_ty) (traceTR (text "check1 passed") >>
+                                      addConstraint my_ty old_ty')
+          search (isMonomorphic `fmap` zonkTcType my_ty)
+                 (\(ty,a) -> go ty a)
+                 (Seq.singleton (my_ty, hval))
+                 max_depth
+          new_ty <- zonkTcType my_ty
+          if isMonomorphic new_ty || check2 (quantifyType new_ty) sigma_old_ty
+            then do
+                 traceTR (text "check2 passed" <+> ppr old_ty $$ ppr new_ty)
+                 addConstraint my_ty old_ty'
+                 applyRevSubst rev_subst
+                 zonkRttiType new_ty
+            else traceTR (text "check2 failed" <+> parens (ppr new_ty)) >>
+                 return old_ty
+   traceTR (text "RTTI completed. Type obtained:" <+> ppr new_ty)
+   return new_ty
+    where
+--  search :: m Bool -> ([a] -> [a] -> [a]) -> [a] -> m ()
+  search _ _ _ 0 = traceTR (text "Failed to reconstruct a type after " <>
+                                int max_depth <> text " steps")
+  search stop expand l d =
+    case viewl l of
+      EmptyL  -> return ()
+      x :< xx -> unlessM stop $ do
+                  new <- expand x
+                  search stop expand (xx `mappend` Seq.fromList new) $! (pred d)
+
+   -- returns unification tasks,since we are going to want a breadth-first search
+  go :: Type -> ForeignHValue -> TR [(Type, ForeignHValue)]
+  go my_ty a = do
+    traceTR (text "go" <+> ppr my_ty)
+    clos <- trIO $ GHCi.getClosure hsc_env a
+    case clos of
+      BlackholeClosure{indirectee=ind} -> go my_ty ind
+      IndClosure{indirectee=ind} -> go my_ty ind
+      MutVarClosure{var=contents} -> do
+         tv'   <- newVar liftedTypeKind
+         world <- newVar liftedTypeKind
+         addConstraint my_ty (mkTyConApp mutVarPrimTyCon [world,tv'])
+         return [(tv', contents)]
+      ConstrClosure{ptrArgs=pArgs} -> do
+        Right dcname <- liftIO $ constrClosToName hsc_env clos
+        traceTR (text "Constr1" <+> ppr dcname)
+        (mb_dc, _) <- tryTc (tcLookupDataCon dcname)
+        case mb_dc of
+          Nothing-> do
+            forM pArgs $ \x -> do
+              tv <- newVar liftedTypeKind
+              return (tv, x)
+
+          Just dc -> do
+            arg_tys <- getDataConArgTys dc my_ty
+            (_, itys) <- findPtrTyss 0 arg_tys
+            traceTR (text "Constr2" <+> ppr dcname <+> ppr arg_tys)
+            return $ zipWith (\(_,ty) x -> (ty, x)) itys pArgs
+      _ -> return []
+
+findPtrTys :: Int  -- Current pointer index
+           -> Type -- Type
+           -> TR (Int, [(Int, Type)])
+findPtrTys i ty
+  | Just (tc, elem_tys) <- tcSplitTyConApp_maybe ty
+  , isUnboxedTupleTyCon tc
+  = findPtrTyss i elem_tys
+
+  | otherwise
+  = case typePrimRep ty of
+      [rep] | isGcPtrRep rep -> return (i + 1, [(i, ty)])
+            | otherwise      -> return (i,     [])
+      prim_reps              ->
+        foldM (\(i, extras) prim_rep ->
+                if isGcPtrRep prim_rep
+                  then newVar liftedTypeKind >>= \tv -> return (i + 1, extras ++ [(i, tv)])
+                  else return (i, extras))
+              (i, []) prim_reps
+
+findPtrTyss :: Int
+            -> [Type]
+            -> TR (Int, [(Int, Type)])
+findPtrTyss i tys = foldM step (i, []) tys
+  where step (i, discovered) elem_ty = do
+          (i, extras) <- findPtrTys i elem_ty
+          return (i, discovered ++ extras)
+
+
+-- Compute the difference between a base type and the type found by RTTI
+-- improveType <base_type> <rtti_type>
+-- The types can contain skolem type variables, which need to be treated as normal vars.
+-- In particular, we want them to unify with things.
+improveRTTIType :: HscEnv -> RttiType -> RttiType -> Maybe TCvSubst
+improveRTTIType _ base_ty new_ty = U.tcUnifyTyKi base_ty new_ty
+
+getDataConArgTys :: DataCon -> Type -> TR [Type]
+-- Given the result type ty of a constructor application (D a b c :: ty)
+-- return the types of the arguments.  This is RTTI-land, so 'ty' might
+-- not be fully known.  Moreover, the arg types might involve existentials;
+-- if so, make up fresh RTTI type variables for them
+--
+-- I believe that con_app_ty should not have any enclosing foralls
+getDataConArgTys dc con_app_ty
+  = do { let rep_con_app_ty = unwrapType con_app_ty
+       ; traceTR (text "getDataConArgTys 1" <+> (ppr con_app_ty $$ ppr rep_con_app_ty
+                   $$ ppr (tcSplitTyConApp_maybe rep_con_app_ty)))
+       ; ASSERT( all isTyVar ex_tvs ) return ()
+                 -- ex_tvs can only be tyvars as data types in source
+                 -- Haskell cannot mention covar yet (Aug 2018)
+       ; (subst, _) <- instTyVars (univ_tvs ++ ex_tvs)
+       ; addConstraint rep_con_app_ty (substTy subst (dataConOrigResTy dc))
+              -- See Note [Constructor arg types]
+       ; let con_arg_tys = substTys subst (dataConRepArgTys dc)
+       ; traceTR (text "getDataConArgTys 2" <+> (ppr rep_con_app_ty $$ ppr con_arg_tys $$ ppr subst))
+       ; return con_arg_tys }
+  where
+    univ_tvs = dataConUnivTyVars dc
+    ex_tvs   = dataConExTyCoVars dc
+
+{- Note [Constructor arg types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider a GADT (cf #7386)
+   data family D a b
+   data instance D [a] a where
+     MkT :: a -> D [a] (Maybe a)
+     ...
+
+In getDataConArgTys
+* con_app_ty is the known type (from outside) of the constructor application,
+  say D [Int] Int
+
+* The data constructor MkT has a (representation) dataConTyCon = DList,
+  say where
+    data DList a where
+      MkT :: a -> DList a (Maybe a)
+      ...
+
+So the dataConTyCon of the data constructor, DList, differs from
+the "outside" type, D. So we can't straightforwardly decompose the
+"outside" type, and we end up in the "_" branch of the case.
+
+Then we match the dataConOrigResTy of the data constructor against the
+outside type, hoping to get a substitution that tells how to instantiate
+the *representation* type constructor.   This looks a bit delicate to
+me, but it seems to work.
+-}
+
+-- Soundness checks
+--------------------
+{-
+This is not formalized anywhere, so hold to your seats!
+RTTI in the presence of newtypes can be a tricky and unsound business.
+
+Example:
+~~~~~~~~~
+Suppose we are doing RTTI for a partially evaluated
+closure t, the real type of which is t :: MkT Int, for
+
+   newtype MkT a = MkT [Maybe a]
+
+The table below shows the results of RTTI and the improvement
+calculated for different combinations of evaluatedness and :type t.
+Regard the two first columns as input and the next two as output.
+
+  # |     t     |  :type t  | rtti(t)  | improv.    | result
+    ------------------------------------------------------------
+  1 |     _     |    t b    |    a     | none       | OK
+  2 |     _     |   MkT b   |    a     | none       | OK
+  3 |     _     |   t Int   |    a     | none       | OK
+
+  If t is not evaluated at *all*, we are safe.
+
+  4 |  (_ : _)  |    t b    |   [a]    | t = []     | UNSOUND
+  5 |  (_ : _)  |   MkT b   |  MkT a   | none       | OK (compensating for the missing newtype)
+  6 |  (_ : _)  |   t Int   |  [Int]   | t = []     | UNSOUND
+
+  If a is a minimal whnf, we run into trouble. Note that
+  row 5 above does newtype enrichment on the ty_rtty parameter.
+
+  7 | (Just _:_)|    t b    |[Maybe a] | t = [],    | UNSOUND
+    |                       |          | b = Maybe a|
+
+  8 | (Just _:_)|   MkT b   |  MkT a   |  none      | OK
+  9 | (Just _:_)|   t Int   |   FAIL   |  none      | OK
+
+  And if t is any more evaluated than whnf, we are still in trouble.
+  Because constraints are solved in top-down order, when we reach the
+  Maybe subterm what we got is already unsound. This explains why the
+  row 9 fails to complete.
+
+  10 | (Just _:_)|  t Int  | [Maybe a]   |  FAIL    | OK
+  11 | (Just 1:_)|  t Int  | [Maybe Int] |  FAIL    | OK
+
+  We can undo the failure in row 9 by leaving out the constraint
+  coming from the type signature of t (i.e., the 2nd column).
+  Note that this type information is still used
+  to calculate the improvement. But we fail
+  when trying to calculate the improvement, as there is no unifier for
+  t Int = [Maybe a] or t Int = [Maybe Int].
+
+
+  Another set of examples with t :: [MkT (Maybe Int)]  \equiv  [[Maybe (Maybe Int)]]
+
+  # |     t     |    :type t    |  rtti(t)    | improvement | result
+    ---------------------------------------------------------------------
+  1 |(Just _:_) | [t (Maybe a)] | [[Maybe b]] | t = []      |
+    |           |               |             | b = Maybe a |
+
+The checks:
+~~~~~~~~~~~
+Consider a function obtainType that takes a value and a type and produces
+the Term representation and a substitution (the improvement).
+Assume an auxiliar rtti' function which does the actual job if recovering
+the type, but which may produce a false type.
+
+In pseudocode:
+
+  rtti' :: a -> IO Type  -- Does not use the static type information
+
+  obtainType :: a -> Type -> IO (Maybe (Term, Improvement))
+  obtainType v old_ty = do
+       rtti_ty <- rtti' v
+       if monomorphic rtti_ty || (check rtti_ty old_ty)
+        then ...
+         else return Nothing
+  where check rtti_ty old_ty = check1 rtti_ty &&
+                              check2 rtti_ty old_ty
+
+  check1 :: Type -> Bool
+  check2 :: Type -> Type -> Bool
+
+Now, if rtti' returns a monomorphic type, we are safe.
+If that is not the case, then we consider two conditions.
+
+
+1. To prevent the class of unsoundness displayed by
+   rows 4 and 7 in the example: no higher kind tyvars
+   accepted.
+
+  check1 (t a)   = NO
+  check1 (t Int) = NO
+  check1 ([] a)  = YES
+
+2. To prevent the class of unsoundness shown by row 6,
+   the rtti type should be structurally more
+   defined than the old type we are comparing it to.
+  check2 :: NewType -> OldType -> Bool
+  check2 a  _        = True
+  check2 [a] a       = True
+  check2 [a] (t Int) = False
+  check2 [a] (t a)   = False  -- By check1 we never reach this equation
+  check2 [Int] a     = True
+  check2 [Int] (t Int) = True
+  check2 [Maybe a]   (t Int) = False
+  check2 [Maybe Int] (t Int) = True
+  check2 (Maybe [a])   (m [Int]) = False
+  check2 (Maybe [Int]) (m [Int]) = True
+
+-}
+
+check1 :: QuantifiedType -> Bool
+check1 (tvs, _) = not $ any isHigherKind (map tyVarKind tvs)
+ where
+   isHigherKind = not . null . fst . splitPiTys
+
+check2 :: QuantifiedType -> QuantifiedType -> Bool
+check2 (_, rtti_ty) (_, old_ty)
+  | Just (_, rttis) <- tcSplitTyConApp_maybe rtti_ty
+  = case () of
+      _ | Just (_,olds) <- tcSplitTyConApp_maybe old_ty
+        -> and$ zipWith check2 (map quantifyType rttis) (map quantifyType olds)
+      _ | Just _ <- splitAppTy_maybe old_ty
+        -> isMonomorphicOnNonPhantomArgs rtti_ty
+      _ -> True
+  | otherwise = True
+
+-- Dealing with newtypes
+--------------------------
+{-
+ congruenceNewtypes does a parallel fold over two Type values,
+ compensating for missing newtypes on both sides.
+ This is necessary because newtypes are not present
+ in runtime, but sometimes there is evidence available.
+   Evidence can come from DataCon signatures or
+ from compile-time type inference.
+ What we are doing here is an approximation
+ of unification modulo a set of equations derived
+ from newtype definitions. These equations should be the
+ same as the equality coercions generated for newtypes
+ in System Fc. The idea is to perform a sort of rewriting,
+ taking those equations as rules, before launching unification.
+
+ The caller must ensure the following.
+ The 1st type (lhs) comes from the heap structure of ptrs,nptrs.
+ The 2nd type (rhs) comes from a DataCon type signature.
+ Rewriting (i.e. adding/removing a newtype wrapper) can happen
+ in both types, but in the rhs it is restricted to the result type.
+
+   Note that it is very tricky to make this 'rewriting'
+ work with the unification implemented by TcM, where
+ substitutions are operationally inlined. The order in which
+ constraints are unified is vital as we cannot modify
+ anything that has been touched by a previous unification step.
+Therefore, congruenceNewtypes is sound only if the types
+recovered by the RTTI mechanism are unified Top-Down.
+-}
+congruenceNewtypes ::  TcType -> TcType -> TR (TcType,TcType)
+congruenceNewtypes lhs rhs = go lhs rhs >>= \rhs' -> return (lhs,rhs')
+ where
+   go l r
+ -- TyVar lhs inductive case
+    | Just tv <- getTyVar_maybe l
+    , isTcTyVar tv
+    , isMetaTyVar tv
+    = recoverTR (return r) $ do
+         Indirect ty_v <- readMetaTyVar tv
+         traceTR $ fsep [text "(congruence) Following indirect tyvar:",
+                          ppr tv, equals, ppr ty_v]
+         go ty_v r
+-- FunTy inductive case
+    | Just (l1,l2) <- splitFunTy_maybe l
+    , Just (r1,r2) <- splitFunTy_maybe r
+    = do r2' <- go l2 r2
+         r1' <- go l1 r1
+         return (mkVisFunTy r1' r2')
+-- TyconApp Inductive case; this is the interesting bit.
+    | Just (tycon_l, _) <- tcSplitTyConApp_maybe lhs
+    , Just (tycon_r, _) <- tcSplitTyConApp_maybe rhs
+    , tycon_l /= tycon_r
+    = upgrade tycon_l r
+
+    | otherwise = return r
+
+    where upgrade :: TyCon -> Type -> TR Type
+          upgrade new_tycon ty
+            | not (isNewTyCon new_tycon) = do
+              traceTR (text "(Upgrade) Not matching newtype evidence: " <>
+                       ppr new_tycon <> text " for " <> ppr ty)
+              return ty
+            | otherwise = do
+               traceTR (text "(Upgrade) upgraded " <> ppr ty <>
+                        text " in presence of newtype evidence " <> ppr new_tycon)
+               (_, vars) <- instTyVars (tyConTyVars new_tycon)
+               let ty' = mkTyConApp new_tycon (mkTyVarTys vars)
+                   rep_ty = unwrapType ty'
+               _ <- liftTcM (unifyType Nothing ty rep_ty)
+        -- assumes that reptype doesn't ^^^^ touch tyconApp args
+               return ty'
+
+
+zonkTerm :: Term -> TcM Term
+zonkTerm = foldTermM (TermFoldM
+             { fTermM = \ty dc v tt -> zonkRttiType ty    >>= \ty' ->
+                                       return (Term ty' dc v tt)
+             , fSuspensionM  = \ct ty v b -> zonkRttiType ty >>= \ty ->
+                                             return (Suspension ct ty v b)
+             , fNewtypeWrapM = \ty dc t -> zonkRttiType ty >>= \ty' ->
+                                           return$ NewtypeWrap ty' dc t
+             , fRefWrapM     = \ty t -> return RefWrap  `ap`
+                                        zonkRttiType ty `ap` return t
+             , fPrimM        = (return.) . Prim })
+
+zonkRttiType :: TcType -> TcM Type
+-- Zonk the type, replacing any unbound Meta tyvars
+-- by RuntimeUnk skolems, safely out of Meta-tyvar-land
+zonkRttiType ty= do { ze <- mkEmptyZonkEnv RuntimeUnkFlexi
+                    ; zonkTcTypeToTypeX ze ty }
+
+--------------------------------------------------------------------------------
+-- Restore Class predicates out of a representation type
+dictsView :: Type -> Type
+dictsView ty = ty
+
+
+-- Use only for RTTI types
+isMonomorphic :: RttiType -> Bool
+isMonomorphic ty = noExistentials && noUniversals
+ where (tvs, _, ty')  = tcSplitSigmaTy ty
+       noExistentials = noFreeVarsOfType ty'
+       noUniversals   = null tvs
+
+-- Use only for RTTI types
+isMonomorphicOnNonPhantomArgs :: RttiType -> Bool
+isMonomorphicOnNonPhantomArgs ty
+  | Just (tc, all_args) <- tcSplitTyConApp_maybe (unwrapType ty)
+  , phantom_vars  <- tyConPhantomTyVars tc
+  , concrete_args <- [ arg | (tyv,arg) <- tyConTyVars tc `zip` all_args
+                           , tyv `notElem` phantom_vars]
+  = all isMonomorphicOnNonPhantomArgs concrete_args
+  | Just (ty1, ty2) <- splitFunTy_maybe ty
+  = all isMonomorphicOnNonPhantomArgs [ty1,ty2]
+  | otherwise = isMonomorphic ty
+
+tyConPhantomTyVars :: TyCon -> [TyVar]
+tyConPhantomTyVars tc
+  | isAlgTyCon tc
+  , Just dcs <- tyConDataCons_maybe tc
+  , dc_vars  <- concatMap dataConUnivTyVars dcs
+  = tyConTyVars tc \\ dc_vars
+tyConPhantomTyVars _ = []
+
+type QuantifiedType = ([TyVar], Type)
+   -- Make the free type variables explicit
+   -- The returned Type should have no top-level foralls (I believe)
+
+quantifyType :: Type -> QuantifiedType
+-- Generalize the type: find all free and forall'd tyvars
+-- and return them, together with the type inside, which
+-- should not be a forall type.
+--
+-- Thus (quantifyType (forall a. a->[b]))
+-- returns ([a,b], a -> [b])
+
+quantifyType ty = ( filter isTyVar $
+                    tyCoVarsOfTypeWellScoped rho
+                  , rho)
+  where
+    (_tvs, rho) = tcSplitForAllTys ty
diff --git a/compiler/GHC/Runtime/Layout.hs b/compiler/GHC/Runtime/Heap/Layout.hs
index 8f245479c1..b7899ecc1b 100644
--- a/compiler/GHC/Runtime/Layout.hs
+++ b/compiler/GHC/Runtime/Heap/Layout.hs
@@ -5,7 +5,7 @@
 
 {-# LANGUAGE CPP,GeneralizedNewtypeDeriving #-}
 
-module GHC.Runtime.Layout (
+module GHC.Runtime.Heap.Layout (
         -- * Words and bytes
         WordOff, ByteOff,
         wordsToBytes, bytesToWordsRoundUp,
diff --git a/compiler/GHC/Runtime/Interpreter.hs b/compiler/GHC/Runtime/Interpreter.hs
new file mode 100644
index 0000000000..9eadacca1c
--- /dev/null
+++ b/compiler/GHC/Runtime/Interpreter.hs
@@ -0,0 +1,667 @@
+{-# LANGUAGE RecordWildCards, ScopedTypeVariables, BangPatterns, CPP #-}
+
+--
+-- | Interacting with the interpreter, whether it is running on an
+-- external process or in the current process.
+--
+module GHC.Runtime.Interpreter
+  ( -- * High-level interface to the interpreter
+    evalStmt, EvalStatus_(..), EvalStatus, EvalResult(..), EvalExpr(..)
+  , resumeStmt
+  , abandonStmt
+  , evalIO
+  , evalString
+  , evalStringToIOString
+  , mallocData
+  , createBCOs
+  , addSptEntry
+  , mkCostCentres
+  , costCentreStackInfo
+  , newBreakArray
+  , enableBreakpoint
+  , breakpointStatus
+  , getBreakpointVar
+  , getClosure
+  , seqHValue
+
+  -- * The object-code linker
+  , initObjLinker
+  , lookupSymbol
+  , lookupClosure
+  , loadDLL
+  , loadArchive
+  , loadObj
+  , unloadObj
+  , addLibrarySearchPath
+  , removeLibrarySearchPath
+  , resolveObjs
+  , findSystemLibrary
+
+  -- * Lower-level API using messages
+  , iservCmd, Message(..), withIServ, stopIServ
+  , iservCall, readIServ, writeIServ
+  , purgeLookupSymbolCache
+  , freeHValueRefs
+  , mkFinalizedHValue
+  , wormhole, wormholeRef
+  , mkEvalOpts
+  , fromEvalResult
+  ) where
+
+import GhcPrelude
+
+import GHCi.Message
+#if defined(HAVE_INTERNAL_INTERPRETER)
+import GHCi.Run
+#endif
+import GHCi.RemoteTypes
+import GHCi.ResolvedBCO
+import GHCi.BreakArray (BreakArray)
+import Fingerprint
+import HscTypes
+import UniqFM
+import Panic
+import DynFlags
+import ErrUtils
+import Outputable
+import Exception
+import BasicTypes
+import FastString
+import Util
+import Hooks
+
+import Control.Concurrent
+import Control.Monad
+import Control.Monad.IO.Class
+import Data.Binary
+import Data.Binary.Put
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Lazy as LB
+import Data.IORef
+import Foreign hiding (void)
+import GHC.Exts.Heap
+import GHC.Stack.CCS (CostCentre,CostCentreStack)
+import System.Exit
+import Data.Maybe
+import GHC.IO.Handle.Types (Handle)
+#if defined(mingw32_HOST_OS)
+import Foreign.C
+import GHC.IO.Handle.FD (fdToHandle)
+#else
+import System.Posix as Posix
+#endif
+import System.Directory
+import System.Process
+import GHC.Conc (getNumProcessors, pseq, par)
+
+{- Note [Remote GHCi]
+
+When the flag -fexternal-interpreter is given to GHC, interpreted code
+is run in a separate process called iserv, and we communicate with the
+external process over a pipe using Binary-encoded messages.
+
+Motivation
+~~~~~~~~~~
+
+When the interpreted code is running in a separate process, it can
+use a different "way", e.g. profiled or dynamic.  This means
+
+- compiling Template Haskell code with -prof does not require
+  building the code without -prof first
+
+- when GHC itself is profiled, it can interpret unprofiled code,
+  and the same applies to dynamic linking.
+
+- An unprofiled GHCi can load and run profiled code, which means it
+  can use the stack-trace functionality provided by profiling without
+  taking the performance hit on the compiler that profiling would
+  entail.
+
+For other reasons see remote-GHCi on the wiki.
+
+Implementation Overview
+~~~~~~~~~~~~~~~~~~~~~~~
+
+The main pieces are:
+
+- libraries/ghci, containing:
+  - types for talking about remote values (GHCi.RemoteTypes)
+  - the message protocol (GHCi.Message),
+  - implementation of the messages (GHCi.Run)
+  - implementation of Template Haskell (GHCi.TH)
+  - a few other things needed to run interpreted code
+
+- top-level iserv directory, containing the codefor the external
+  server.  This is a fairly simple wrapper, most of the functionality
+  is provided by modules in libraries/ghci.
+
+- This module which provides the interface to the server used
+  by the rest of GHC.
+
+GHC works with and without -fexternal-interpreter.  With the flag, all
+interpreted code is run by the iserv binary.  Without the flag,
+interpreted code is run in the same process as GHC.
+
+Things that do not work with -fexternal-interpreter
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+dynCompileExpr cannot work, because we have no way to run code of an
+unknown type in the remote process.  This API fails with an error
+message if it is used with -fexternal-interpreter.
+
+Other Notes on Remote GHCi
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+  * This wiki page has an implementation overview:
+    https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/external-interpreter
+  * Note [External GHCi pointers] in compiler/ghci/GHCi.hs
+  * Note [Remote Template Haskell] in libraries/ghci/GHCi/TH.hs
+-}
+
+#if !defined(HAVE_INTERNAL_INTERPRETER)
+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
+-- @Binary@ constraint).  With @-fno-external-interpreter@ we execute
+-- the command directly here.
+iservCmd :: Binary a => HscEnv -> Message a -> IO a
+iservCmd hsc_env@HscEnv{..} msg
+ | gopt Opt_ExternalInterpreter hsc_dflags =
+     withIServ hsc_env $ \iserv ->
+       uninterruptibleMask_ $ do -- Note [uninterruptibleMask_]
+         iservCall iserv msg
+ | otherwise = -- Just run it directly
+#if defined(HAVE_INTERNAL_INTERPRETER)
+   run msg
+#else
+   needExtInt
+#endif
+
+-- Note [uninterruptibleMask_ and iservCmd]
+--
+-- If we receive an async exception, such as ^C, while communicating
+-- with the iserv process then we will be out-of-sync and not be able
+-- to recoever.  Thus we use uninterruptibleMask_ during
+-- communication.  A ^C will be delivered to the iserv process (because
+-- signals get sent to the whole process group) which will interrupt
+-- the running computation and return an EvalException result.
+
+-- | Grab a lock on the 'IServ' and do something with it.
+-- Overloaded because this is used from TcM as well as IO.
+withIServ
+  :: (MonadIO m, ExceptionMonad m)
+  => HscEnv -> (IServ -> m a) -> m a
+withIServ HscEnv{..} action =
+  gmask $ \restore -> do
+    m <- liftIO $ takeMVar hsc_iserv
+      -- start the iserv process if we haven't done so yet
+    iserv <- maybe (liftIO $ startIServ hsc_dflags) return m
+               `gonException` (liftIO $ putMVar hsc_iserv Nothing)
+      -- free any ForeignHValues that have been garbage collected.
+    let iserv' = iserv{ iservPendingFrees = [] }
+    a <- (do
+      liftIO $ when (not (null (iservPendingFrees iserv))) $
+        iservCall iserv (FreeHValueRefs (iservPendingFrees iserv))
+        -- run the inner action
+      restore $ action iserv)
+          `gonException` (liftIO $ putMVar hsc_iserv (Just iserv'))
+    liftIO $ putMVar hsc_iserv (Just iserv')
+    return a
+
+
+-- -----------------------------------------------------------------------------
+-- Wrappers around messages
+
+-- | Execute an action of type @IO [a]@, returning 'ForeignHValue's for
+-- each of the results.
+evalStmt
+  :: HscEnv -> Bool -> EvalExpr ForeignHValue
+  -> IO (EvalStatus_ [ForeignHValue] [HValueRef])
+evalStmt hsc_env step foreign_expr = do
+  let dflags = hsc_dflags hsc_env
+  status <- withExpr foreign_expr $ \expr ->
+    iservCmd hsc_env (EvalStmt (mkEvalOpts dflags step) expr)
+  handleEvalStatus hsc_env status
+ where
+  withExpr :: EvalExpr ForeignHValue -> (EvalExpr HValueRef -> IO a) -> IO a
+  withExpr (EvalThis fhv) cont =
+    withForeignRef fhv $ \hvref -> cont (EvalThis hvref)
+  withExpr (EvalApp fl fr) cont =
+    withExpr fl $ \fl' ->
+    withExpr fr $ \fr' ->
+    cont (EvalApp fl' fr')
+
+resumeStmt
+  :: HscEnv -> Bool -> ForeignRef (ResumeContext [HValueRef])
+  -> IO (EvalStatus_ [ForeignHValue] [HValueRef])
+resumeStmt hsc_env step resume_ctxt = do
+  let dflags = hsc_dflags hsc_env
+  status <- withForeignRef resume_ctxt $ \rhv ->
+    iservCmd hsc_env (ResumeStmt (mkEvalOpts dflags step) rhv)
+  handleEvalStatus hsc_env status
+
+abandonStmt :: HscEnv -> ForeignRef (ResumeContext [HValueRef]) -> IO ()
+abandonStmt hsc_env resume_ctxt = do
+  withForeignRef resume_ctxt $ \rhv ->
+    iservCmd hsc_env (AbandonStmt rhv)
+
+handleEvalStatus
+  :: HscEnv -> EvalStatus [HValueRef]
+  -> IO (EvalStatus_ [ForeignHValue] [HValueRef])
+handleEvalStatus hsc_env status =
+  case status of
+    EvalBreak a b c d e f -> return (EvalBreak a b c d e f)
+    EvalComplete alloc res ->
+      EvalComplete alloc <$> addFinalizer res
+ where
+  addFinalizer (EvalException e) = return (EvalException e)
+  addFinalizer (EvalSuccess rs) = do
+    EvalSuccess <$> mapM (mkFinalizedHValue hsc_env) rs
+
+-- | Execute an action of type @IO ()@
+evalIO :: HscEnv -> ForeignHValue -> IO ()
+evalIO hsc_env fhv = do
+  liftIO $ withForeignRef fhv $ \fhv ->
+    iservCmd hsc_env (EvalIO fhv) >>= fromEvalResult
+
+-- | Execute an action of type @IO String@
+evalString :: HscEnv -> ForeignHValue -> IO String
+evalString hsc_env fhv = do
+  liftIO $ withForeignRef fhv $ \fhv ->
+    iservCmd hsc_env (EvalString fhv) >>= fromEvalResult
+
+-- | Execute an action of type @String -> IO String@
+evalStringToIOString :: HscEnv -> ForeignHValue -> String -> IO String
+evalStringToIOString hsc_env fhv str = do
+  liftIO $ withForeignRef fhv $ \fhv ->
+    iservCmd hsc_env (EvalStringToString fhv str) >>= fromEvalResult
+
+
+-- | Allocate and store the given bytes in memory, returning a pointer
+-- to the memory in the remote process.
+mallocData :: HscEnv -> ByteString -> IO (RemotePtr ())
+mallocData hsc_env bs = iservCmd hsc_env (MallocData bs)
+
+mkCostCentres
+  :: HscEnv -> String -> [(String,String)] -> IO [RemotePtr CostCentre]
+mkCostCentres hsc_env mod ccs =
+  iservCmd hsc_env (MkCostCentres mod ccs)
+
+-- | Create a set of BCOs that may be mutually recursive.
+createBCOs :: HscEnv -> [ResolvedBCO] -> IO [HValueRef]
+createBCOs hsc_env rbcos = do
+  n_jobs <- case parMakeCount (hsc_dflags hsc_env) of
+              Nothing -> liftIO getNumProcessors
+              Just n  -> return n
+  -- Serializing ResolvedBCO is expensive, so if we're in parallel mode
+  -- (-j<n>) parallelise the serialization.
+  if (n_jobs == 1)
+    then
+      iservCmd hsc_env (CreateBCOs [runPut (put rbcos)])
+
+    else do
+      old_caps <- getNumCapabilities
+      if old_caps == n_jobs
+         then void $ evaluate puts
+         else bracket_ (setNumCapabilities n_jobs)
+                       (setNumCapabilities old_caps)
+                       (void $ evaluate puts)
+      iservCmd hsc_env (CreateBCOs puts)
+ where
+  puts = parMap doChunk (chunkList 100 rbcos)
+
+  -- make sure we force the whole lazy ByteString
+  doChunk c = pseq (LB.length bs) bs
+    where bs = runPut (put c)
+
+  -- We don't have the parallel package, so roll our own simple parMap
+  parMap _ [] = []
+  parMap f (x:xs) = fx `par` (fxs `pseq` (fx : fxs))
+    where fx = f x; fxs = parMap f xs
+
+addSptEntry :: HscEnv -> Fingerprint -> ForeignHValue -> IO ()
+addSptEntry hsc_env fpr ref =
+  withForeignRef ref $ \val ->
+    iservCmd hsc_env (AddSptEntry fpr val)
+
+costCentreStackInfo :: HscEnv -> RemotePtr CostCentreStack -> IO [String]
+costCentreStackInfo hsc_env ccs =
+  iservCmd hsc_env (CostCentreStackInfo ccs)
+
+newBreakArray :: HscEnv -> Int -> IO (ForeignRef BreakArray)
+newBreakArray hsc_env size = do
+  breakArray <- iservCmd hsc_env (NewBreakArray size)
+  mkFinalizedHValue hsc_env breakArray
+
+enableBreakpoint :: HscEnv -> ForeignRef BreakArray -> Int -> Bool -> IO ()
+enableBreakpoint hsc_env ref ix b = do
+  withForeignRef ref $ \breakarray ->
+    iservCmd hsc_env (EnableBreakpoint breakarray ix b)
+
+breakpointStatus :: HscEnv -> ForeignRef BreakArray -> Int -> IO Bool
+breakpointStatus hsc_env ref ix = do
+  withForeignRef ref $ \breakarray ->
+    iservCmd hsc_env (BreakpointStatus breakarray ix)
+
+getBreakpointVar :: HscEnv -> ForeignHValue -> Int -> IO (Maybe ForeignHValue)
+getBreakpointVar hsc_env ref ix =
+  withForeignRef ref $ \apStack -> do
+    mb <- iservCmd hsc_env (GetBreakpointVar apStack ix)
+    mapM (mkFinalizedHValue hsc_env) mb
+
+getClosure :: HscEnv -> ForeignHValue -> IO (GenClosure ForeignHValue)
+getClosure hsc_env ref =
+  withForeignRef ref $ \hval -> do
+    mb <- iservCmd hsc_env (GetClosure hval)
+    mapM (mkFinalizedHValue hsc_env) mb
+
+seqHValue :: HscEnv -> ForeignHValue -> IO ()
+seqHValue hsc_env ref =
+  withForeignRef ref $ \hval ->
+    iservCmd hsc_env (Seq hval) >>= fromEvalResult
+
+-- -----------------------------------------------------------------------------
+-- Interface to the object-code linker
+
+initObjLinker :: HscEnv -> IO ()
+initObjLinker hsc_env = iservCmd hsc_env InitLinker
+
+lookupSymbol :: HscEnv -> FastString -> IO (Maybe (Ptr ()))
+lookupSymbol hsc_env@HscEnv{..} str
+ | gopt Opt_ExternalInterpreter hsc_dflags =
+     -- Profiling of GHCi showed a lot of time and allocation spent
+     -- making cross-process LookupSymbol calls, so I added a GHC-side
+     -- cache which sped things up quite a lot.  We have to be careful
+     -- to purge this cache when unloading code though.
+     withIServ hsc_env $ \iserv@IServ{..} -> do
+       cache <- readIORef iservLookupSymbolCache
+       case lookupUFM cache str of
+         Just p -> return (Just p)
+         Nothing -> do
+           m <- uninterruptibleMask_ $
+                    iservCall iserv (LookupSymbol (unpackFS str))
+           case m of
+             Nothing -> return Nothing
+             Just r -> do
+               let p = fromRemotePtr r
+               writeIORef iservLookupSymbolCache $! addToUFM cache str p
+               return (Just p)
+ | otherwise =
+#if defined(HAVE_INTERNAL_INTERPRETER)
+   fmap fromRemotePtr <$> run (LookupSymbol (unpackFS str))
+#else
+   needExtInt
+#endif
+
+lookupClosure :: HscEnv -> String -> IO (Maybe HValueRef)
+lookupClosure hsc_env str =
+  iservCmd hsc_env (LookupClosure str)
+
+purgeLookupSymbolCache :: HscEnv -> IO ()
+purgeLookupSymbolCache hsc_env@HscEnv{..} =
+ when (gopt Opt_ExternalInterpreter hsc_dflags) $
+   withIServ hsc_env $ \IServ{..} ->
+     writeIORef iservLookupSymbolCache emptyUFM
+
+
+-- | loadDLL loads a dynamic library using the OS's native linker
+-- (i.e. dlopen() on Unix, LoadLibrary() on Windows).  It takes either
+-- an absolute pathname to the file, or a relative filename
+-- (e.g. "libfoo.so" or "foo.dll").  In the latter case, loadDLL
+-- searches the standard locations for the appropriate library.
+--
+-- Returns:
+--
+-- Nothing      => success
+-- Just err_msg => failure
+loadDLL :: HscEnv -> String -> IO (Maybe String)
+loadDLL hsc_env str = iservCmd hsc_env (LoadDLL str)
+
+loadArchive :: HscEnv -> String -> IO ()
+loadArchive hsc_env path = do
+  path' <- canonicalizePath path -- Note [loadObj and relative paths]
+  iservCmd hsc_env (LoadArchive path')
+
+loadObj :: HscEnv -> String -> IO ()
+loadObj hsc_env path = do
+  path' <- canonicalizePath path -- Note [loadObj and relative paths]
+  iservCmd hsc_env (LoadObj path')
+
+unloadObj :: HscEnv -> String -> IO ()
+unloadObj hsc_env path = do
+  path' <- canonicalizePath path -- Note [loadObj and relative paths]
+  iservCmd hsc_env (UnloadObj path')
+
+-- Note [loadObj and relative paths]
+-- the iserv process might have a different current directory from the
+-- GHC process, so we must make paths absolute before sending them
+-- over.
+
+addLibrarySearchPath :: HscEnv -> String -> IO (Ptr ())
+addLibrarySearchPath hsc_env str =
+  fromRemotePtr <$> iservCmd hsc_env (AddLibrarySearchPath str)
+
+removeLibrarySearchPath :: HscEnv -> Ptr () -> IO Bool
+removeLibrarySearchPath hsc_env p =
+  iservCmd hsc_env (RemoveLibrarySearchPath (toRemotePtr p))
+
+resolveObjs :: HscEnv -> IO SuccessFlag
+resolveObjs hsc_env = successIf <$> iservCmd hsc_env ResolveObjs
+
+findSystemLibrary :: HscEnv -> String -> IO (Maybe String)
+findSystemLibrary hsc_env str = iservCmd hsc_env (FindSystemLibrary str)
+
+
+-- -----------------------------------------------------------------------------
+-- Raw calls and messages
+
+-- | Send a 'Message' and receive the response from the iserv process
+iservCall :: Binary a => IServ -> Message a -> IO a
+iservCall iserv@IServ{..} msg =
+  remoteCall iservPipe msg
+    `catch` \(e :: SomeException) -> handleIServFailure iserv e
+
+-- | Read a value from the iserv process
+readIServ :: IServ -> Get a -> IO a
+readIServ iserv@IServ{..} get =
+  readPipe iservPipe get
+    `catch` \(e :: SomeException) -> handleIServFailure iserv e
+
+-- | Send a value to the iserv process
+writeIServ :: IServ -> Put -> IO ()
+writeIServ iserv@IServ{..} put =
+  writePipe iservPipe put
+    `catch` \(e :: SomeException) -> handleIServFailure iserv e
+
+handleIServFailure :: IServ -> SomeException -> IO a
+handleIServFailure IServ{..} e = do
+  ex <- getProcessExitCode iservProcess
+  case ex of
+    Just (ExitFailure n) ->
+      throw (InstallationError ("ghc-iserv terminated (" ++ show n ++ ")"))
+    _ -> do
+      terminateProcess iservProcess
+      _ <- waitForProcess iservProcess
+      throw e
+
+-- -----------------------------------------------------------------------------
+-- Starting and stopping the iserv process
+
+startIServ :: DynFlags -> IO IServ
+startIServ dflags = do
+  let flavour
+        | WayProf `elem` ways dflags = "-prof"
+        | WayDyn `elem` ways dflags = "-dyn"
+        | otherwise = ""
+      prog = pgm_i dflags ++ flavour
+      opts = getOpts dflags opt_i
+  debugTraceMsg dflags 3 $ text "Starting " <> text prog
+  let createProc = lookupHook createIservProcessHook
+                              (\cp -> do { (_,_,_,ph) <- createProcess cp
+                                         ; return ph })
+                              dflags
+  (ph, rh, wh) <- runWithPipes createProc prog opts
+  lo_ref <- newIORef Nothing
+  cache_ref <- newIORef emptyUFM
+  return $ IServ
+    { iservPipe = Pipe { pipeRead = rh
+                       , pipeWrite = wh
+                       , pipeLeftovers = lo_ref }
+    , iservProcess = ph
+    , iservLookupSymbolCache = cache_ref
+    , iservPendingFrees = []
+    }
+
+stopIServ :: HscEnv -> IO ()
+stopIServ HscEnv{..} =
+  gmask $ \_restore -> do
+    m <- takeMVar hsc_iserv
+    maybe (return ()) stop m
+    putMVar hsc_iserv Nothing
+ where
+  stop iserv = do
+    ex <- getProcessExitCode (iservProcess iserv)
+    if isJust ex
+       then return ()
+       else iservCall iserv Shutdown
+
+runWithPipes :: (CreateProcess -> IO ProcessHandle)
+             -> FilePath -> [String] -> IO (ProcessHandle, Handle, Handle)
+#if defined(mingw32_HOST_OS)
+foreign import ccall "io.h _close"
+   c__close :: CInt -> IO CInt
+
+foreign import ccall unsafe "io.h _get_osfhandle"
+   _get_osfhandle :: CInt -> IO CInt
+
+runWithPipes createProc prog opts = do
+    (rfd1, wfd1) <- createPipeFd -- we read on rfd1
+    (rfd2, wfd2) <- createPipeFd -- we write on wfd2
+    wh_client    <- _get_osfhandle wfd1
+    rh_client    <- _get_osfhandle rfd2
+    let args = show wh_client : show rh_client : opts
+    ph <- createProc (proc prog args)
+    rh <- mkHandle rfd1
+    wh <- mkHandle wfd2
+    return (ph, rh, wh)
+      where mkHandle :: CInt -> IO Handle
+            mkHandle fd = (fdToHandle fd) `onException` (c__close fd)
+
+#else
+runWithPipes createProc prog opts = do
+    (rfd1, wfd1) <- Posix.createPipe -- we read on rfd1
+    (rfd2, wfd2) <- Posix.createPipe -- we write on wfd2
+    setFdOption rfd1 CloseOnExec True
+    setFdOption wfd2 CloseOnExec True
+    let args = show wfd1 : show rfd2 : opts
+    ph <- createProc (proc prog args)
+    closeFd wfd1
+    closeFd rfd2
+    rh <- fdToHandle rfd1
+    wh <- fdToHandle wfd2
+    return (ph, rh, wh)
+#endif
+
+-- -----------------------------------------------------------------------------
+{- Note [External GHCi pointers]
+
+We have the following ways to reference things in GHCi:
+
+HValue
+------
+
+HValue is a direct reference to a value in the local heap.  Obviously
+we cannot use this to refer to things in the external process.
+
+
+RemoteRef
+---------
+
+RemoteRef is a StablePtr to a heap-resident value.  When
+-fexternal-interpreter is used, this value resides in the external
+process's heap.  RemoteRefs are mostly used to send pointers in
+messages between GHC and iserv.
+
+A RemoteRef must be explicitly freed when no longer required, using
+freeHValueRefs, or by attaching a finalizer with mkForeignHValue.
+
+To get from a RemoteRef to an HValue you can use 'wormholeRef', which
+fails with an error message if -fexternal-interpreter is in use.
+
+ForeignRef
+----------
+
+A ForeignRef is a RemoteRef with a finalizer that will free the
+'RemoteRef' when it is garbage collected.  We mostly use ForeignHValue
+on the GHC side.
+
+The finalizer adds the RemoteRef to the iservPendingFrees list in the
+IServ record.  The next call to iservCmd will free any RemoteRefs in
+the list.  It was done this way rather than calling iservCmd directly,
+because I didn't want to have arbitrary threads calling iservCmd.  In
+principle it would probably be ok, but it seems less hairy this way.
+-}
+
+-- | Creates a 'ForeignRef' that will automatically release the
+-- 'RemoteRef' when it is no longer referenced.
+mkFinalizedHValue :: HscEnv -> RemoteRef a -> IO (ForeignRef a)
+mkFinalizedHValue HscEnv{..} rref = mkForeignRef rref free
+ where
+  !external = gopt Opt_ExternalInterpreter hsc_dflags
+  hvref = toHValueRef rref
+
+  free :: IO ()
+  free
+    | not external = freeRemoteRef hvref
+    | otherwise =
+      modifyMVar_ hsc_iserv $ \mb_iserv ->
+        case mb_iserv of
+          Nothing -> return Nothing -- already shut down
+          Just iserv@IServ{..} ->
+            return (Just iserv{iservPendingFrees = hvref : iservPendingFrees})
+
+freeHValueRefs :: HscEnv -> [HValueRef] -> IO ()
+freeHValueRefs _ [] = return ()
+freeHValueRefs hsc_env refs = iservCmd hsc_env (FreeHValueRefs refs)
+
+-- | Convert a 'ForeignRef' to the value it references directly.  This
+-- only works when the interpreter is running in the same process as
+-- the compiler, so it fails when @-fexternal-interpreter@ is on.
+wormhole :: DynFlags -> ForeignRef a -> IO a
+wormhole dflags r = wormholeRef dflags (unsafeForeignRefToRemoteRef r)
+
+-- | Convert an 'RemoteRef' to the value it references directly.  This
+-- only works when the interpreter is running in the same process as
+-- the compiler, so it fails when @-fexternal-interpreter@ is on.
+wormholeRef :: DynFlags -> RemoteRef a -> IO a
+wormholeRef dflags _r
+  | gopt Opt_ExternalInterpreter dflags
+  = throwIO (InstallationError
+      "this operation requires -fno-external-interpreter")
+#if defined(HAVE_INTERNAL_INTERPRETER)
+  | otherwise
+  = localRef _r
+#else
+  | otherwise
+  = throwIO (InstallationError
+      "can't wormhole a value in a stage1 compiler")
+#endif
+
+-- -----------------------------------------------------------------------------
+-- Misc utils
+
+mkEvalOpts :: DynFlags -> Bool -> EvalOpts
+mkEvalOpts dflags step =
+  EvalOpts
+    { useSandboxThread = gopt Opt_GhciSandbox dflags
+    , singleStep = step
+    , breakOnException = gopt Opt_BreakOnException dflags
+    , breakOnError = gopt Opt_BreakOnError dflags }
+
+fromEvalResult :: EvalResult a -> IO a
+fromEvalResult (EvalException e) = throwIO (fromSerializableException e)
+fromEvalResult (EvalSuccess a) = return a
diff --git a/compiler/GHC/Runtime/Linker.hs b/compiler/GHC/Runtime/Linker.hs
new file mode 100644
index 0000000000..fb409bd75b
--- /dev/null
+++ b/compiler/GHC/Runtime/Linker.hs
@@ -0,0 +1,1716 @@
+{-# LANGUAGE CPP, NondecreasingIndentation, TupleSections, RecordWildCards #-}
+{-# LANGUAGE BangPatterns #-}
+
+--
+--  (c) The University of Glasgow 2002-2006
+--
+-- | The dynamic linker for GHCi.
+--
+-- This module deals with the top-level issues of dynamic linking,
+-- calling the object-code linker and the byte-code linker where
+-- necessary.
+module GHC.Runtime.Linker
+   ( getHValue
+   , showLinkerState
+   , linkExpr
+   , linkDecls
+   , unload
+   , withExtendedLinkEnv
+   , extendLinkEnv
+   , deleteFromLinkEnv
+   , extendLoadedPkgs
+   , linkPackages
+   , initDynLinker
+   , linkModule
+   , linkCmdLineLibs
+   , uninitializedLinker
+   )
+where
+
+#include "HsVersions.h"
+
+import GhcPrelude
+
+import GHC.Runtime.Interpreter
+import GHCi.RemoteTypes
+import GHC.Iface.Load
+import GHC.ByteCode.Linker
+import GHC.ByteCode.Asm
+import GHC.ByteCode.Types
+import TcRnMonad
+import Packages
+import DriverPhases
+import Finder
+import HscTypes
+import Name
+import NameEnv
+import Module
+import ListSetOps
+import GHC.Runtime.Linker.Types (DynLinker(..), LinkerUnitId, PersistentLinkerState(..))
+import DynFlags
+import BasicTypes
+import Outputable
+import Panic
+import Util
+import ErrUtils
+import SrcLoc
+import qualified Maybes
+import UniqDSet
+import FastString
+import GHC.Platform
+import SysTools
+import FileCleanup
+
+-- Standard libraries
+import Control.Monad
+
+import Data.Char (isSpace)
+import Data.IORef
+import Data.List (intercalate, isPrefixOf, isSuffixOf, nub, partition)
+import Data.Maybe
+import Control.Concurrent.MVar
+
+import System.FilePath
+import System.Directory
+import System.IO.Unsafe
+import System.Environment (lookupEnv)
+
+#if defined(mingw32_HOST_OS)
+import System.Win32.Info (getSystemDirectory)
+#endif
+
+import Exception
+
+{- **********************************************************************
+
+                        The Linker's state
+
+  ********************************************************************* -}
+
+{-
+The persistent linker state *must* match the actual state of the
+C dynamic linker at all times.
+
+The MVar used to hold the PersistentLinkerState contains a Maybe
+PersistentLinkerState. The MVar serves to ensure mutual exclusion between
+multiple loaded copies of the GHC library. The Maybe may be Nothing to
+indicate that the linker has not yet been initialised.
+
+The PersistentLinkerState maps Names to actual closures (for
+interpreted code only), for use during linking.
+-}
+
+uninitializedLinker :: IO DynLinker
+uninitializedLinker =
+  newMVar Nothing >>= (pure . DynLinker)
+
+uninitialised :: a
+uninitialised = panic "Dynamic linker not initialised"
+
+modifyPLS_ :: DynLinker -> (PersistentLinkerState -> IO PersistentLinkerState) -> IO ()
+modifyPLS_ dl f =
+  modifyMVar_ (dl_mpls dl) (fmap pure . f . fromMaybe uninitialised)
+
+modifyPLS :: DynLinker -> (PersistentLinkerState -> IO (PersistentLinkerState, a)) -> IO a
+modifyPLS dl f =
+  modifyMVar (dl_mpls dl) (fmapFst pure . f . fromMaybe uninitialised)
+  where fmapFst f = fmap (\(x, y) -> (f x, y))
+
+readPLS :: DynLinker -> IO PersistentLinkerState
+readPLS dl =
+  (fmap (fromMaybe uninitialised) . readMVar) (dl_mpls dl)
+
+modifyMbPLS_
+  :: DynLinker -> (Maybe PersistentLinkerState -> IO (Maybe PersistentLinkerState)) -> IO ()
+modifyMbPLS_ dl f = modifyMVar_ (dl_mpls dl) f
+
+emptyPLS :: DynFlags -> PersistentLinkerState
+emptyPLS _ = PersistentLinkerState {
+                        closure_env = emptyNameEnv,
+                        itbl_env    = emptyNameEnv,
+                        pkgs_loaded = init_pkgs,
+                        bcos_loaded = [],
+                        objs_loaded = [],
+                        temp_sos = [] }
+
+  -- Packages that don't need loading, because the compiler
+  -- shares them with the interpreted program.
+  --
+  -- The linker's symbol table is populated with RTS symbols using an
+  -- explicit list.  See rts/Linker.c for details.
+  where init_pkgs = map toInstalledUnitId [rtsUnitId]
+
+extendLoadedPkgs :: DynLinker -> [InstalledUnitId] -> IO ()
+extendLoadedPkgs dl pkgs =
+  modifyPLS_ dl $ \s ->
+      return s{ pkgs_loaded = pkgs ++ pkgs_loaded s }
+
+extendLinkEnv :: DynLinker -> [(Name,ForeignHValue)] -> IO ()
+extendLinkEnv dl new_bindings =
+  modifyPLS_ dl $ \pls@PersistentLinkerState{..} -> do
+    let new_ce = extendClosureEnv closure_env new_bindings
+    return $! pls{ closure_env = new_ce }
+    -- strictness is important for not retaining old copies of the pls
+
+deleteFromLinkEnv :: DynLinker -> [Name] -> IO ()
+deleteFromLinkEnv dl to_remove =
+  modifyPLS_ dl $ \pls -> do
+    let ce = closure_env pls
+    let new_ce = delListFromNameEnv ce to_remove
+    return pls{ closure_env = new_ce }
+
+-- | Get the 'HValue' associated with the given name.
+--
+-- May cause loading the module that contains the name.
+--
+-- Throws a 'ProgramError' if loading fails or the name cannot be found.
+getHValue :: HscEnv -> Name -> IO ForeignHValue
+getHValue hsc_env name = do
+  let dl = hsc_dynLinker hsc_env
+  initDynLinker hsc_env
+  pls <- modifyPLS dl $ \pls -> do
+           if (isExternalName name) then do
+             (pls', ok) <- linkDependencies hsc_env pls noSrcSpan
+                              [nameModule name]
+             if (failed ok) then throwGhcExceptionIO (ProgramError "")
+                            else return (pls', pls')
+            else
+             return (pls, pls)
+  case lookupNameEnv (closure_env pls) name of
+    Just (_,aa) -> return aa
+    Nothing
+        -> ASSERT2(isExternalName name, ppr name)
+           do let sym_to_find = nameToCLabel name "closure"
+              m <- lookupClosure hsc_env (unpackFS sym_to_find)
+              case m of
+                Just hvref -> mkFinalizedHValue hsc_env hvref
+                Nothing -> linkFail "GHC.ByteCode.Linker.lookupCE"
+                             (unpackFS sym_to_find)
+
+linkDependencies :: HscEnv -> PersistentLinkerState
+                 -> SrcSpan -> [Module]
+                 -> IO (PersistentLinkerState, SuccessFlag)
+linkDependencies hsc_env pls span needed_mods = do
+--   initDynLinker (hsc_dflags hsc_env) dl
+   let hpt = hsc_HPT hsc_env
+       dflags = hsc_dflags hsc_env
+   -- The interpreter and dynamic linker can only handle object code built
+   -- the "normal" way, i.e. no non-std ways like profiling or ticky-ticky.
+   -- So here we check the build tag: if we're building a non-standard way
+   -- then we need to find & link object files built the "normal" way.
+   maybe_normal_osuf <- checkNonStdWay dflags span
+
+   -- Find what packages and linkables are required
+   (lnks, pkgs) <- getLinkDeps hsc_env hpt pls
+                               maybe_normal_osuf span needed_mods
+
+   -- Link the packages and modules required
+   pls1 <- linkPackages' hsc_env pkgs pls
+   linkModules hsc_env pls1 lnks
+
+
+-- | Temporarily extend the linker state.
+
+withExtendedLinkEnv :: (ExceptionMonad m) =>
+                       DynLinker -> [(Name,ForeignHValue)] -> m a -> m a
+withExtendedLinkEnv dl new_env action
+    = gbracket (liftIO $ extendLinkEnv dl new_env)
+               (\_ -> reset_old_env)
+               (\_ -> action)
+    where
+        -- Remember that the linker state might be side-effected
+        -- during the execution of the IO action, and we don't want to
+        -- lose those changes (we might have linked a new module or
+        -- package), so the reset action only removes the names we
+        -- added earlier.
+          reset_old_env = liftIO $ do
+            modifyPLS_ dl $ \pls ->
+                let cur = closure_env pls
+                    new = delListFromNameEnv cur (map fst new_env)
+                in return pls{ closure_env = new }
+
+
+-- | Display the persistent linker state.
+showLinkerState :: DynLinker -> DynFlags -> IO ()
+showLinkerState dl dflags
+  = do pls <- readPLS dl
+       putLogMsg dflags NoReason SevDump noSrcSpan
+          (defaultDumpStyle dflags)
+                 (vcat [text "----- Linker state -----",
+                        text "Pkgs:" <+> ppr (pkgs_loaded pls),
+                        text "Objs:" <+> ppr (objs_loaded pls),
+                        text "BCOs:" <+> ppr (bcos_loaded pls)])
+
+
+{- **********************************************************************
+
+                        Initialisation
+
+  ********************************************************************* -}
+
+-- | Initialise the dynamic linker.  This entails
+--
+--  a) Calling the C initialisation procedure,
+--
+--  b) Loading any packages specified on the command line,
+--
+--  c) Loading any packages specified on the command line, now held in the
+--     @-l@ options in @v_Opt_l@,
+--
+--  d) Loading any @.o\/.dll@ files specified on the command line, now held
+--     in @ldInputs@,
+--
+--  e) Loading any MacOS frameworks.
+--
+-- NOTE: This function is idempotent; if called more than once, it does
+-- nothing.  This is useful in Template Haskell, where we call it before
+-- trying to link.
+--
+initDynLinker :: HscEnv -> IO ()
+initDynLinker hsc_env = do
+  let dl = hsc_dynLinker hsc_env
+  modifyMbPLS_ dl $ \pls -> do
+    case pls of
+      Just  _ -> return pls
+      Nothing -> Just <$> reallyInitDynLinker hsc_env
+
+reallyInitDynLinker :: HscEnv -> IO PersistentLinkerState
+reallyInitDynLinker hsc_env = do
+  -- Initialise the linker state
+  let dflags = hsc_dflags hsc_env
+      pls0 = emptyPLS dflags
+
+  -- (a) initialise the C dynamic linker
+  initObjLinker hsc_env
+
+  -- (b) Load packages from the command-line (Note [preload packages])
+  pls <- linkPackages' hsc_env (preloadPackages (pkgState dflags)) pls0
+
+  -- steps (c), (d) and (e)
+  linkCmdLineLibs' hsc_env pls
+
+
+linkCmdLineLibs :: HscEnv -> IO ()
+linkCmdLineLibs hsc_env = do
+  let dl = hsc_dynLinker hsc_env
+  initDynLinker hsc_env
+  modifyPLS_ dl $ \pls -> do
+    linkCmdLineLibs' hsc_env pls
+
+linkCmdLineLibs' :: HscEnv -> PersistentLinkerState -> IO PersistentLinkerState
+linkCmdLineLibs' hsc_env pls =
+  do
+      let dflags@(DynFlags { ldInputs = cmdline_ld_inputs
+                           , libraryPaths = lib_paths_base})
+            = hsc_dflags hsc_env
+
+      -- (c) Link libraries from the command-line
+      let minus_ls_1 = [ lib | Option ('-':'l':lib) <- cmdline_ld_inputs ]
+
+      -- On Windows we want to add libpthread by default just as GCC would.
+      -- However because we don't know the actual name of pthread's dll we
+      -- need to defer this to the locateLib call so we can't initialize it
+      -- inside of the rts. Instead we do it here to be able to find the
+      -- import library for pthreads. See #13210.
+      let platform = targetPlatform dflags
+          os       = platformOS platform
+          minus_ls = case os of
+                       OSMinGW32 -> "pthread" : minus_ls_1
+                       _         -> minus_ls_1
+      -- See Note [Fork/Exec Windows]
+      gcc_paths <- getGCCPaths dflags os
+
+      lib_paths_env <- addEnvPaths "LIBRARY_PATH" lib_paths_base
+
+      maybePutStrLn dflags "Search directories (user):"
+      maybePutStr dflags (unlines $ map ("  "++) lib_paths_env)
+      maybePutStrLn dflags "Search directories (gcc):"
+      maybePutStr dflags (unlines $ map ("  "++) gcc_paths)
+
+      libspecs
+        <- mapM (locateLib hsc_env False lib_paths_env gcc_paths) minus_ls
+
+      -- (d) Link .o files from the command-line
+      classified_ld_inputs <- mapM (classifyLdInput dflags)
+                                [ f | FileOption _ f <- cmdline_ld_inputs ]
+
+      -- (e) Link any MacOS frameworks
+      let platform = targetPlatform dflags
+      let (framework_paths, frameworks) =
+            if platformUsesFrameworks platform
+             then (frameworkPaths dflags, cmdlineFrameworks dflags)
+              else ([],[])
+
+      -- Finally do (c),(d),(e)
+      let cmdline_lib_specs = catMaybes classified_ld_inputs
+                           ++ libspecs
+                           ++ map Framework frameworks
+      if null cmdline_lib_specs then return pls
+                                else do
+
+      -- Add directories to library search paths, this only has an effect
+      -- on Windows. On Unix OSes this function is a NOP.
+      let all_paths = let paths = takeDirectory (pgm_c dflags)
+                                : framework_paths
+                               ++ lib_paths_base
+                               ++ [ takeDirectory dll | DLLPath dll <- libspecs ]
+                      in nub $ map normalise paths
+      let lib_paths = nub $ lib_paths_base ++ gcc_paths
+      all_paths_env <- addEnvPaths "LD_LIBRARY_PATH" all_paths
+      pathCache <- mapM (addLibrarySearchPath hsc_env) all_paths_env
+
+      let merged_specs = mergeStaticObjects cmdline_lib_specs
+      pls1 <- foldM (preloadLib hsc_env lib_paths framework_paths) pls
+                    merged_specs
+
+      maybePutStr dflags "final link ... "
+      ok <- resolveObjs hsc_env
+
+      -- DLLs are loaded, reset the search paths
+      mapM_ (removeLibrarySearchPath hsc_env) $ reverse pathCache
+
+      if succeeded ok then maybePutStrLn dflags "done"
+      else throwGhcExceptionIO (ProgramError "linking extra libraries/objects failed")
+
+      return pls1
+
+-- | Merge runs of consecutive of 'Objects'. This allows for resolution of
+-- cyclic symbol references when dynamically linking. Specifically, we link
+-- together all of the static objects into a single shared object, avoiding
+-- the issue we saw in #13786.
+mergeStaticObjects :: [LibrarySpec] -> [LibrarySpec]
+mergeStaticObjects specs = go [] specs
+  where
+    go :: [FilePath] -> [LibrarySpec] -> [LibrarySpec]
+    go accum (Objects objs : rest) = go (objs ++ accum) rest
+    go accum@(_:_) rest = Objects (reverse accum) : go [] rest
+    go [] (spec:rest) = spec : go [] rest
+    go [] [] = []
+
+{- Note [preload packages]
+
+Why do we need to preload packages from the command line?  This is an
+explanation copied from #2437:
+
+I tried to implement the suggestion from #3560, thinking it would be
+easy, but there are two reasons we link in packages eagerly when they
+are mentioned on the command line:
+
+  * So that you can link in extra object files or libraries that
+    depend on the packages. e.g. ghc -package foo -lbar where bar is a
+    C library that depends on something in foo. So we could link in
+    foo eagerly if and only if there are extra C libs or objects to
+    link in, but....
+
+  * Haskell code can depend on a C function exported by a package, and
+    the normal dependency tracking that TH uses can't know about these
+    dependencies. The test ghcilink004 relies on this, for example.
+
+I conclude that we need two -package flags: one that says "this is a
+package I want to make available", and one that says "this is a
+package I want to link in eagerly". Would that be too complicated for
+users?
+-}
+
+classifyLdInput :: DynFlags -> FilePath -> IO (Maybe LibrarySpec)
+classifyLdInput dflags f
+  | isObjectFilename platform f = return (Just (Objects [f]))
+  | isDynLibFilename platform f = return (Just (DLLPath f))
+  | otherwise          = do
+        putLogMsg dflags NoReason SevInfo noSrcSpan
+            (defaultUserStyle dflags)
+            (text ("Warning: ignoring unrecognised input `" ++ f ++ "'"))
+        return Nothing
+    where platform = targetPlatform dflags
+
+preloadLib
+  :: HscEnv -> [String] -> [String] -> PersistentLinkerState
+  -> LibrarySpec -> IO PersistentLinkerState
+preloadLib hsc_env lib_paths framework_paths pls lib_spec = do
+  maybePutStr dflags ("Loading object " ++ showLS lib_spec ++ " ... ")
+  case lib_spec of
+    Objects static_ishs -> do
+      (b, pls1) <- preload_statics lib_paths static_ishs
+      maybePutStrLn dflags (if b  then "done" else "not found")
+      return pls1
+
+    Archive static_ish -> do
+      b <- preload_static_archive lib_paths static_ish
+      maybePutStrLn dflags (if b  then "done" else "not found")
+      return pls
+
+    DLL dll_unadorned -> do
+      maybe_errstr <- loadDLL hsc_env (mkSOName platform dll_unadorned)
+      case maybe_errstr of
+         Nothing -> maybePutStrLn dflags "done"
+         Just mm | platformOS platform /= OSDarwin ->
+           preloadFailed mm lib_paths lib_spec
+         Just mm | otherwise -> do
+           -- As a backup, on Darwin, try to also load a .so file
+           -- since (apparently) some things install that way - see
+           -- ticket #8770.
+           let libfile = ("lib" ++ dll_unadorned) <.> "so"
+           err2 <- loadDLL hsc_env libfile
+           case err2 of
+             Nothing -> maybePutStrLn dflags "done"
+             Just _  -> preloadFailed mm lib_paths lib_spec
+      return pls
+
+    DLLPath dll_path -> do
+      do maybe_errstr <- loadDLL hsc_env dll_path
+         case maybe_errstr of
+            Nothing -> maybePutStrLn dflags "done"
+            Just mm -> preloadFailed mm lib_paths lib_spec
+         return pls
+
+    Framework framework ->
+      if platformUsesFrameworks (targetPlatform dflags)
+      then do maybe_errstr <- loadFramework hsc_env framework_paths framework
+              case maybe_errstr of
+                 Nothing -> maybePutStrLn dflags "done"
+                 Just mm -> preloadFailed mm framework_paths lib_spec
+              return pls
+      else panic "preloadLib Framework"
+
+  where
+    dflags = hsc_dflags hsc_env
+
+    platform = targetPlatform dflags
+
+    preloadFailed :: String -> [String] -> LibrarySpec -> IO ()
+    preloadFailed sys_errmsg paths spec
+       = do maybePutStr dflags "failed.\n"
+            throwGhcExceptionIO $
+              CmdLineError (
+                    "user specified .o/.so/.DLL could not be loaded ("
+                    ++ sys_errmsg ++ ")\nWhilst trying to load:  "
+                    ++ showLS spec ++ "\nAdditional directories searched:"
+                    ++ (if null paths then " (none)" else
+                        intercalate "\n" (map ("   "++) paths)))
+
+    -- Not interested in the paths in the static case.
+    preload_statics _paths names
+       = do b <- or <$> mapM doesFileExist names
+            if not b then return (False, pls)
+                     else if dynamicGhc
+                             then  do pls1 <- dynLoadObjs hsc_env pls names
+                                      return (True, pls1)
+                             else  do mapM_ (loadObj hsc_env) names
+                                      return (True, pls)
+
+    preload_static_archive _paths name
+       = do b <- doesFileExist name
+            if not b then return False
+                     else do if dynamicGhc
+                                 then throwGhcExceptionIO $
+                                      CmdLineError dynamic_msg
+                                 else loadArchive hsc_env name
+                             return True
+      where
+        dynamic_msg = unlines
+          [ "User-specified static library could not be loaded ("
+            ++ name ++ ")"
+          , "Loading static libraries is not supported in this configuration."
+          , "Try using a dynamic library instead."
+          ]
+
+
+{- **********************************************************************
+
+                        Link a byte-code expression
+
+  ********************************************************************* -}
+
+-- | Link a single expression, /including/ first linking packages and
+-- modules that this expression depends on.
+--
+-- Raises an IO exception ('ProgramError') if it can't find a compiled
+-- version of the dependents to link.
+--
+linkExpr :: HscEnv -> SrcSpan -> UnlinkedBCO -> IO ForeignHValue
+linkExpr hsc_env span root_ul_bco
+  = do {
+     -- Initialise the linker (if it's not been done already)
+   ; initDynLinker hsc_env
+
+     -- Extract the DynLinker value for passing into required places
+   ; let dl = hsc_dynLinker hsc_env
+
+     -- Take lock for the actual work.
+   ; modifyPLS dl $ \pls0 -> do {
+
+     -- Link the packages and modules required
+   ; (pls, ok) <- linkDependencies hsc_env pls0 span needed_mods
+   ; if failed ok then
+        throwGhcExceptionIO (ProgramError "")
+     else do {
+
+     -- Link the expression itself
+     let ie = itbl_env pls
+         ce = closure_env pls
+
+     -- Link the necessary packages and linkables
+
+   ; let nobreakarray = error "no break array"
+         bco_ix = mkNameEnv [(unlinkedBCOName root_ul_bco, 0)]
+   ; resolved <- linkBCO hsc_env ie ce bco_ix nobreakarray root_ul_bco
+   ; [root_hvref] <- createBCOs hsc_env [resolved]
+   ; fhv <- mkFinalizedHValue hsc_env root_hvref
+   ; return (pls, fhv)
+   }}}
+   where
+     free_names = uniqDSetToList (bcoFreeNames root_ul_bco)
+
+     needed_mods :: [Module]
+     needed_mods = [ nameModule n | n <- free_names,
+                     isExternalName n,      -- Names from other modules
+                     not (isWiredInName n)  -- Exclude wired-in names
+                   ]                        -- (see note below)
+        -- Exclude wired-in names because we may not have read
+        -- their interface files, so getLinkDeps will fail
+        -- All wired-in names are in the base package, which we link
+        -- by default, so we can safely ignore them here.
+
+dieWith :: DynFlags -> SrcSpan -> MsgDoc -> IO a
+dieWith dflags span msg = throwGhcExceptionIO (ProgramError (showSDoc dflags (mkLocMessage SevFatal span msg)))
+
+
+checkNonStdWay :: DynFlags -> SrcSpan -> IO (Maybe FilePath)
+checkNonStdWay dflags srcspan
+  | gopt Opt_ExternalInterpreter dflags = return Nothing
+    -- with -fexternal-interpreter we load the .o files, whatever way
+    -- they were built.  If they were built for a non-std way, then
+    -- we will use the appropriate variant of the iserv binary to load them.
+
+  | interpWays == haskellWays = return Nothing
+    -- Only if we are compiling with the same ways as GHC is built
+    -- with, can we dynamically load those object files. (see #3604)
+
+  | objectSuf dflags == normalObjectSuffix && not (null haskellWays)
+  = failNonStd dflags srcspan
+
+  | otherwise = return (Just (interpTag ++ "o"))
+  where
+    haskellWays = filter (not . wayRTSOnly) (ways dflags)
+    interpTag = case mkBuildTag interpWays of
+                  "" -> ""
+                  tag -> tag ++ "_"
+
+normalObjectSuffix :: String
+normalObjectSuffix = phaseInputExt StopLn
+
+failNonStd :: DynFlags -> SrcSpan -> IO (Maybe FilePath)
+failNonStd dflags srcspan = dieWith dflags srcspan $
+  text "Cannot load" <+> compWay <+>
+     text "objects when GHC is built" <+> ghciWay $$
+  text "To fix this, either:" $$
+  text "  (1) Use -fexternal-interpreter, or" $$
+  text "  (2) Build the program twice: once" <+>
+                       ghciWay <> text ", and then" $$
+  text "      with" <+> compWay <+>
+     text "using -osuf to set a different object file suffix."
+    where compWay
+            | WayDyn `elem` ways dflags = text "-dynamic"
+            | WayProf `elem` ways dflags = text "-prof"
+            | otherwise = text "normal"
+          ghciWay
+            | dynamicGhc = text "with -dynamic"
+            | rtsIsProfiled = text "with -prof"
+            | otherwise = text "the normal way"
+
+getLinkDeps :: HscEnv -> HomePackageTable
+            -> PersistentLinkerState
+            -> Maybe FilePath                   -- replace object suffices?
+            -> SrcSpan                          -- for error messages
+            -> [Module]                         -- If you need these
+            -> IO ([Linkable], [InstalledUnitId])     -- ... then link these first
+-- Fails with an IO exception if it can't find enough files
+
+getLinkDeps hsc_env hpt pls replace_osuf span mods
+-- Find all the packages and linkables that a set of modules depends on
+ = do {
+        -- 1.  Find the dependent home-pkg-modules/packages from each iface
+        -- (omitting modules from the interactive package, which is already linked)
+      ; (mods_s, pkgs_s) <- follow_deps (filterOut isInteractiveModule mods)
+                                        emptyUniqDSet emptyUniqDSet;
+
+      ; let {
+        -- 2.  Exclude ones already linked
+        --      Main reason: avoid findModule calls in get_linkable
+            mods_needed = mods_s `minusList` linked_mods     ;
+            pkgs_needed = pkgs_s `minusList` pkgs_loaded pls ;
+
+            linked_mods = map (moduleName.linkableModule)
+                                (objs_loaded pls ++ bcos_loaded pls)  }
+
+        -- 3.  For each dependent module, find its linkable
+        --     This will either be in the HPT or (in the case of one-shot
+        --     compilation) we may need to use maybe_getFileLinkable
+      ; let { osuf = objectSuf dflags }
+      ; lnks_needed <- mapM (get_linkable osuf) mods_needed
+
+      ; return (lnks_needed, pkgs_needed) }
+  where
+    dflags = hsc_dflags hsc_env
+    this_pkg = thisPackage dflags
+
+        -- The ModIface contains the transitive closure of the module dependencies
+        -- within the current package, *except* for boot modules: if we encounter
+        -- a boot module, we have to find its real interface and discover the
+        -- dependencies of that.  Hence we need to traverse the dependency
+        -- tree recursively.  See bug #936, testcase ghci/prog007.
+    follow_deps :: [Module]             -- modules to follow
+                -> UniqDSet ModuleName         -- accum. module dependencies
+                -> UniqDSet InstalledUnitId          -- accum. package dependencies
+                -> IO ([ModuleName], [InstalledUnitId]) -- result
+    follow_deps []     acc_mods acc_pkgs
+        = return (uniqDSetToList acc_mods, uniqDSetToList acc_pkgs)
+    follow_deps (mod:mods) acc_mods acc_pkgs
+        = do
+          mb_iface <- initIfaceCheck (text "getLinkDeps") hsc_env $
+                        loadInterface msg mod (ImportByUser False)
+          iface <- case mb_iface of
+                    Maybes.Failed err      -> throwGhcExceptionIO (ProgramError (showSDoc dflags err))
+                    Maybes.Succeeded iface -> return iface
+
+          when (mi_boot iface) $ link_boot_mod_error mod
+
+          let
+            pkg = moduleUnitId mod
+            deps  = mi_deps iface
+
+            pkg_deps = dep_pkgs deps
+            (boot_deps, mod_deps) = partitionWith is_boot (dep_mods deps)
+                    where is_boot (m,True)  = Left m
+                          is_boot (m,False) = Right m
+
+            boot_deps' = filter (not . (`elementOfUniqDSet` acc_mods)) boot_deps
+            acc_mods'  = addListToUniqDSet acc_mods (moduleName mod : mod_deps)
+            acc_pkgs'  = addListToUniqDSet acc_pkgs $ map fst pkg_deps
+          --
+          if pkg /= this_pkg
+             then follow_deps mods acc_mods (addOneToUniqDSet acc_pkgs' (toInstalledUnitId pkg))
+             else follow_deps (map (mkModule this_pkg) boot_deps' ++ mods)
+                              acc_mods' acc_pkgs'
+        where
+            msg = text "need to link module" <+> ppr mod <+>
+                  text "due to use of Template Haskell"
+
+
+    link_boot_mod_error mod =
+        throwGhcExceptionIO (ProgramError (showSDoc dflags (
+            text "module" <+> ppr mod <+>
+            text "cannot be linked; it is only available as a boot module")))
+
+    no_obj :: Outputable a => a -> IO b
+    no_obj mod = dieWith dflags span $
+                     text "cannot find object file for module " <>
+                        quotes (ppr mod) $$
+                     while_linking_expr
+
+    while_linking_expr = text "while linking an interpreted expression"
+
+        -- This one is a build-system bug
+
+    get_linkable osuf mod_name      -- A home-package module
+        | Just mod_info <- lookupHpt hpt mod_name
+        = adjust_linkable (Maybes.expectJust "getLinkDeps" (hm_linkable mod_info))
+        | otherwise
+        = do    -- It's not in the HPT because we are in one shot mode,
+                -- so use the Finder to get a ModLocation...
+             mb_stuff <- findHomeModule hsc_env mod_name
+             case mb_stuff of
+                  Found loc mod -> found loc mod
+                  _ -> no_obj mod_name
+        where
+            found loc mod = do {
+                -- ...and then find the linkable for it
+               mb_lnk <- findObjectLinkableMaybe mod loc ;
+               case mb_lnk of {
+                  Nothing  -> no_obj mod ;
+                  Just lnk -> adjust_linkable lnk
+              }}
+
+            adjust_linkable lnk
+                | Just new_osuf <- replace_osuf = do
+                        new_uls <- mapM (adjust_ul new_osuf)
+                                        (linkableUnlinked lnk)
+                        return lnk{ linkableUnlinked=new_uls }
+                | otherwise =
+                        return lnk
+
+            adjust_ul new_osuf (DotO file) = do
+                MASSERT(osuf `isSuffixOf` file)
+                let file_base = fromJust (stripExtension osuf file)
+                    new_file = file_base <.> new_osuf
+                ok <- doesFileExist new_file
+                if (not ok)
+                   then dieWith dflags span $
+                          text "cannot find object file "
+                                <> quotes (text new_file) $$ while_linking_expr
+                   else return (DotO new_file)
+            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
+
+
+
+{- **********************************************************************
+
+              Loading a Decls statement
+
+  ********************************************************************* -}
+
+linkDecls :: HscEnv -> SrcSpan -> CompiledByteCode -> IO ()
+linkDecls hsc_env span cbc@CompiledByteCode{..} = do
+    -- Initialise the linker (if it's not been done already)
+    initDynLinker hsc_env
+
+    -- Extract the DynLinker for passing into required places
+    let dl = hsc_dynLinker hsc_env
+
+    -- Take lock for the actual work.
+    modifyPLS dl $ \pls0 -> do
+
+    -- Link the packages and modules required
+    (pls, ok) <- linkDependencies hsc_env pls0 span needed_mods
+    if failed ok
+      then throwGhcExceptionIO (ProgramError "")
+      else do
+
+    -- Link the expression itself
+    let ie = plusNameEnv (itbl_env pls) bc_itbls
+        ce = closure_env pls
+
+    -- Link the necessary packages and linkables
+    new_bindings <- linkSomeBCOs hsc_env ie ce [cbc]
+    nms_fhvs <- makeForeignNamedHValueRefs hsc_env new_bindings
+    let pls2 = pls { closure_env = extendClosureEnv ce nms_fhvs
+                   , itbl_env    = ie }
+    return (pls2, ())
+  where
+    free_names = uniqDSetToList $
+      foldr (unionUniqDSets . bcoFreeNames) emptyUniqDSet bc_bcos
+
+    needed_mods :: [Module]
+    needed_mods = [ nameModule n | n <- free_names,
+                    isExternalName n,       -- Names from other modules
+                    not (isWiredInName n)   -- Exclude wired-in names
+                  ]                         -- (see note below)
+    -- Exclude wired-in names because we may not have read
+    -- their interface files, so getLinkDeps will fail
+    -- All wired-in names are in the base package, which we link
+    -- by default, so we can safely ignore them here.
+
+{- **********************************************************************
+
+              Loading a single module
+
+  ********************************************************************* -}
+
+linkModule :: HscEnv -> Module -> IO ()
+linkModule hsc_env mod = do
+  initDynLinker hsc_env
+  let dl = hsc_dynLinker hsc_env
+  modifyPLS_ dl $ \pls -> do
+    (pls', ok) <- linkDependencies hsc_env pls noSrcSpan [mod]
+    if (failed ok) then throwGhcExceptionIO (ProgramError "could not link module")
+      else return pls'
+
+{- **********************************************************************
+
+                Link some linkables
+        The linkables may consist of a mixture of
+        byte-code modules and object modules
+
+  ********************************************************************* -}
+
+linkModules :: HscEnv -> PersistentLinkerState -> [Linkable]
+            -> IO (PersistentLinkerState, SuccessFlag)
+linkModules hsc_env pls linkables
+  = mask_ $ do  -- don't want to be interrupted by ^C in here
+
+        let (objs, bcos) = partition isObjectLinkable
+                              (concatMap partitionLinkable linkables)
+
+                -- Load objects first; they can't depend on BCOs
+        (pls1, ok_flag) <- dynLinkObjs hsc_env pls objs
+
+        if failed ok_flag then
+                return (pls1, Failed)
+          else do
+                pls2 <- dynLinkBCOs hsc_env pls1 bcos
+                return (pls2, Succeeded)
+
+
+-- HACK to support f-x-dynamic in the interpreter; no other purpose
+partitionLinkable :: Linkable -> [Linkable]
+partitionLinkable li
+   = let li_uls = linkableUnlinked li
+         li_uls_obj = filter isObject li_uls
+         li_uls_bco = filter isInterpretable li_uls
+     in
+         case (li_uls_obj, li_uls_bco) of
+            (_:_, _:_) -> [li {linkableUnlinked=li_uls_obj},
+                           li {linkableUnlinked=li_uls_bco}]
+            _ -> [li]
+
+findModuleLinkable_maybe :: [Linkable] -> Module -> Maybe Linkable
+findModuleLinkable_maybe lis mod
+   = case [LM time nm us | LM time nm us <- lis, nm == mod] of
+        []   -> Nothing
+        [li] -> Just li
+        _    -> pprPanic "findModuleLinkable" (ppr mod)
+
+linkableInSet :: Linkable -> [Linkable] -> Bool
+linkableInSet l objs_loaded =
+  case findModuleLinkable_maybe objs_loaded (linkableModule l) of
+        Nothing -> False
+        Just m  -> linkableTime l == linkableTime m
+
+
+{- **********************************************************************
+
+                The object-code linker
+
+  ********************************************************************* -}
+
+dynLinkObjs :: HscEnv -> PersistentLinkerState -> [Linkable]
+            -> IO (PersistentLinkerState, SuccessFlag)
+dynLinkObjs hsc_env pls objs = do
+        -- Load the object files and link them
+        let (objs_loaded', new_objs) = rmDupLinkables (objs_loaded pls) objs
+            pls1                     = pls { objs_loaded = objs_loaded' }
+            unlinkeds                = concatMap linkableUnlinked new_objs
+            wanted_objs              = map nameOfObject unlinkeds
+
+        if interpreterDynamic (hsc_dflags hsc_env)
+            then do pls2 <- dynLoadObjs hsc_env pls1 wanted_objs
+                    return (pls2, Succeeded)
+            else do mapM_ (loadObj hsc_env) wanted_objs
+
+                    -- Link them all together
+                    ok <- resolveObjs hsc_env
+
+                    -- If resolving failed, unload all our
+                    -- object modules and carry on
+                    if succeeded ok then do
+                            return (pls1, Succeeded)
+                      else do
+                            pls2 <- unload_wkr hsc_env [] pls1
+                            return (pls2, Failed)
+
+
+dynLoadObjs :: HscEnv -> PersistentLinkerState -> [FilePath]
+            -> IO PersistentLinkerState
+dynLoadObjs _       pls                           []   = return pls
+dynLoadObjs hsc_env pls@PersistentLinkerState{..} objs = do
+    let dflags = hsc_dflags hsc_env
+    let platform = targetPlatform dflags
+    let minus_ls = [ lib | Option ('-':'l':lib) <- ldInputs dflags ]
+    let minus_big_ls = [ lib | Option ('-':'L':lib) <- ldInputs dflags ]
+    (soFile, libPath , libName) <-
+      newTempLibName dflags TFL_CurrentModule (soExt platform)
+    let
+        dflags2 = dflags {
+                      -- We don't want the original ldInputs in
+                      -- (they're already linked in), but we do want
+                      -- to link against previous dynLoadObjs
+                      -- libraries if there were any, so that the linker
+                      -- can resolve dependencies when it loads this
+                      -- library.
+                      ldInputs =
+                           concatMap (\l -> [ Option ("-l" ++ l) ])
+                                     (nub $ snd <$> temp_sos)
+                        ++ concatMap (\lp -> [ Option ("-L" ++ lp)
+                                                    , Option "-Xlinker"
+                                                    , Option "-rpath"
+                                                    , Option "-Xlinker"
+                                                    , Option lp ])
+                                     (nub $ fst <$> temp_sos)
+                        ++ concatMap
+                             (\lp ->
+                                 [ Option ("-L" ++ lp)
+                                 , Option "-Xlinker"
+                                 , Option "-rpath"
+                                 , Option "-Xlinker"
+                                 , Option lp
+                                 ])
+                             minus_big_ls
+                        -- See Note [-Xlinker -rpath vs -Wl,-rpath]
+                        ++ map (\l -> Option ("-l" ++ l)) minus_ls,
+                      -- Add -l options and -L options from dflags.
+                      --
+                      -- When running TH for a non-dynamic way, we still
+                      -- need to make -l flags to link against the dynamic
+                      -- libraries, so we need to add WayDyn to ways.
+                      --
+                      -- Even if we're e.g. profiling, we still want
+                      -- the vanilla dynamic libraries, so we set the
+                      -- ways / build tag to be just WayDyn.
+                      ways = [WayDyn],
+                      buildTag = mkBuildTag [WayDyn],
+                      outputFile = Just soFile
+                  }
+    -- link all "loaded packages" so symbols in those can be resolved
+    -- Note: We are loading packages with local scope, so to see the
+    -- symbols in this link we must link all loaded packages again.
+    linkDynLib dflags2 objs pkgs_loaded
+
+    -- if we got this far, extend the lifetime of the library file
+    changeTempFilesLifetime dflags TFL_GhcSession [soFile]
+    m <- loadDLL hsc_env soFile
+    case m of
+        Nothing -> return $! pls { temp_sos = (libPath, libName) : temp_sos }
+        Just err -> panic ("Loading temp shared object failed: " ++ err)
+
+rmDupLinkables :: [Linkable]    -- Already loaded
+               -> [Linkable]    -- New linkables
+               -> ([Linkable],  -- New loaded set (including new ones)
+                   [Linkable])  -- New linkables (excluding dups)
+rmDupLinkables already ls
+  = go already [] ls
+  where
+    go already extras [] = (already, extras)
+    go already extras (l:ls)
+        | linkableInSet l already = go already     extras     ls
+        | otherwise               = go (l:already) (l:extras) ls
+
+{- **********************************************************************
+
+                The byte-code linker
+
+  ********************************************************************* -}
+
+
+dynLinkBCOs :: HscEnv -> PersistentLinkerState -> [Linkable]
+            -> IO PersistentLinkerState
+dynLinkBCOs hsc_env pls bcos = do
+
+        let (bcos_loaded', new_bcos) = rmDupLinkables (bcos_loaded pls) bcos
+            pls1                     = pls { bcos_loaded = bcos_loaded' }
+            unlinkeds :: [Unlinked]
+            unlinkeds                = concatMap linkableUnlinked new_bcos
+
+            cbcs :: [CompiledByteCode]
+            cbcs      = map byteCodeOfObject unlinkeds
+
+
+            ies        = map bc_itbls cbcs
+            gce       = closure_env pls
+            final_ie  = foldr plusNameEnv (itbl_env pls) ies
+
+        names_and_refs <- linkSomeBCOs hsc_env final_ie gce cbcs
+
+        -- We only want to add the external ones to the ClosureEnv
+        let (to_add, to_drop) = partition (isExternalName.fst) names_and_refs
+
+        -- Immediately release any HValueRefs we're not going to add
+        freeHValueRefs hsc_env (map snd to_drop)
+        -- Wrap finalizers on the ones we want to keep
+        new_binds <- makeForeignNamedHValueRefs hsc_env to_add
+
+        return pls1 { closure_env = extendClosureEnv gce new_binds,
+                      itbl_env    = final_ie }
+
+-- Link a bunch of BCOs and return references to their values
+linkSomeBCOs :: HscEnv
+             -> ItblEnv
+             -> ClosureEnv
+             -> [CompiledByteCode]
+             -> IO [(Name,HValueRef)]
+                        -- The returned HValueRefs are associated 1-1 with
+                        -- the incoming unlinked BCOs.  Each gives the
+                        -- value of the corresponding unlinked BCO
+
+linkSomeBCOs hsc_env ie ce mods = foldr fun do_link mods []
+ where
+  fun CompiledByteCode{..} inner accum =
+    case bc_breaks of
+      Nothing -> inner ((panic "linkSomeBCOs: no break array", bc_bcos) : accum)
+      Just mb -> withForeignRef (modBreaks_flags mb) $ \breakarray ->
+                   inner ((breakarray, bc_bcos) : accum)
+
+  do_link [] = return []
+  do_link mods = do
+    let flat = [ (breakarray, bco) | (breakarray, bcos) <- mods, bco <- bcos ]
+        names = map (unlinkedBCOName . snd) flat
+        bco_ix = mkNameEnv (zip names [0..])
+    resolved <- sequence [ linkBCO hsc_env ie ce bco_ix breakarray bco
+                         | (breakarray, bco) <- flat ]
+    hvrefs <- createBCOs hsc_env resolved
+    return (zip names hvrefs)
+
+-- | Useful to apply to the result of 'linkSomeBCOs'
+makeForeignNamedHValueRefs
+  :: HscEnv -> [(Name,HValueRef)] -> IO [(Name,ForeignHValue)]
+makeForeignNamedHValueRefs hsc_env bindings =
+  mapM (\(n, hvref) -> (n,) <$> mkFinalizedHValue hsc_env hvref) bindings
+
+{- **********************************************************************
+
+                Unload some object modules
+
+  ********************************************************************* -}
+
+-- ---------------------------------------------------------------------------
+-- | Unloading old objects ready for a new compilation sweep.
+--
+-- The compilation manager provides us with a list of linkables that it
+-- considers \"stable\", i.e. won't be recompiled this time around.  For
+-- each of the modules current linked in memory,
+--
+--   * if the linkable is stable (and it's the same one -- the user may have
+--     recompiled the module on the side), we keep it,
+--
+--   * otherwise, we unload it.
+--
+--   * we also implicitly unload all temporary bindings at this point.
+--
+unload :: HscEnv
+       -> [Linkable] -- ^ The linkables to *keep*.
+       -> IO ()
+unload hsc_env linkables
+  = mask_ $ do -- mask, so we're safe from Ctrl-C in here
+
+        -- Initialise the linker (if it's not been done already)
+        initDynLinker hsc_env
+
+        -- Extract DynLinker for passing into required places
+        let dl = hsc_dynLinker hsc_env
+
+        new_pls
+            <- modifyPLS dl $ \pls -> do
+                 pls1 <- unload_wkr hsc_env linkables pls
+                 return (pls1, pls1)
+
+        let dflags = hsc_dflags hsc_env
+        debugTraceMsg dflags 3 $
+          text "unload: retaining objs" <+> ppr (objs_loaded new_pls)
+        debugTraceMsg dflags 3 $
+          text "unload: retaining bcos" <+> ppr (bcos_loaded new_pls)
+        return ()
+
+unload_wkr :: HscEnv
+           -> [Linkable]                -- stable linkables
+           -> PersistentLinkerState
+           -> IO PersistentLinkerState
+-- Does the core unload business
+-- (the wrapper blocks exceptions and deals with the PLS get and put)
+
+unload_wkr hsc_env keep_linkables pls@PersistentLinkerState{..}  = do
+  -- NB. careful strictness here to avoid keeping the old PLS when
+  -- we're unloading some code.  -fghci-leak-check with the tests in
+  -- testsuite/ghci can detect space leaks here.
+
+  let (objs_to_keep, bcos_to_keep) = partition isObjectLinkable keep_linkables
+
+      discard keep l = not (linkableInSet l keep)
+
+      (objs_to_unload, remaining_objs_loaded) =
+         partition (discard objs_to_keep) objs_loaded
+      (bcos_to_unload, remaining_bcos_loaded) =
+         partition (discard bcos_to_keep) bcos_loaded
+
+  mapM_ unloadObjs objs_to_unload
+  mapM_ unloadObjs bcos_to_unload
+
+  -- If we unloaded any object files at all, we need to purge the cache
+  -- of lookupSymbol results.
+  when (not (null (objs_to_unload ++
+                   filter (not . null . linkableObjs) bcos_to_unload))) $
+    purgeLookupSymbolCache hsc_env
+
+  let !bcos_retained = mkModuleSet $ map linkableModule remaining_bcos_loaded
+
+      -- Note that we want to remove all *local*
+      -- (i.e. non-isExternal) names too (these are the
+      -- temporary bindings from the command line).
+      keep_name (n,_) = isExternalName n &&
+                        nameModule n `elemModuleSet` bcos_retained
+
+      itbl_env'     = filterNameEnv keep_name itbl_env
+      closure_env'  = filterNameEnv keep_name closure_env
+
+      !new_pls = pls { itbl_env = itbl_env',
+                       closure_env = closure_env',
+                       bcos_loaded = remaining_bcos_loaded,
+                       objs_loaded = remaining_objs_loaded }
+
+  return new_pls
+  where
+    unloadObjs :: Linkable -> IO ()
+    unloadObjs lnk
+      | dynamicGhc = return ()
+        -- We don't do any cleanup when linking objects with the
+        -- dynamic linker.  Doing so introduces extra complexity for
+        -- not much benefit.
+
+      -- Code unloading currently disabled due to instability.
+      -- See #16841.
+      -- id False, so that the pattern-match checker doesn't complain
+      | id False -- otherwise
+      = mapM_ (unloadObj hsc_env) [f | DotO f <- linkableUnlinked lnk]
+                -- The components of a BCO linkable may contain
+                -- dot-o files.  Which is very confusing.
+                --
+                -- But the BCO parts can be unlinked just by
+                -- letting go of them (plus of course depopulating
+                -- the symbol table which is done in the main body)
+      | otherwise = return () -- see #16841
+
+{- **********************************************************************
+
+                Loading packages
+
+  ********************************************************************* -}
+
+data LibrarySpec
+   = Objects [FilePath] -- Full path names of set of .o files, including trailing .o
+                        -- We allow batched loading to ensure that cyclic symbol
+                        -- references can be resolved (see #13786).
+                        -- For dynamic objects only, try to find the object
+                        -- file in all the directories specified in
+                        -- v_Library_paths before giving up.
+
+   | Archive FilePath   -- Full path name of a .a file, including trailing .a
+
+   | DLL String         -- "Unadorned" name of a .DLL/.so
+                        --  e.g.    On unix     "qt"  denotes "libqt.so"
+                        --          On Windows  "burble"  denotes "burble.DLL" or "libburble.dll"
+                        --  loadDLL is platform-specific and adds the lib/.so/.DLL
+                        --  suffixes platform-dependently
+
+   | DLLPath FilePath   -- Absolute or relative pathname to a dynamic library
+                        -- (ends with .dll or .so).
+
+   | Framework String   -- Only used for darwin, but does no harm
+
+instance Outputable LibrarySpec where
+  ppr (Objects objs) = text "Objects" <+> ppr objs
+  ppr (Archive a) = text "Archive" <+> text a
+  ppr (DLL s) = text "DLL" <+> text s
+  ppr (DLLPath f) = text "DLLPath" <+> text f
+  ppr (Framework s) = text "Framework" <+> text s
+
+-- If this package is already part of the GHCi binary, we'll already
+-- have the right DLLs for this package loaded, so don't try to
+-- load them again.
+--
+-- But on Win32 we must load them 'again'; doing so is a harmless no-op
+-- as far as the loader is concerned, but it does initialise the list
+-- of DLL handles that rts/Linker.c maintains, and that in turn is
+-- used by lookupSymbol.  So we must call addDLL for each library
+-- just to get the DLL handle into the list.
+partOfGHCi :: [PackageName]
+partOfGHCi
+ | isWindowsHost || isDarwinHost = []
+ | otherwise = map (PackageName . mkFastString)
+                   ["base", "template-haskell", "editline"]
+
+showLS :: LibrarySpec -> String
+showLS (Objects nms)  = "(static) [" ++ intercalate ", " nms ++ "]"
+showLS (Archive nm)   = "(static archive) " ++ nm
+showLS (DLL nm)       = "(dynamic) " ++ nm
+showLS (DLLPath nm)   = "(dynamic) " ++ nm
+showLS (Framework nm) = "(framework) " ++ nm
+
+-- | Link exactly the specified packages, and their dependents (unless of
+-- course they are already linked).  The dependents are linked
+-- automatically, and it doesn't matter what order you specify the input
+-- packages.
+--
+linkPackages :: HscEnv -> [LinkerUnitId] -> IO ()
+-- NOTE: in fact, since each module tracks all the packages it depends on,
+--       we don't really need to use the package-config dependencies.
+--
+-- However we do need the package-config stuff (to find aux libs etc),
+-- and following them lets us load libraries in the right order, which
+-- perhaps makes the error message a bit more localised if we get a link
+-- failure.  So the dependency walking code is still here.
+
+linkPackages hsc_env new_pkgs = do
+  -- It's probably not safe to try to load packages concurrently, so we take
+  -- a lock.
+  initDynLinker hsc_env
+  let dl = hsc_dynLinker hsc_env
+  modifyPLS_ dl $ \pls -> do
+    linkPackages' hsc_env new_pkgs pls
+
+linkPackages' :: HscEnv -> [LinkerUnitId] -> PersistentLinkerState
+             -> IO PersistentLinkerState
+linkPackages' hsc_env new_pks pls = do
+    pkgs' <- link (pkgs_loaded pls) new_pks
+    return $! pls { pkgs_loaded = pkgs' }
+  where
+     dflags = hsc_dflags hsc_env
+
+     link :: [LinkerUnitId] -> [LinkerUnitId] -> IO [LinkerUnitId]
+     link pkgs new_pkgs =
+         foldM link_one pkgs new_pkgs
+
+     link_one pkgs new_pkg
+        | new_pkg `elem` pkgs   -- Already linked
+        = return pkgs
+
+        | Just pkg_cfg <- lookupInstalledPackage dflags new_pkg
+        = do {  -- Link dependents first
+               pkgs' <- link pkgs (depends pkg_cfg)
+                -- Now link the package itself
+             ; linkPackage hsc_env pkg_cfg
+             ; return (new_pkg : pkgs') }
+
+        | otherwise
+        = throwGhcExceptionIO (CmdLineError ("unknown package: " ++ unpackFS (installedUnitIdFS new_pkg)))
+
+
+linkPackage :: HscEnv -> UnitInfo -> IO ()
+linkPackage hsc_env pkg
+   = do
+        let dflags    = hsc_dflags hsc_env
+            platform  = targetPlatform dflags
+            is_dyn = interpreterDynamic dflags
+            dirs | is_dyn    = Packages.libraryDynDirs pkg
+                 | otherwise = Packages.libraryDirs pkg
+
+        let hs_libs   =  Packages.hsLibraries pkg
+            -- The FFI GHCi import lib isn't needed as
+            -- compiler/ghci/Linker.hs + rts/Linker.c link the
+            -- interpreted references to FFI to the compiled FFI.
+            -- We therefore filter it out so that we don't get
+            -- duplicate symbol errors.
+            hs_libs'  =  filter ("HSffi" /=) hs_libs
+
+        -- Because of slight differences between the GHC dynamic linker and
+        -- the native system linker some packages have to link with a
+        -- different list of libraries when using GHCi. Examples include: libs
+        -- that are actually gnu ld scripts, and the possibility that the .a
+        -- libs do not exactly match the .so/.dll equivalents. So if the
+        -- package file provides an "extra-ghci-libraries" field then we use
+        -- that instead of the "extra-libraries" field.
+            extra_libs =
+                      (if null (Packages.extraGHCiLibraries pkg)
+                            then Packages.extraLibraries pkg
+                            else Packages.extraGHCiLibraries pkg)
+                      ++ [ lib | '-':'l':lib <- Packages.ldOptions pkg ]
+        -- See Note [Fork/Exec Windows]
+        gcc_paths <- getGCCPaths dflags (platformOS platform)
+        dirs_env <- addEnvPaths "LIBRARY_PATH" dirs
+
+        hs_classifieds
+           <- mapM (locateLib hsc_env True  dirs_env gcc_paths) hs_libs'
+        extra_classifieds
+           <- mapM (locateLib hsc_env False dirs_env gcc_paths) extra_libs
+        let classifieds = hs_classifieds ++ extra_classifieds
+
+        -- Complication: all the .so's must be loaded before any of the .o's.
+        let known_dlls = [ dll  | DLLPath dll    <- classifieds ]
+            dlls       = [ dll  | DLL dll        <- classifieds ]
+            objs       = [ obj  | Objects objs    <- classifieds
+                                , obj <- objs ]
+            archs      = [ arch | Archive arch   <- classifieds ]
+
+        -- Add directories to library search paths
+        let dll_paths  = map takeDirectory known_dlls
+            all_paths  = nub $ map normalise $ dll_paths ++ dirs
+        all_paths_env <- addEnvPaths "LD_LIBRARY_PATH" all_paths
+        pathCache <- mapM (addLibrarySearchPath hsc_env) all_paths_env
+
+        maybePutStr dflags
+            ("Loading package " ++ sourcePackageIdString pkg ++ " ... ")
+
+        -- See comments with partOfGHCi
+        when (packageName pkg `notElem` partOfGHCi) $ do
+            loadFrameworks hsc_env platform pkg
+            -- See Note [Crash early load_dyn and locateLib]
+            -- Crash early if can't load any of `known_dlls`
+            mapM_ (load_dyn hsc_env True) known_dlls
+            -- For remaining `dlls` crash early only when there is surely
+            -- no package's DLL around ... (not is_dyn)
+            mapM_ (load_dyn hsc_env (not is_dyn) . mkSOName platform) dlls
+
+        -- After loading all the DLLs, we can load the static objects.
+        -- Ordering isn't important here, because we do one final link
+        -- step to resolve everything.
+        mapM_ (loadObj hsc_env) objs
+        mapM_ (loadArchive hsc_env) archs
+
+        maybePutStr dflags "linking ... "
+        ok <- resolveObjs hsc_env
+
+        -- DLLs are loaded, reset the search paths
+        -- Import libraries will be loaded via loadArchive so only
+        -- reset the DLL search path after all archives are loaded
+        -- as well.
+        mapM_ (removeLibrarySearchPath hsc_env) $ reverse pathCache
+
+        if succeeded ok
+           then maybePutStrLn dflags "done."
+           else let errmsg = "unable to load package `"
+                             ++ sourcePackageIdString pkg ++ "'"
+                 in throwGhcExceptionIO (InstallationError errmsg)
+
+{-
+Note [Crash early load_dyn and locateLib]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+If a package is "normal" (exposes it's code from more than zero Haskell
+modules, unlike e.g. that in ghcilink004) and is built "dyn" way, then
+it has it's code compiled and linked into the DLL, which GHCi linker picks
+when loading the package's code (see the big comment in the beginning of
+`locateLib`).
+
+When loading DLLs, GHCi linker simply calls the system's `dlopen` or
+`LoadLibrary` APIs. This is quite different from the case when GHCi linker
+loads an object file or static library. When loading an object file or static
+library GHCi linker parses them and resolves all symbols "manually".
+These object file or static library may reference some external symbols
+defined in some external DLLs. And GHCi should know which these
+external DLLs are.
+
+But when GHCi loads a DLL, it's the *system* linker who manages all
+the necessary dependencies, and it is able to load this DLL not having
+any extra info. Thus we don't *have to* crash in this case even if we
+are unable to load any supposed dependencies explicitly.
+
+Suppose during GHCi session a client of the package wants to
+`foreign import` a symbol which isn't exposed by the package DLL, but
+is exposed by such an external (dependency) DLL.
+If the DLL isn't *explicitly* loaded because `load_dyn` failed to do
+this, then the client code eventually crashes because the GHCi linker
+isn't able to locate this symbol (GHCi linker maintains a list of
+explicitly loaded DLLs it looks into when trying to find a symbol).
+
+This is why we still should try to load all the dependency DLLs
+even though we know that the system linker loads them implicitly when
+loading the package DLL.
+
+Why we still keep the `crash_early` opportunity then not allowing such
+a permissive behaviour for any DLLs? Well, we, perhaps, improve a user
+experience in some cases slightly.
+
+But if it happens there exist other corner cases where our current
+usage of `crash_early` flag is overly restrictive, we may lift the
+restriction very easily.
+-}
+
+-- we have already searched the filesystem; the strings passed to load_dyn
+-- can be passed directly to loadDLL.  They are either fully-qualified
+-- ("/usr/lib/libfoo.so"), or unqualified ("libfoo.so").  In the latter case,
+-- loadDLL is going to search the system paths to find the library.
+load_dyn :: HscEnv -> Bool -> FilePath -> IO ()
+load_dyn hsc_env crash_early dll = do
+  r <- loadDLL hsc_env dll
+  case r of
+    Nothing  -> return ()
+    Just err ->
+      if crash_early
+        then cmdLineErrorIO err
+        else let dflags = hsc_dflags hsc_env in
+          when (wopt Opt_WarnMissedExtraSharedLib dflags)
+            $ putLogMsg dflags
+                (Reason Opt_WarnMissedExtraSharedLib) SevWarning
+                  noSrcSpan (defaultUserStyle dflags)(note err)
+  where
+    note err = vcat $ map text
+      [ err
+      , "It's OK if you don't want to use symbols from it directly."
+      , "(the package DLL is loaded by the system linker"
+      , " which manages dependencies by itself)." ]
+
+loadFrameworks :: HscEnv -> Platform -> UnitInfo -> IO ()
+loadFrameworks hsc_env platform pkg
+    = when (platformUsesFrameworks platform) $ mapM_ load frameworks
+  where
+    fw_dirs    = Packages.frameworkDirs pkg
+    frameworks = Packages.frameworks pkg
+
+    load fw = do  r <- loadFramework hsc_env fw_dirs fw
+                  case r of
+                    Nothing  -> return ()
+                    Just err -> cmdLineErrorIO ("can't load framework: "
+                                                ++ fw ++ " (" ++ err ++ ")" )
+
+-- Try to find an object file for a given library in the given paths.
+-- If it isn't present, we assume that addDLL in the RTS can find it,
+-- which generally means that it should be a dynamic library in the
+-- standard system search path.
+-- For GHCi we tend to prefer dynamic libraries over static ones as
+-- they are easier to load and manage, have less overhead.
+locateLib :: HscEnv -> Bool -> [FilePath] -> [FilePath] -> String
+          -> IO LibrarySpec
+locateLib hsc_env is_hs lib_dirs gcc_dirs lib
+  | not is_hs
+    -- For non-Haskell libraries (e.g. gmp, iconv):
+    --   first look in library-dirs for a dynamic library (on User paths only)
+    --   (libfoo.so)
+    --   then  try looking for import libraries on Windows (on User paths only)
+    --   (.dll.a, .lib)
+    --   first look in library-dirs for a dynamic library (on GCC paths only)
+    --   (libfoo.so)
+    --   then  check for system dynamic libraries (e.g. kernel32.dll on windows)
+    --   then  try looking for import libraries on Windows (on GCC paths only)
+    --   (.dll.a, .lib)
+    --   then  look in library-dirs for a static library (libfoo.a)
+    --   then look in library-dirs and inplace GCC for a dynamic library (libfoo.so)
+    --   then  try looking for import libraries on Windows (.dll.a, .lib)
+    --   then  look in library-dirs and inplace GCC for a static library (libfoo.a)
+    --   then  try "gcc --print-file-name" to search gcc's search path
+    --       for a dynamic library (#5289)
+    --   otherwise, assume loadDLL can find it
+    --
+    --   The logic is a bit complicated, but the rationale behind it is that
+    --   loading a shared library for us is O(1) while loading an archive is
+    --   O(n). Loading an import library is also O(n) so in general we prefer
+    --   shared libraries because they are simpler and faster.
+    --
+  = findDll   user `orElse`
+    tryImpLib user `orElse`
+    findDll   gcc  `orElse`
+    findSysDll     `orElse`
+    tryImpLib gcc  `orElse`
+    findArchive    `orElse`
+    tryGcc         `orElse`
+    assumeDll
+
+  | loading_dynamic_hs_libs -- search for .so libraries first.
+  = findHSDll     `orElse`
+    findDynObject `orElse`
+    assumeDll
+
+  | otherwise
+    -- use HSfoo.{o,p_o} if it exists, otherwise fallback to libHSfoo{,_p}.a
+  = findObject  `orElse`
+    findArchive `orElse`
+    assumeDll
+
+   where
+     dflags = hsc_dflags hsc_env
+     dirs   = lib_dirs ++ gcc_dirs
+     gcc    = False
+     user   = True
+
+     obj_file
+       | is_hs && loading_profiled_hs_libs = lib <.> "p_o"
+       | otherwise = lib <.> "o"
+     dyn_obj_file = lib <.> "dyn_o"
+     arch_files = [ "lib" ++ lib ++ lib_tag <.> "a"
+                  , lib <.> "a" -- native code has no lib_tag
+                  , "lib" ++ lib, lib
+                  ]
+     lib_tag = if is_hs && loading_profiled_hs_libs then "_p" else ""
+
+     loading_profiled_hs_libs = interpreterProfiled dflags
+     loading_dynamic_hs_libs  = interpreterDynamic dflags
+
+     import_libs  = [ lib <.> "lib"           , "lib" ++ lib <.> "lib"
+                    , "lib" ++ lib <.> "dll.a", lib <.> "dll.a"
+                    ]
+
+     hs_dyn_lib_name = lib ++ '-':programName dflags ++ projectVersion dflags
+     hs_dyn_lib_file = mkHsSOName platform hs_dyn_lib_name
+
+     so_name     = mkSOName platform lib
+     lib_so_name = "lib" ++ so_name
+     dyn_lib_file = case (arch, os) of
+                             (ArchX86_64, OSSolaris2) -> "64" </> so_name
+                             _ -> so_name
+
+     findObject    = liftM (fmap $ Objects . (:[]))  $ findFile dirs obj_file
+     findDynObject = liftM (fmap $ Objects . (:[]))  $ findFile dirs dyn_obj_file
+     findArchive   = let local name = liftM (fmap Archive) $ findFile dirs name
+                     in  apply (map local arch_files)
+     findHSDll     = liftM (fmap DLLPath) $ findFile dirs hs_dyn_lib_file
+     findDll    re = let dirs' = if re == user then lib_dirs else gcc_dirs
+                     in liftM (fmap DLLPath) $ findFile dirs' dyn_lib_file
+     findSysDll    = fmap (fmap $ DLL . dropExtension . takeFileName) $
+                        findSystemLibrary hsc_env so_name
+     tryGcc        = let search   = searchForLibUsingGcc dflags
+                         dllpath  = liftM (fmap DLLPath)
+                         short    = dllpath $ search so_name lib_dirs
+                         full     = dllpath $ search lib_so_name lib_dirs
+                         gcc name = liftM (fmap Archive) $ search name lib_dirs
+                         files    = import_libs ++ arch_files
+                     in apply $ short : full : map gcc files
+     tryImpLib re = case os of
+                       OSMinGW32 ->
+                        let dirs' = if re == user then lib_dirs else gcc_dirs
+                            implib name = liftM (fmap Archive) $
+                                            findFile dirs' name
+                        in apply (map implib import_libs)
+                       _         -> return Nothing
+
+     -- TH Makes use of the interpreter so this failure is not obvious.
+     -- So we are nice and warn/inform users why we fail before we do.
+     -- But only for haskell libraries, as C libraries don't have a
+     -- profiling/non-profiling distinction to begin with.
+     assumeDll
+      | is_hs
+      , not loading_dynamic_hs_libs
+      , interpreterProfiled dflags
+      = do
+          warningMsg dflags
+            (text "Interpreter failed to load profiled static library" <+> text lib <> char '.' $$
+              text " \tTrying dynamic library instead. If this fails try to rebuild" <+>
+              text "libraries with profiling support.")
+          return (DLL lib)
+      | otherwise = return (DLL lib)
+     infixr `orElse`
+     f `orElse` g = f >>= maybe g return
+
+     apply :: [IO (Maybe a)] -> IO (Maybe a)
+     apply []     = return Nothing
+     apply (x:xs) = do x' <- x
+                       if isJust x'
+                          then return x'
+                          else apply xs
+
+     platform = targetPlatform dflags
+     arch = platformArch platform
+     os = platformOS platform
+
+searchForLibUsingGcc :: DynFlags -> String -> [FilePath] -> IO (Maybe FilePath)
+searchForLibUsingGcc dflags so dirs = do
+   -- GCC does not seem to extend the library search path (using -L) when using
+   -- --print-file-name. So instead pass it a new base location.
+   str <- askLd dflags (map (FileOption "-B") dirs
+                          ++ [Option "--print-file-name", Option so])
+   let file = case lines str of
+                []  -> ""
+                l:_ -> l
+   if (file == so)
+      then return Nothing
+      else do b <- doesFileExist file -- file could be a folder (see #16063)
+              return (if b then Just file else Nothing)
+
+-- | Retrieve the list of search directory GCC and the System use to find
+--   libraries and components. See Note [Fork/Exec Windows].
+getGCCPaths :: DynFlags -> OS -> IO [FilePath]
+getGCCPaths dflags os
+  = case os of
+      OSMinGW32 ->
+        do gcc_dirs <- getGccSearchDirectory dflags "libraries"
+           sys_dirs <- getSystemDirectories
+           return $ nub $ gcc_dirs ++ sys_dirs
+      _         -> return []
+
+-- | Cache for the GCC search directories as this can't easily change
+--   during an invocation of GHC. (Maybe with some env. variable but we'll)
+--   deal with that highly unlikely scenario then.
+{-# NOINLINE gccSearchDirCache #-}
+gccSearchDirCache :: IORef [(String, [String])]
+gccSearchDirCache = unsafePerformIO $ newIORef []
+
+-- Note [Fork/Exec Windows]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~
+-- fork/exec is expensive on Windows, for each time we ask GCC for a library we
+-- have to eat the cost of af least 3 of these: gcc -> real_gcc -> cc1.
+-- So instead get a list of location that GCC would search and use findDirs
+-- which hopefully is written in an optimized mannor to take advantage of
+-- caching. At the very least we remove the overhead of the fork/exec and waits
+-- which dominate a large percentage of startup time on Windows.
+getGccSearchDirectory :: DynFlags -> String -> IO [FilePath]
+getGccSearchDirectory dflags key = do
+    cache <- readIORef gccSearchDirCache
+    case lookup key cache of
+      Just x  -> return x
+      Nothing -> do
+        str <- askLd dflags [Option "--print-search-dirs"]
+        let line = dropWhile isSpace str
+            name = key ++ ": ="
+        if null line
+          then return []
+          else do let val = split $ find name line
+                  dirs <- filterM doesDirectoryExist val
+                  modifyIORef' gccSearchDirCache ((key, dirs):)
+                  return val
+      where split :: FilePath -> [FilePath]
+            split r = case break (==';') r of
+                        (s, []    ) -> [s]
+                        (s, (_:xs)) -> s : split xs
+
+            find :: String -> String -> String
+            find r x = let lst = lines x
+                           val = filter (r `isPrefixOf`) lst
+                       in if null val
+                             then []
+                             else case break (=='=') (head val) of
+                                     (_ , [])    -> []
+                                     (_, (_:xs)) -> xs
+
+-- | Get a list of system search directories, this to alleviate pressure on
+-- the findSysDll function.
+getSystemDirectories :: IO [FilePath]
+#if defined(mingw32_HOST_OS)
+getSystemDirectories = fmap (:[]) getSystemDirectory
+#else
+getSystemDirectories = return []
+#endif
+
+-- | Merge the given list of paths with those in the environment variable
+--   given. If the variable does not exist then just return the identity.
+addEnvPaths :: String -> [String] -> IO [String]
+addEnvPaths name list
+  = do -- According to POSIX (chapter 8.3) a zero-length prefix means current
+       -- working directory. Replace empty strings in the env variable with
+       -- `working_dir` (see also #14695).
+       working_dir <- getCurrentDirectory
+       values <- lookupEnv name
+       case values of
+         Nothing  -> return list
+         Just arr -> return $ list ++ splitEnv working_dir arr
+    where
+      splitEnv :: FilePath -> String -> [String]
+      splitEnv working_dir value =
+        case break (== envListSep) value of
+          (x, []    ) ->
+            [if null x then working_dir else x]
+          (x, (_:xs)) ->
+            (if null x then working_dir else x) : splitEnv working_dir xs
+#if defined(mingw32_HOST_OS)
+      envListSep = ';'
+#else
+      envListSep = ':'
+#endif
+
+-- ----------------------------------------------------------------------------
+-- Loading a dynamic library (dlopen()-ish on Unix, LoadLibrary-ish on Win32)
+
+-- Darwin / MacOS X only: load a framework
+-- a framework is a dynamic library packaged inside a directory of the same
+-- name. They are searched for in different paths than normal libraries.
+loadFramework :: HscEnv -> [FilePath] -> FilePath -> IO (Maybe String)
+loadFramework hsc_env extraPaths rootname
+   = do { either_dir <- tryIO getHomeDirectory
+        ; let homeFrameworkPath = case either_dir of
+                                  Left _ -> []
+                                  Right dir -> [dir </> "Library/Frameworks"]
+              ps = extraPaths ++ homeFrameworkPath ++ defaultFrameworkPaths
+        ; mb_fwk <- findFile ps fwk_file
+        ; case mb_fwk of
+            Just fwk_path -> loadDLL hsc_env fwk_path
+            Nothing       -> return (Just "not found") }
+                -- Tried all our known library paths, but dlopen()
+                -- has no built-in paths for frameworks: give up
+   where
+     fwk_file = rootname <.> "framework" </> rootname
+        -- sorry for the hardcoded paths, I hope they won't change anytime soon:
+     defaultFrameworkPaths = ["/Library/Frameworks", "/System/Library/Frameworks"]
+
+{- **********************************************************************
+
+                Helper functions
+
+  ********************************************************************* -}
+
+maybePutStr :: DynFlags -> String -> IO ()
+maybePutStr dflags s
+    = when (verbosity dflags > 1) $
+          putLogMsg dflags
+              NoReason
+              SevInteractive
+              noSrcSpan
+              (defaultUserStyle dflags)
+              (text s)
+
+maybePutStrLn :: DynFlags -> String -> IO ()
+maybePutStrLn dflags s = maybePutStr dflags (s ++ "\n")
diff --git a/compiler/GHC/Runtime/Linker/Types.hs b/compiler/GHC/Runtime/Linker/Types.hs
new file mode 100644
index 0000000000..5b2f506c6d
--- /dev/null
+++ b/compiler/GHC/Runtime/Linker/Types.hs
@@ -0,0 +1,112 @@
+-----------------------------------------------------------------------------
+--
+-- Types for the Dynamic Linker
+--
+-- (c) The University of Glasgow 2019
+--
+-----------------------------------------------------------------------------
+
+module GHC.Runtime.Linker.Types (
+      DynLinker(..),
+      PersistentLinkerState(..),
+      LinkerUnitId,
+      Linkable(..),
+      Unlinked(..),
+      SptEntry(..)
+    ) where
+
+import GhcPrelude              ( FilePath, String, show )
+import Data.Time               ( UTCTime )
+import Data.Maybe              ( Maybe )
+import Control.Concurrent.MVar ( MVar )
+import Module                  ( InstalledUnitId, Module )
+import GHC.ByteCode.Types           ( ItblEnv, CompiledByteCode )
+import Outputable
+import Var                     ( Id )
+import GHC.Fingerprint.Type    ( Fingerprint )
+import NameEnv                 ( NameEnv )
+import Name                    ( Name )
+import GHCi.RemoteTypes        ( ForeignHValue )
+
+type ClosureEnv = NameEnv (Name, ForeignHValue)
+
+newtype DynLinker =
+  DynLinker { dl_mpls :: MVar (Maybe PersistentLinkerState) }
+
+data PersistentLinkerState
+  = PersistentLinkerState {
+
+       -- Current global mapping from Names to their true values
+       closure_env :: ClosureEnv,
+
+       -- The current global mapping from RdrNames of DataCons to
+       -- info table addresses.
+       -- When a new Unlinked is linked into the running image, or an existing
+       -- module in the image is replaced, the itbl_env must be updated
+       -- appropriately.
+       itbl_env    :: !ItblEnv,
+
+       -- The currently loaded interpreted modules (home package)
+       bcos_loaded :: ![Linkable],
+
+       -- And the currently-loaded compiled modules (home package)
+       objs_loaded :: ![Linkable],
+
+       -- The currently-loaded packages; always object code
+       -- Held, as usual, in dependency order; though I am not sure if
+       -- that is really important
+       pkgs_loaded :: ![LinkerUnitId],
+
+       -- we need to remember the name of previous temporary DLL/.so
+       -- libraries so we can link them (see #10322)
+       temp_sos :: ![(FilePath, String)] }
+
+-- TODO: Make this type more precise
+type LinkerUnitId = InstalledUnitId
+
+-- | Information we can use to dynamically link modules into the compiler
+data Linkable = LM {
+  linkableTime     :: UTCTime,          -- ^ Time at which this linkable was built
+                                        -- (i.e. when the bytecodes were produced,
+                                        --       or the mod date on the files)
+  linkableModule   :: Module,           -- ^ The linkable module itself
+  linkableUnlinked :: [Unlinked]
+    -- ^ Those files and chunks of code we have yet to link.
+    --
+    -- INVARIANT: A valid linkable always has at least one 'Unlinked' item.
+    -- If this list is empty, the Linkable represents a fake linkable, which
+    -- is generated in HscNothing mode to avoid recompiling modules.
+    --
+    -- ToDo: Do items get removed from this list when they get linked?
+ }
+
+instance Outputable Linkable where
+  ppr (LM when_made mod unlinkeds)
+     = (text "LinkableM" <+> parens (text (show when_made)) <+> ppr mod)
+       $$ nest 3 (ppr unlinkeds)
+
+-- | Objects which have yet to be linked by the compiler
+data Unlinked
+  = DotO FilePath      -- ^ An object file (.o)
+  | DotA FilePath      -- ^ Static archive file (.a)
+  | DotDLL FilePath    -- ^ Dynamically linked library file (.so, .dll, .dylib)
+  | BCOs CompiledByteCode
+         [SptEntry]    -- ^ A byte-code object, lives only in memory. Also
+                       -- carries some static pointer table entries which
+                       -- should be loaded along with the BCOs.
+                       -- See Note [Grant plan for static forms] in
+                       -- StaticPtrTable.
+
+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
+  ppr (BCOs bcos spt) = text "BCOs" <+> ppr bcos <+> ppr spt
+
+-- | An entry to be inserted into a module's static pointer table.
+-- See Note [Grand plan for static forms] in StaticPtrTable.
+data SptEntry = SptEntry Id Fingerprint
+
+instance Outputable SptEntry where
+  ppr (SptEntry id fpr) = ppr id <> colon <+> ppr fpr
+
diff --git a/compiler/GHC/Runtime/Loader.hs b/compiler/GHC/Runtime/Loader.hs
new file mode 100644
index 0000000000..a1c7c2a0fa
--- /dev/null
+++ b/compiler/GHC/Runtime/Loader.hs
@@ -0,0 +1,283 @@
+{-# LANGUAGE CPP, MagicHash #-}
+
+-- | Dynamically lookup up values from modules and loading them.
+module GHC.Runtime.Loader (
+        initializePlugins,
+        -- * Loading plugins
+        loadFrontendPlugin,
+
+        -- * Force loading information
+        forceLoadModuleInterfaces,
+        forceLoadNameModuleInterface,
+        forceLoadTyCon,
+
+        -- * Finding names
+        lookupRdrNameInModuleForPlugins,
+
+        -- * Loading values
+        getValueSafely,
+        getHValueSafely,
+        lessUnsafeCoerce
+    ) where
+
+import GhcPrelude
+import DynFlags
+
+import GHC.Runtime.Linker      ( linkModule, getHValue )
+import GHC.Runtime.Interpreter ( wormhole )
+import SrcLoc           ( noSrcSpan )
+import Finder           ( findPluginModule, cannotFindModule )
+import TcRnMonad        ( initTcInteractive, initIfaceTcRn )
+import GHC.Iface.Load   ( loadPluginInterface )
+import RdrName          ( RdrName, ImportSpec(..), ImpDeclSpec(..)
+                        , ImpItemSpec(..), mkGlobalRdrEnv, lookupGRE_RdrName
+                        , gre_name, mkRdrQual )
+import OccName          ( OccName, mkVarOcc )
+import GHC.Rename.Names ( gresFromAvails )
+import Plugins
+import PrelNames        ( pluginTyConName, frontendPluginTyConName )
+
+import HscTypes
+import GHCi.RemoteTypes ( HValue )
+import Type             ( Type, eqType, mkTyConTy )
+import TyCoPpr          ( pprTyThingCategory )
+import TyCon            ( TyCon )
+import Name             ( Name, nameModule_maybe )
+import Id               ( idType )
+import Module           ( Module, ModuleName )
+import Panic
+import FastString
+import ErrUtils
+import Outputable
+import Exception
+import Hooks
+
+import Control.Monad     ( when, unless )
+import Data.Maybe        ( mapMaybe )
+import GHC.Exts          ( unsafeCoerce# )
+
+-- | Loads the plugins specified in the pluginModNames field of the dynamic
+-- flags. Should be called after command line arguments are parsed, but before
+-- actual compilation starts. Idempotent operation. Should be re-called if
+-- pluginModNames or pluginModNameOpts changes.
+initializePlugins :: HscEnv -> DynFlags -> IO DynFlags
+initializePlugins hsc_env df
+  | map lpModuleName (cachedPlugins df)
+         == pluginModNames df -- plugins not changed
+     && all (\p -> paArguments (lpPlugin p)
+                       == argumentsForPlugin p (pluginModNameOpts df))
+            (cachedPlugins df) -- arguments not changed
+  = return df -- no need to reload plugins
+  | otherwise
+  = do loadedPlugins <- loadPlugins (hsc_env { hsc_dflags = df })
+       let df' = df { cachedPlugins = loadedPlugins }
+       df'' <- withPlugins df' runDflagsPlugin df'
+       return df''
+
+  where argumentsForPlugin p = map snd . filter ((== lpModuleName p) . fst)
+        runDflagsPlugin p opts dynflags = dynflagsPlugin p opts dynflags
+
+loadPlugins :: HscEnv -> IO [LoadedPlugin]
+loadPlugins hsc_env
+  = do { unless (null to_load) $
+           checkExternalInterpreter hsc_env
+       ; plugins <- mapM loadPlugin to_load
+       ; return $ zipWith attachOptions to_load plugins }
+  where
+    dflags  = hsc_dflags hsc_env
+    to_load = pluginModNames dflags
+
+    attachOptions mod_nm (plug, mod) =
+        LoadedPlugin (PluginWithArgs plug (reverse options)) mod
+      where
+        options = [ option | (opt_mod_nm, option) <- pluginModNameOpts dflags
+                            , opt_mod_nm == mod_nm ]
+    loadPlugin = loadPlugin' (mkVarOcc "plugin") pluginTyConName hsc_env
+
+
+loadFrontendPlugin :: HscEnv -> ModuleName -> IO FrontendPlugin
+loadFrontendPlugin hsc_env mod_name = do
+    checkExternalInterpreter hsc_env
+    fst <$> loadPlugin' (mkVarOcc "frontendPlugin") frontendPluginTyConName
+                hsc_env mod_name
+
+-- #14335
+checkExternalInterpreter :: HscEnv -> IO ()
+checkExternalInterpreter hsc_env =
+    when (gopt Opt_ExternalInterpreter dflags) $
+      throwCmdLineError $ showSDoc dflags $
+        text "Plugins require -fno-external-interpreter"
+  where
+    dflags = hsc_dflags hsc_env
+
+loadPlugin' :: OccName -> Name -> HscEnv -> ModuleName -> IO (a, ModIface)
+loadPlugin' occ_name plugin_name hsc_env mod_name
+  = do { let plugin_rdr_name = mkRdrQual mod_name occ_name
+             dflags = hsc_dflags hsc_env
+       ; mb_name <- lookupRdrNameInModuleForPlugins hsc_env mod_name
+                        plugin_rdr_name
+       ; case mb_name of {
+            Nothing ->
+                throwGhcExceptionIO (CmdLineError $ showSDoc dflags $ hsep
+                          [ text "The module", ppr mod_name
+                          , text "did not export the plugin name"
+                          , ppr plugin_rdr_name ]) ;
+            Just (name, mod_iface) ->
+
+     do { plugin_tycon <- forceLoadTyCon hsc_env plugin_name
+        ; mb_plugin <- getValueSafely hsc_env name (mkTyConTy plugin_tycon)
+        ; case mb_plugin of
+            Nothing ->
+                throwGhcExceptionIO (CmdLineError $ showSDoc dflags $ hsep
+                          [ text "The value", ppr name
+                          , text "did not have the type"
+                          , ppr pluginTyConName, text "as required"])
+            Just plugin -> return (plugin, mod_iface) } } }
+
+
+-- | Force the interfaces for the given modules to be loaded. The 'SDoc' parameter is used
+-- for debugging (@-ddump-if-trace@) only: it is shown as the reason why the module is being loaded.
+forceLoadModuleInterfaces :: HscEnv -> SDoc -> [Module] -> IO ()
+forceLoadModuleInterfaces hsc_env doc modules
+    = (initTcInteractive hsc_env $
+       initIfaceTcRn $
+       mapM_ (loadPluginInterface doc) modules)
+      >> return ()
+
+-- | Force the interface for the module containing the name to be loaded. The 'SDoc' parameter is used
+-- for debugging (@-ddump-if-trace@) only: it is shown as the reason why the module is being loaded.
+forceLoadNameModuleInterface :: HscEnv -> SDoc -> Name -> IO ()
+forceLoadNameModuleInterface hsc_env reason name = do
+    let name_modules = mapMaybe nameModule_maybe [name]
+    forceLoadModuleInterfaces hsc_env reason name_modules
+
+-- | Load the 'TyCon' associated with the given name, come hell or high water. Fails if:
+--
+-- * The interface could not be loaded
+-- * The name is not that of a 'TyCon'
+-- * The name did not exist in the loaded module
+forceLoadTyCon :: HscEnv -> Name -> IO TyCon
+forceLoadTyCon hsc_env con_name = do
+    forceLoadNameModuleInterface hsc_env (text "contains a name used in an invocation of loadTyConTy") con_name
+
+    mb_con_thing <- lookupTypeHscEnv hsc_env con_name
+    case mb_con_thing of
+        Nothing -> throwCmdLineErrorS dflags $ missingTyThingError con_name
+        Just (ATyCon tycon) -> return tycon
+        Just con_thing -> throwCmdLineErrorS dflags $ wrongTyThingError con_name con_thing
+  where dflags = hsc_dflags hsc_env
+
+-- | Loads the value corresponding to a 'Name' if that value has the given 'Type'. This only provides limited safety
+-- in that it is up to the user to ensure that that type corresponds to the type you try to use the return value at!
+--
+-- If the value found was not of the correct type, returns @Nothing@. Any other condition results in an exception:
+--
+-- * If we could not load the names module
+-- * If the thing being loaded is not a value
+-- * If the Name does not exist in the module
+-- * If the link failed
+
+getValueSafely :: HscEnv -> Name -> Type -> IO (Maybe a)
+getValueSafely hsc_env val_name expected_type = do
+  mb_hval <- lookupHook getValueSafelyHook getHValueSafely dflags hsc_env val_name expected_type
+  case mb_hval of
+    Nothing   -> return Nothing
+    Just hval -> do
+      value <- lessUnsafeCoerce dflags "getValueSafely" hval
+      return (Just value)
+  where
+    dflags = hsc_dflags hsc_env
+
+getHValueSafely :: HscEnv -> Name -> Type -> IO (Maybe HValue)
+getHValueSafely hsc_env val_name expected_type = do
+    forceLoadNameModuleInterface hsc_env (text "contains a name used in an invocation of getHValueSafely") val_name
+    -- Now look up the names for the value and type constructor in the type environment
+    mb_val_thing <- lookupTypeHscEnv hsc_env val_name
+    case mb_val_thing of
+        Nothing -> throwCmdLineErrorS dflags $ missingTyThingError val_name
+        Just (AnId id) -> do
+            -- Check the value type in the interface against the type recovered from the type constructor
+            -- before finally casting the value to the type we assume corresponds to that constructor
+            if expected_type `eqType` idType id
+             then do
+                -- Link in the module that contains the value, if it has such a module
+                case nameModule_maybe val_name of
+                    Just mod -> do linkModule hsc_env mod
+                                   return ()
+                    Nothing ->  return ()
+                -- Find the value that we just linked in and cast it given that we have proved it's type
+                hval <- getHValue hsc_env val_name >>= wormhole dflags
+                return (Just hval)
+             else return Nothing
+        Just val_thing -> throwCmdLineErrorS dflags $ wrongTyThingError val_name val_thing
+   where dflags = hsc_dflags hsc_env
+
+-- | Coerce a value as usual, but:
+--
+-- 1) Evaluate it immediately to get a segfault early if the coercion was wrong
+--
+-- 2) Wrap it in some debug messages at verbosity 3 or higher so we can see what happened
+--    if it /does/ segfault
+lessUnsafeCoerce :: DynFlags -> String -> a -> IO b
+lessUnsafeCoerce dflags context what = do
+    debugTraceMsg dflags 3 $ (text "Coercing a value in") <+> (text context) <>
+                             (text "...")
+    output <- evaluate (unsafeCoerce# what)
+    debugTraceMsg dflags 3 (text "Successfully evaluated coercion")
+    return output
+
+
+-- | Finds the 'Name' corresponding to the given 'RdrName' in the
+-- context of the 'ModuleName'. Returns @Nothing@ if no such 'Name'
+-- could be found. Any other condition results in an exception:
+--
+-- * If the module could not be found
+-- * If we could not determine the imports of the module
+--
+-- Can only be used for looking up names while loading plugins (and is
+-- *not* suitable for use within plugins).  The interface file is
+-- loaded very partially: just enough that it can be used, without its
+-- rules and instances affecting (and being linked from!) the module
+-- being compiled.  This was introduced by 57d6798.
+--
+-- Need the module as well to record information in the interface file
+lookupRdrNameInModuleForPlugins :: HscEnv -> ModuleName -> RdrName
+                                -> IO (Maybe (Name, ModIface))
+lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do
+    -- First find the package the module resides in by searching exposed packages and home modules
+    found_module <- findPluginModule hsc_env mod_name
+    case found_module of
+        Found _ mod -> do
+            -- Find the exports of the module
+            (_, mb_iface) <- initTcInteractive hsc_env $
+                             initIfaceTcRn $
+                             loadPluginInterface doc mod
+            case mb_iface of
+                Just iface -> do
+                    -- Try and find the required name in the exports
+                    let decl_spec = ImpDeclSpec { is_mod = mod_name, is_as = mod_name
+                                                , is_qual = False, is_dloc = noSrcSpan }
+                        imp_spec = ImpSpec decl_spec ImpAll
+                        env = mkGlobalRdrEnv (gresFromAvails (Just imp_spec) (mi_exports iface))
+                    case lookupGRE_RdrName rdr_name env of
+                        [gre] -> return (Just (gre_name gre, iface))
+                        []    -> return Nothing
+                        _     -> panic "lookupRdrNameInModule"
+
+                Nothing -> throwCmdLineErrorS dflags $ hsep [text "Could not determine the exports of the module", ppr mod_name]
+        err -> throwCmdLineErrorS dflags $ cannotFindModule dflags mod_name err
+  where
+    dflags = hsc_dflags hsc_env
+    doc = text "contains a name used in an invocation of lookupRdrNameInModule"
+
+wrongTyThingError :: Name -> TyThing -> SDoc
+wrongTyThingError name got_thing = hsep [text "The name", ppr name, ptext (sLit "is not that of a value but rather a"), pprTyThingCategory got_thing]
+
+missingTyThingError :: Name -> SDoc
+missingTyThingError name = hsep [text "The name", ppr name, ptext (sLit "is not in the type environment: are you sure it exists?")]
+
+throwCmdLineErrorS :: DynFlags -> SDoc -> IO a
+throwCmdLineErrorS dflags = throwCmdLineError . showSDoc dflags
+
+throwCmdLineError :: String -> IO a
+throwCmdLineError = throwGhcExceptionIO . CmdLineError