Remote GHCi, -fexternal-interpreter

Summary:
(Apologies for the size of this patch, I couldn't make a smaller one
that was validate-clean and also made sense independently)

(Some of this code is derived from GHCJS.)

This commit adds support for running interpreted code (for GHCi and
TemplateHaskell) in a separate process.  The functionality is
experimental, so for now it is off by default and enabled by the flag
-fexternal-interpreter.

Reaosns we want this:

* 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.  We would no longer need to
  force -dynamic-too with TemplateHaskell, and we can load ordinary
  objects into a dynamically-linked GHCi (and vice versa).

* 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.

Amongst other things; see
https://ghc.haskell.org/trac/ghc/wiki/RemoteGHCi for more details.

Notes on the implementation are in Note [Remote GHCi] in the new
module compiler/ghci/GHCi.hs.  It probably needs more documenting,
feel free to suggest things I could elaborate on.

Things that are not currently implemented for -fexternal-interpreter:

* The GHCi debugger
* :set prog, :set args in GHCi
* `recover` in Template Haskell
* Redirecting stdin/stdout for the external process

These are all doable, I just wanted to get to a working validate-clean
patch first.

I also haven't done any benchmarking yet.  I expect there to be slight hit
to link times for byte code and some penalty due to having to
serialize/deserialize TH syntax, but I don't expect it to be a serious
problem.  There's also lots of low-hanging fruit in the byte code
generator/linker that we could exploit to speed things up.

Test Plan:
* validate
* I've run parts of the test suite with
EXTRA_HC_OPTS=-fexternal-interpreter, notably tests/ghci and tests/th.
There are a few failures due to the things not currently implemented
(see above).

Reviewers: simonpj, goldfire, ezyang, austin, alanz, hvr, niteria, bgamari, gibiansky, luite

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1562

1 files changed, 31 insertions, 24 deletions

diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 0b60596123..558341aebc 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -90,7 +90,7 @@ module HscMain
 
 #ifdef GHCI
 import Id
-import BasicTypes       ( HValue )
+import GHCi.RemoteTypes ( ForeignHValue )
 import ByteCodeGen      ( byteCodeGen, coreExprToBCOs )
 import Linker
 import CoreTidy         ( tidyExpr )
@@ -101,8 +101,6 @@ import VarEnv           ( emptyTidyEnv )
 import THNames          ( templateHaskellNames )
 import Panic
 import ConLike
-
-import GHC.Exts
 #endif
 
 import Module
@@ -162,6 +160,7 @@ import Stream (Stream)
 import Util
 
 import Data.List
+import Control.Concurrent
 import Control.Monad
 import Data.IORef
 import System.FilePath as FilePath
@@ -183,15 +182,20 @@ newHscEnv dflags = do
     us      <- mkSplitUniqSupply 'r'
     nc_var  <- newIORef (initNameCache us allKnownKeyNames)
     fc_var  <- newIORef emptyModuleEnv
-    return HscEnv {  hsc_dflags       = dflags,
-                     hsc_targets      = [],
-                     hsc_mod_graph    = [],
-                     hsc_IC           = emptyInteractiveContext dflags,
-                     hsc_HPT          = emptyHomePackageTable,
-                     hsc_EPS          = eps_var,
-                     hsc_NC           = nc_var,
-                     hsc_FC           = fc_var,
-                     hsc_type_env_var = Nothing }
+    iserv_mvar <- newMVar Nothing
+    return HscEnv {  hsc_dflags       = dflags
+                  ,  hsc_targets      = []
+                  ,  hsc_mod_graph    = []
+                  ,  hsc_IC           = emptyInteractiveContext dflags
+                  ,  hsc_HPT          = emptyHomePackageTable
+                  ,  hsc_EPS          = eps_var
+                  ,  hsc_NC           = nc_var
+                  ,  hsc_FC           = fc_var
+                  ,  hsc_type_env_var = Nothing
+#ifdef GHCI
+                  , hsc_iserv        = iserv_mvar
+#endif
+                  }
 
 
 allKnownKeyNames :: [Name]      -- Put here to avoid loops involving DsMeta,
