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, 18 insertions, 37 deletions

diff --git a/compiler/ghci/ByteCodeInstr.hs b/compiler/ghci/ByteCodeInstr.hs
index 2de4941aa6..4f2b82ba27 100644
--- a/compiler/ghci/ByteCodeInstr.hs
+++ b/compiler/ghci/ByteCodeInstr.hs
@@ -6,17 +6,15 @@
 
 -- | ByteCodeInstrs: Bytecode instruction definitions
 module ByteCodeInstr (
-        BCInstr(..), ProtoBCO(..), bciStackUse, BreakInfo (..)
+        BCInstr(..), ProtoBCO(..), bciStackUse,
   ) where
 
 #include "HsVersions.h"
 #include "../includes/MachDeps.h"
 
-import ByteCodeItbls    ( ItblPtr )
-
+import ByteCodeTypes
 import StgCmmLayout     ( ArgRep(..) )
 import PprCore
-import Type
 import Outputable
 import FastString
 import Name
@@ -28,7 +26,6 @@ import VarSet
 import PrimOp
 import SMRep
 
-import Module (Module)
 import GHC.Exts
 import Data.Word
 
@@ -46,7 +43,7 @@ data ProtoBCO a
         -- what the BCO came from
         protoBCOExpr       :: Either  [AnnAlt Id DVarSet] (AnnExpr Id DVarSet),
         -- malloc'd pointers
-        protoBCOPtrs       :: [Either ItblPtr (Ptr ())]
+        protoBCOFFIs       :: [FFIInfo]
    }
 
 type LocalLabel = Word16
@@ -70,7 +67,7 @@ data BCInstr
    | PUSH_ALTS_UNLIFTED (ProtoBCO Name) ArgRep
 
    -- Pushing literals
-   | PUSH_UBX  (Either Literal (Ptr ())) Word16
+   | PUSH_UBX  Literal Word16
         -- push this int/float/double/addr, on the stack. Word16
         -- is # of words to copy from literal pool.  Eitherness reflects
         -- the difficulty of dealing with MachAddr here, mostly due to
@@ -144,28 +141,13 @@ data BCInstr
    -- Breakpoints
    | BRK_FUN          (MutableByteArray# RealWorld) Word16 BreakInfo
 
-data BreakInfo
-   = BreakInfo
-   { breakInfo_module :: Module
-   , breakInfo_number :: {-# UNPACK #-} !Int
-   , breakInfo_vars   :: [(Id,Word16)]
-   , breakInfo_resty  :: Type
-   }
-
-instance Outputable BreakInfo where
-   ppr info = text "BreakInfo" <+>
-              parens (ppr (breakInfo_module info) <+>
-                      ppr (breakInfo_number info) <+>
-                      ppr (breakInfo_vars info) <+>
-                      ppr (breakInfo_resty info))
-
 -- -----------------------------------------------------------------------------
 -- Printing bytecode instructions
 
 instance Outputable a => Outputable (ProtoBCO a) where
-   ppr (ProtoBCO name instrs bitmap bsize arity origin malloced)
+   ppr (ProtoBCO name instrs bitmap bsize arity origin ffis)
       = (text "ProtoBCO" <+> ppr name <> char '#' <> int arity
-                <+> text (show malloced) <> colon)
+                <+> text (show ffis) <> colon)
         $$ nest 3 (case origin of
                       Left alts -> vcat (zipWith (<+>) (char '{' : repeat (char ';'))
                                                        (map (pprCoreAltShort.deAnnAlt) alts)) <+> char '}'
@@ -210,19 +192,18 @@ instance Outputable BCInstr where
    ppr (PUSH_ALTS bco)       = hang (text "PUSH_ALTS") 2 (ppr bco)
    ppr (PUSH_ALTS_UNLIFTED bco pk) = hang (text "PUSH_ALTS_UNLIFTED" <+> ppr pk) 2 (ppr bco)
 
-   ppr (PUSH_UBX (Left lit) nw) = text "PUSH_UBX" <+> parens (ppr nw) <+> ppr lit
-   ppr (PUSH_UBX (Right aa) nw) = text "PUSH_UBX" <+> parens (ppr nw) <+> text (show aa)
-   ppr PUSH_APPLY_N             = text "PUSH_APPLY_N"
-   ppr PUSH_APPLY_V             = text "PUSH_APPLY_V"
-   ppr PUSH_APPLY_F             = text "PUSH_APPLY_F"
-   ppr PUSH_APPLY_D             = text "PUSH_APPLY_D"
-   ppr PUSH_APPLY_L             = text "PUSH_APPLY_L"
-   ppr PUSH_APPLY_P             = text "PUSH_APPLY_P"
-   ppr PUSH_APPLY_PP            = text "PUSH_APPLY_PP"
-   ppr PUSH_APPLY_PPP           = text "PUSH_APPLY_PPP"
-   ppr PUSH_APPLY_PPPP          = text "PUSH_APPLY_PPPP"
-   ppr PUSH_APPLY_PPPPP         = text "PUSH_APPLY_PPPPP"
-   ppr PUSH_APPLY_PPPPPP        = text "PUSH_APPLY_PPPPPP"
+   ppr (PUSH_UBX lit nw)     = text "PUSH_UBX" <+> parens (ppr nw) <+> ppr lit
+   ppr PUSH_APPLY_N          = text "PUSH_APPLY_N"
+   ppr PUSH_APPLY_V          = text "PUSH_APPLY_V"
+   ppr PUSH_APPLY_F          = text "PUSH_APPLY_F"
+   ppr PUSH_APPLY_D          = text "PUSH_APPLY_D"
+   ppr PUSH_APPLY_L          = text "PUSH_APPLY_L"
+   ppr PUSH_APPLY_P          = text "PUSH_APPLY_P"
+   ppr PUSH_APPLY_PP         = text "PUSH_APPLY_PP"
+   ppr PUSH_APPLY_PPP        = text "PUSH_APPLY_PPP"
+   ppr PUSH_APPLY_PPPP       = text "PUSH_APPLY_PPPP"
+   ppr PUSH_APPLY_PPPPP      = text "PUSH_APPLY_PPPPP"
+   ppr PUSH_APPLY_PPPPPP     = text "PUSH_APPLY_PPPPPP"
 
    ppr (SLIDE n d)           = text "SLIDE   " <+> ppr n <+> ppr d
    ppr (ALLOC_AP sz)         = text "ALLOC_AP   " <+> ppr sz