summaryrefslogtreecommitdiff
path: root/libraries
diff options
context:
space:
mode:
Diffstat (limited to 'libraries')
-rw-r--r--libraries/ghc-heap/GHC/Exts/Heap/ClosureTypes.hs5
-rw-r--r--libraries/ghc-heap/GHC/Exts/Heap/Closures.hs9
-rw-r--r--libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc4
-rw-r--r--libraries/ghci/GHCi/Message.hs35
-rw-r--r--libraries/ghci/GHCi/Run.hs7
-rw-r--r--libraries/integer-gmp/src/GHC/Integer/Type.hs5
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
View Lorry Controller Status