@@ -1303,7 +1307,7 @@ hscInteractive hsc_env cgguts mod_summary = do
     prepd_binds <- {-# SCC "CorePrep" #-}
                    corePrepPgm hsc_env location core_binds data_tycons
     -----------------  Generate byte code ------------------
-    comp_bc <- byteCodeGen dflags this_mod prepd_binds data_tycons mod_breaks
+    comp_bc <- byteCodeGen hsc_env this_mod prepd_binds data_tycons mod_breaks
     ------------------ Create f-x-dynamic C-side stuff ---
     (_istub_h_exists, istub_c_exists)
         <- outputForeignStubs dflags this_mod location foreign_stubs
@@ -1434,7 +1438,7 @@ IO monad as explained in Note [Interactively-bound Ids in GHCi] in HscTypes
 --
 -- We return Nothing to indicate an empty statement (or comment only), not a
 -- parse error.
-hscStmt :: HscEnv -> String -> IO (Maybe ([Id], IO [HValue], FixityEnv))
+hscStmt :: HscEnv -> String -> IO (Maybe ([Id], ForeignHValue, FixityEnv))
 hscStmt hsc_env stmt = hscStmtWithLocation hsc_env stmt "<interactive>" 1
 
 -- | Compile a stmt all the way to an HValue, but don't run it
@@ -1445,7 +1449,9 @@ hscStmtWithLocation :: HscEnv
                     -> String -- ^ The statement
                     -> String -- ^ The source
                     -> Int    -- ^ Starting line
-                    -> IO (Maybe ([Id], IO [HValue], FixityEnv))
+                    -> IO ( Maybe ([Id]
+                          , ForeignHValue {- IO [HValue] -}
+                          , FixityEnv))
 hscStmtWithLocation hsc_env0 stmt source linenumber =
   runInteractiveHsc hsc_env0 $ do
     maybe_stmt <- hscParseStmtWithLocation source linenumber stmt
@@ -1458,7 +1464,9 @@ hscStmtWithLocation hsc_env0 stmt source linenumber =
 
 hscParsedStmt :: HscEnv
               -> GhciLStmt RdrName  -- ^ The parsed statement
-              -> IO (Maybe ([Id], IO [HValue], FixityEnv))
+              -> IO ( Maybe ([Id]
+                    , ForeignHValue {- IO [HValue] -}
+                    , FixityEnv))
 hscParsedStmt hsc_env stmt = runInteractiveHsc hsc_env $ do
   -- Rename and typecheck it
   (ids, tc_expr, fix_env) <- ioMsgMaybe $ tcRnStmt hsc_env stmt
@@ -1474,9 +1482,8 @@ hscParsedStmt hsc_env stmt = runInteractiveHsc hsc_env $ do
   -- Whereas the linker already knows to ignore 'interactive'
   let src_span = srcLocSpan interactiveSrcLoc
   hval <- liftIO $ hscCompileCoreExpr hsc_env src_span ds_expr
-  let hvals_io = unsafeCoerce# hval :: IO [HValue]
 
-  return $ Just (ids, hvals_io, fix_env)
+  return $ Just (ids, hval, fix_env)
 
 -- | Compile a decls
 hscDecls :: HscEnv
@@ -1518,8 +1525,7 @@ hscDeclsWithLocation hsc_env0 str source linenumber =
     {- Tidy -}
     (tidy_cg, mod_details) <- liftIO $ tidyProgram hsc_env simpl_mg
 
-    let dflags = hsc_dflags hsc_env
-        !CgGuts{ cg_module    = this_mod,
+    let !CgGuts{ cg_module    = this_mod,
                  cg_binds     = core_binds,
                  cg_tycons    = tycons,
                  cg_modBreaks = mod_breaks } = tidy_cg
@@ -1536,7 +1542,7 @@ hscDeclsWithLocation hsc_env0 str source linenumber =
       liftIO $ corePrepPgm hsc_env iNTERACTIVELoc core_binds data_tycons
 
     {- Generate byte code -}
-    cbc <- liftIO $ byteCodeGen dflags this_mod
+    cbc <- liftIO $ byteCodeGen hsc_env this_mod
                                 prepd_binds data_tycons mod_breaks
 
     let src_span = srcLocSpan interactiveSrcLoc
@@ -1715,11 +1721,11 @@ mkModGuts mod safe binds =
 %********************************************************************* -}
 
 #ifdef GHCI
-hscCompileCoreExpr :: HscEnv -> SrcSpan -> CoreExpr -> IO HValue
+hscCompileCoreExpr :: HscEnv -> SrcSpan -> CoreExpr -> IO ForeignHValue
 hscCompileCoreExpr hsc_env =
   lookupHook hscCompileCoreExprHook hscCompileCoreExpr' (hsc_dflags hsc_env) hsc_env
 
-hscCompileCoreExpr' :: HscEnv -> SrcSpan -> CoreExpr -> IO HValue
+hscCompileCoreExpr' :: HscEnv -> SrcSpan -> CoreExpr -> IO ForeignHValue
 hscCompileCoreExpr' hsc_env srcspan ds_expr
     = do { let dflags = hsc_dflags hsc_env
 
@@ -1736,7 +1742,8 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr
          ; lintInteractiveExpr "hscCompileExpr" hsc_env prepd_expr
 
            {- Convert to BCOs -}
-         ; bcos <- coreExprToBCOs dflags (icInteractiveModule (hsc_IC hsc_env)) prepd_expr
+         ; bcos <- coreExprToBCOs hsc_env
+                     (icInteractiveModule (hsc_IC hsc_env)) prepd_expr
 
            {- link it -}
          ; hval <- linkExpr hsc_env srcspan bcos