Support the GHCi debugger with -fexternal-interpreter

* All the tests in tests/ghci.debugger now pass with
  -fexternal-interpreter. These tests are now run with the ghci-ext way
  in addition to the normal way so we won't break it in the future.

* I removed all the unsafeCoerce# calls from RtClosureInspect. Yay!

The main changes are:

* New messages: GetClosure and Seq.  GetClosure is a remote interface to
  GHC.Exts.Heap.getClosureData, which required Binary instances for
  various datatypes. Fortunately this wasn't too painful thanks to
  DeriveGeneric.

* No cheating by unsafeCoercing values when printing them. Now we have
  to turn the Closure representation back into the native representation
  when printing Int, Float, Double, Integer and Char. Of these, Integer
  was the most painful - we now have a dependency on integer-gmp due to
  needing access to the representation.

* Fixed a bug in rts/Heap.c - it was bogusly returning stack content as
  pointers for an AP_STACK closure.

Test Plan:
* `cd testsuite/tests/ghci.debugger && make`
* validate

Reviewers: bgamari, patrickdoc, nomeata, angerman, hvr, erikd, goldfire

Subscribers: alpmestan, snowleopard, rwbarton, thomie, carter

GHC Trac Issues: #13184

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

6 files changed, 58 insertions, 7 deletions

diff --git a/libraries/ghc-heap/GHC/Exts/Heap/ClosureTypes.hs b/libraries/ghc-heap/GHC/Exts/Heap/ClosureTypes.hs
index 7cd85fe99e..677e3b64e7 100644
--- a/libraries/ghc-heap/GHC/Exts/Heap/ClosureTypes.hs
+++ b/libraries/ghc-heap/GHC/Exts/Heap/ClosureTypes.hs
@@ -1,10 +1,13 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveGeneric #-}
 
 module GHC.Exts.Heap.ClosureTypes
     ( ClosureType(..)
     , closureTypeHeaderSize
     ) where
 
