[commit: ghc] master: RtClosureInspect: add some docs, remove unused stuff (6cb189d)
git at git.haskell.org
git at git.haskell.org
Wed Jul 4 06:08:45 UTC 2018
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/6cb189d1d465d18879b6a4b107fbdce53b2ebf56/ghc
>---------------------------------------------------------------
commit 6cb189d1d465d18879b6a4b107fbdce53b2ebf56
Author: Ömer Sinan Ağacan <omeragacan at gmail.com>
Date: Wed Jul 4 09:08:16 2018 +0300
RtClosureInspect: add some docs, remove unused stuff
Details are not documented, only the high-level functions
Reviewers: simonpj, hvr, bgamari
Reviewed By: bgamari
Subscribers: rwbarton, thomie, carter
Differential Revision: https://phabricator.haskell.org/D4911
>---------------------------------------------------------------
6cb189d1d465d18879b6a4b107fbdce53b2ebf56
compiler/ghci/RtClosureInspect.hs | 129 +++++++++++++++++---------------------
1 file changed, 58 insertions(+), 71 deletions(-)
diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index 025efe8..81bdb61 100644
--- a/compiler/ghci/RtClosureInspect.hs
+++ b/compiler/ghci/RtClosureInspect.hs
@@ -8,20 +8,19 @@
--
-----------------------------------------------------------------------------
module RtClosureInspect(
- cvObtainTerm, -- :: HscEnv -> Int -> Bool -> Maybe Type -> HValue -> IO Term
+ -- * Entry points and types
+ cvObtainTerm,
cvReconstructType,
improveRTTIType,
-
Term(..),
- isTerm, isSuspension, isPrim, isFun, isFunLike, isNewtypeWrap,
- isFullyEvaluated, isFullyEvaluatedTerm,
- termType, mapTermType, termTyCoVars,
- foldTerm, TermFold(..), foldTermM, TermFoldM(..), idTermFold,
- pprTerm, cPprTerm, cPprTermBase, CustomTermPrinter,
--- unsafeDeepSeq,
+ -- * Utils
+ isFullyEvaluatedTerm,
+ termType, mapTermType, termTyCoVars,
+ foldTerm, TermFold(..),
+ cPprTerm, cPprTermBase,
- constrClosToName, isConstr, isIndirection
+ constrClosToName -- exported to use in test T4891
) where
#include "HsVersions.h"
@@ -102,28 +101,6 @@ data Term = Term { ty :: RttiType
ty :: RttiType
, wrapped_term :: Term }
-isTerm, isSuspension, isPrim, isFun, isFunLike, isNewtypeWrap :: Term -> Bool
-isTerm Term{} = True
-isTerm _ = False
-isSuspension Suspension{} = True
-isSuspension _ = False
-isPrim Prim{} = True
-isPrim _ = False
-isNewtypeWrap NewtypeWrap{} = True
-isNewtypeWrap _ = False
-
-isFun Suspension{ctype=FUN} = True
-isFun Suspension{ctype=FUN_1_0} = True
-isFun Suspension{ctype=FUN_0_1} = True
-isFun Suspension{ctype=FUN_2_0} = True
-isFun Suspension{ctype=FUN_1_1} = True
-isFun Suspension{ctype=FUN_0_2} = True
-isFun Suspension{ctype=FUN_STATIC} = True
-isFun _ = False
-
-isFunLike s at Suspension{ty=ty} = isFun s || isFunTy ty
-isFunLike _ = False
-
termType :: Term -> RttiType
termType t = ty t
@@ -142,40 +119,12 @@ instance Outputable (Term) where
-- Runtime Closure information functions
----------------------------------------
-isConstr, isIndirection, isThunk :: GenClosure a -> Bool
-isConstr ConstrClosure{} = True
-isConstr _ = False
-
-isIndirection IndClosure{} = True
-isIndirection _ = False
-
+isThunk :: GenClosure a -> Bool
isThunk ThunkClosure{} = True
isThunk APClosure{} = True
isThunk APStackClosure{} = True
isThunk _ = False
-isFullyEvaluated :: a -> IO Bool
-isFullyEvaluated a = do
- closure <- getClosureData a
- if isConstr closure
- then do are_subs_evaluated <- amapM isFullyEvaluated (ptrArgs closure)
- return$ and are_subs_evaluated
- else return False
- where amapM f = sequence . map (\(Box x) -> f x)
-
--- TODO: Fix it. Probably the otherwise case is failing, trace/debug it
-{-
-unsafeDeepSeq :: a -> b -> b
-unsafeDeepSeq = unsafeDeepSeq1 2
- where unsafeDeepSeq1 0 a b = seq a $! b
- unsafeDeepSeq1 i a b -- 1st case avoids infinite loops for non reducible thunks
- | not (isConstr tipe) = seq a $! unsafeDeepSeq1 (i-1) a b
- -- | unsafePerformIO (isFullyEvaluated a) = b
- | otherwise = case unsafePerformIO (getClosureData a) of
- closure -> foldl' (flip unsafeDeepSeq) b (ptrs closure)
- where tipe = unsafePerformIO (getClosureType a)
--}
-
-- Lookup the name in a constructor closure
constrClosToName :: HscEnv -> Closure -> IO (Either String Name)
constrClosToName hsc_env ConstrClosure{pkg=pkg,modl=mod,name=occ} = do
@@ -266,7 +215,6 @@ termTyCoVars = foldTerm TermFold {
----------------------------------
type Precedence = Int
-type TermPrinter = Precedence -> Term -> SDoc
type TermPrinterM m = Precedence -> Term -> m SDoc
app_prec,cons_prec, max_prec ::Int
@@ -274,10 +222,6 @@ max_prec = 10
app_prec = max_prec
cons_prec = 5 -- TODO Extract this info from GHC itself
-pprTerm :: TermPrinter -> TermPrinter
-pprTerm y p t | Just doc <- pprTermM (\p -> Just . y p) p t = doc
-pprTerm _ _ _ = panic "pprTerm"
-
pprTermM, ppr_termM, pprNewtypeWrap :: Monad m => TermPrinterM m -> TermPrinterM m
pprTermM y p t = pprDeeper `liftM` ppr_termM y p t
@@ -591,9 +535,26 @@ addConstraint actual expected = do
-- TOMDO: what about the coercion?
-- we should consider family instances
--- Type & Term reconstruction
-------------------------------
-cvObtainTerm :: HscEnv -> Int -> Bool -> RttiType -> HValue -> IO Term
+
+-- | 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
+ -> HValue -- ^ 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
@@ -814,9 +775,35 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0
moveBytes = r * 8
--- Fast, breadth-first Type reconstruction
-------------------------------------------
-cvReconstructType :: HscEnv -> Int -> GhciType -> HValue -> IO (Maybe Type)
+-- | 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
+ -> HValue -- ^ 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
More information about the ghc-commits
mailing list