+import GHC.Generics
+
 {- ---------------------------------------------
 -- Enum representing closure types
 -- This is a mirror of:
@@ -77,7 +80,7 @@ data ClosureType
     | SMALL_MUT_ARR_PTRS_FROZEN_CLEAN
     | COMPACT_NFDATA
     | N_CLOSURE_TYPES
- deriving (Enum, Eq, Ord, Show)
+ deriving (Enum, Eq, Ord, Show, Generic)
 
 -- | Return the size of the closures header in words
 closureTypeHeaderSize :: ClosureType -> Int
diff --git a/libraries/ghc-heap/GHC/Exts/Heap/Closures.hs b/libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
index 09a94a0f3f..bdfac8bf8b 100644
--- a/libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
+++ b/libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
@@ -4,6 +4,8 @@
 {-# LANGUAGE MagicHash #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE UnliftedFFITypes #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveTraversable #-}
 
 module GHC.Exts.Heap.Closures (
     -- * Closures
@@ -35,6 +37,7 @@ import Data.Bits
 import Data.Int
 import Data.Word
 import GHC.Exts
+import GHC.Generics
 import Numeric
 
 ------------------------------------------------------------------------
@@ -222,7 +225,7 @@ data GenClosure b
     -- | A @MutVar#@
   | MutVarClosure
         { info       :: !StgInfoTable
-        , var        :: !b              -- ^ Pointer to closure
+        , var        :: !b              -- ^ Pointer to contents
         }
 
     -- | An STM blocking queue.
@@ -285,7 +288,7 @@ data GenClosure b
   | UnsupportedClosure
         { info       :: !StgInfoTable
         }
-  deriving (Show)
+  deriving (Show, Generic, Functor, Foldable, Traversable)
 
 
 data PrimType
@@ -296,7 +299,7 @@ data PrimType
   | PAddr
   | PFloat
   | PDouble
-  deriving (Eq, Show)
+  deriving (Eq, Show, Generic)
 
 -- | For generic code, this function returns all referenced closures.
 allClosures :: GenClosure b -> [b]
diff --git a/libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc b/libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc
index d8666d6b1d..0ba535d039 100644
--- a/libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc
+++ b/libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveGeneric #-}
 module GHC.Exts.Heap.InfoTable.Types
     ( StgInfoTable(..)
     , EntryFunPtr
@@ -7,6 +8,7 @@ module GHC.Exts.Heap.InfoTable.Types
 
 #include "Rts.h"
 
+import GHC.Generics
 import GHC.Exts.Heap.ClosureTypes
 import Foreign
 
@@ -34,4 +36,4 @@ data StgInfoTable = StgInfoTable {
    tipe   :: ClosureType,
    srtlen :: HalfWord,
    code   :: Maybe ItblCodes -- Just <=> ghciTablesNextToCode
-  } deriving (Show)
+  } deriving (Show, Generic)
diff --git a/libraries/ghci/GHCi/Message.hs b/libraries/ghci/GHCi/Message.hs
index 3f0bad9888..9b6740cc51 100644
--- a/libraries/ghci/GHCi/Message.hs
+++ b/libraries/ghci/GHCi/Message.hs
@@ -43,6 +43,7 @@ import Data.Dynamic
 import Data.Typeable (TypeRep)
 import Data.IORef
 import Data.Map (Map)
+import Foreign
 import GHC.Generics
 import GHC.Stack.CCS
 import qualified Language.Haskell.TH        as TH
@@ -202,6 +203,18 @@ data Message a where
                    -> [RemoteRef (TH.Q ())]
                    -> Message (QResult ())
 
+  -- | Remote interface to GHC.Exts.Heap.getClosureData. This is used by
+  -- the GHCi debugger to inspect values in the heap for :print and
+  -- type reconstruction.
+  GetClosure
+    :: HValueRef
+    -> Message (GenClosure HValueRef)
+
+  -- | Evaluate something. This is used to support :force in GHCi.
+  Seq
+    :: HValueRef
+    -> Message (EvalResult ())
+
 deriving instance Show (Message a)
 
 
@@ -410,6 +423,22 @@ data QState = QState
   }
 instance Show QState where show _ = "<QState>"
 
+-- Orphan instances of Binary for Ptr / FunPtr by conversion to Word64.
+-- This is to support Binary StgInfoTable which includes these.
+instance Binary (Ptr a) where
+  put p = put (fromIntegral (ptrToWordPtr p) :: Word64)
+  get = (wordPtrToPtr . fromIntegral) <$> (get :: Get Word64)
+
+instance Binary (FunPtr a) where
+  put = put . castFunPtrToPtr
+  get = castPtrToFunPtr <$> get
+
+-- Binary instances to support the GetClosure message
+instance Binary StgInfoTable
+instance Binary ClosureType
+instance Binary PrimType
+instance Binary a => Binary (GenClosure a)
+
 data Msg = forall a . (Binary a, Show a) => Msg (Message a)
 
 getMessage :: Get Msg
@@ -450,7 +479,9 @@ getMessage = do
       31 -> Msg <$> return StartTH
       32 -> Msg <$> (RunModFinalizers <$> get <*> get)
       33 -> Msg <$> (AddSptEntry <$> get <*> get)
-      _  -> Msg <$> (RunTH <$> get <*> get <*> get <*> get)
+      34 -> Msg <$> (RunTH <$> get <*> get <*> get <*> get)
+      35 -> Msg <$> (GetClosure <$> get)
+      _  -> Msg <$> (Seq <$> get)
 
 putMessage :: Message a -> Put
 putMessage m = case m of
@@ -489,6 +520,8 @@ putMessage m = case m of
   RunModFinalizers a b        -> putWord8 32 >> put a >> put b
   AddSptEntry a b             -> putWord8 33 >> put a >> put b
   RunTH st q loc ty           -> putWord8 34 >> put st >> put q >> put loc >> put ty
+  GetClosure a                -> putWord8 35 >> put a
+  Seq a                       -> putWord8 36 >> put a
 
 -- -----------------------------------------------------------------------------
 -- Reading/writing messages
diff --git a/libraries/ghci/GHCi/Run.hs b/libraries/ghci/GHCi/Run.hs
index 2988ec202a..8ec7659abe 100644
--- a/libraries/ghci/GHCi/Run.hs
+++ b/libraries/ghci/GHCi/Run.hs
@@ -31,8 +31,9 @@ import Data.Binary.Get
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Unsafe as B
 import GHC.Exts
+import GHC.Exts.Heap
 import GHC.Stack
-import Foreign
+import Foreign hiding (void)
 import Foreign.C
 import GHC.Conc.Sync
 import GHC.IO hiding ( bracket )
@@ -86,6 +87,10 @@ run m = case m of
   MkConInfoTable ptrs nptrs tag ptrtag desc ->
     toRemotePtr <$> mkConInfoTable ptrs nptrs tag ptrtag desc
   StartTH -> startTH
+  GetClosure ref -> do
+    clos <- getClosureData =<< localRef ref
+    mapM (\(Box x) -> mkRemoteRef (HValue x)) clos
+  Seq ref -> tryEval (void $ evaluate =<< localRef ref)
   _other -> error "GHCi.Run.run"
 
 evalStmt :: EvalOpts -> EvalExpr HValueRef -> IO (EvalStatus [HValueRef])
diff --git a/libraries/integer-gmp/src/GHC/Integer/Type.hs b/libraries/integer-gmp/src/GHC/Integer/Type.hs
index 9636b9f443..3434df29c4 100644
--- a/libraries/integer-gmp/src/GHC/Integer/Type.hs
+++ b/libraries/integer-gmp/src/GHC/Integer/Type.hs
@@ -150,6 +150,11 @@ data Integer  = S#                !Int#
               | Jn# {-# UNPACK #-} !BigNat
                 -- ^ iff value in @]-inf, minBound::'Int'[@ range
 
+-- NOTE: the above representation is baked into the GHCi debugger in
+-- compiler/ghci/RtClosureInspect.hs. If you change it here, fixes
+-- will be required over there too. Tests for this are in
+-- testsuite/tests/ghci.debugger.
+
 -- TODO: experiment with different constructor-ordering
 
 instance Eq Integer where