Commit ec22f7dd authored by patrickdoc's avatar patrickdoc Committed by Ben Gamari

Add HeapView functionality

This pulls parts of Joachim Breitner's ghc-heap-view library inside GHC.
The bits added are the C hooks into the RTS and a basic Haskell wrapper
to these C hooks. The main reason for these to be added to GHC proper
is that the code needs to be kept in sync with the closure types
defined by the RTS. It is expected that the version of HeapView shipped
with GHC will always work with that version of GHC and that extra
functionality can be layered on top with a library like ghc-heap-view
distributed via Hackage.

Test Plan: validate

Reviewers: simonmar, hvr, nomeata, austin, Phyx, bgamari, erikd

Reviewed By: bgamari

Subscribers: carter, patrickdoc, tmcgilchrist, rwbarton, thomie

Differential Revision: https://phabricator.haskell.org/D3055
parent 12deb9a9
...@@ -145,6 +145,7 @@ _darcs/ ...@@ -145,6 +145,7 @@ _darcs/
/libraries/ghc-boot-th/GNUmakefile /libraries/ghc-boot-th/GNUmakefile
/libraries/ghc-boot-th/ghc-boot-th.cabal /libraries/ghc-boot-th/ghc-boot-th.cabal
/libraries/ghc-boot-th/ghc.mk /libraries/ghc-boot-th/ghc.mk
/libraries/ghc-heap/ghc-heap.cabal
/libraries/ghci/GNUmakefile /libraries/ghci/GNUmakefile
/libraries/ghci/ghci.cabal /libraries/ghci/ghci.cabal
/libraries/ghci/ghc.mk /libraries/ghci/ghc.mk
......
...@@ -64,6 +64,7 @@ Library ...@@ -64,6 +64,7 @@ Library
transformers == 0.5.*, transformers == 0.5.*,
ghc-boot == @ProjectVersionMunged@, ghc-boot == @ProjectVersionMunged@,
ghc-boot-th == @ProjectVersionMunged@, ghc-boot-th == @ProjectVersionMunged@,
ghc-heap == @ProjectVersionMunged@,
ghci == @ProjectVersionMunged@ ghci == @ProjectVersionMunged@
if os(windows) if os(windows)
...@@ -643,5 +644,4 @@ Library ...@@ -643,5 +644,4 @@ Library
Debugger Debugger
Linker Linker
RtClosureInspect RtClosureInspect
DebuggerUtils
GHCi GHCi
...@@ -23,7 +23,6 @@ import GhcPrelude ...@@ -23,7 +23,6 @@ import GhcPrelude
import GHCi.RemoteTypes import GHCi.RemoteTypes
import GHCi.ResolvedBCO import GHCi.ResolvedBCO
import GHCi.InfoTable
import GHCi.BreakArray import GHCi.BreakArray
import SizedSeq import SizedSeq
...@@ -99,7 +98,7 @@ lookupStaticPtr hsc_env addr_of_label_string = do ...@@ -99,7 +98,7 @@ lookupStaticPtr hsc_env addr_of_label_string = do
lookupIE :: HscEnv -> ItblEnv -> Name -> IO (Ptr ()) lookupIE :: HscEnv -> ItblEnv -> Name -> IO (Ptr ())
lookupIE hsc_env ie con_nm = lookupIE hsc_env ie con_nm =
case lookupNameEnv ie con_nm of case lookupNameEnv ie con_nm of
Just (_, ItblPtr a) -> return (conInfoPtr (fromRemotePtr (castRemotePtr a))) Just (_, ItblPtr a) -> return (fromRemotePtr (castRemotePtr a))
Nothing -> do -- try looking up in the object files. Nothing -> do -- try looking up in the object files.
let sym_to_find1 = nameToCLabel con_nm "con_info" let sym_to_find1 = nameToCLabel con_nm "con_info"
m <- lookupSymbol hsc_env sym_to_find1 m <- lookupSymbol hsc_env sym_to_find1
......
...@@ -27,7 +27,6 @@ import SrcLoc ...@@ -27,7 +27,6 @@ import SrcLoc
import GHCi.BreakArray import GHCi.BreakArray
import GHCi.RemoteTypes import GHCi.RemoteTypes
import GHCi.FFI import GHCi.FFI
import GHCi.InfoTable
import Control.DeepSeq import Control.DeepSeq
import Foreign import Foreign
...@@ -36,6 +35,7 @@ import Data.Array.Base ( UArray(..) ) ...@@ -36,6 +35,7 @@ import Data.Array.Base ( UArray(..) )
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import Data.IntMap (IntMap) import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap import qualified Data.IntMap as IntMap
import GHC.Exts.Heap
import GHC.Stack.CCS import GHC.Stack.CCS
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
......
{-# LANGUAGE CPP #-}
module DebuggerUtils (
dataConInfoPtrToName,
) where
import GhcPrelude
import GHCi.InfoTable
import CmmInfo ( stdInfoTableSizeB )
import DynFlags
import HscTypes
import FastString
import IfaceEnv
import Module
import OccName
import Name
import Outputable
import Util
import Data.Char
import Foreign
import Data.List
#include "HsVersions.h"
-- | Given a data constructor in the heap, find its Name.
-- The info tables for data constructors have a field which records
-- the source name of the constructor as a Ptr Word8 (UTF-8 encoded
-- string). The format is:
--
-- > Package:Module.Name
--
-- We use this string to lookup the interpreter's internal representation of the name
-- using the lookupOrig.
--
dataConInfoPtrToName :: HscEnv -> Ptr () -> IO Name
dataConInfoPtrToName hsc_env x = do
let dflags = hsc_dflags hsc_env
theString <- do
let ptr = castPtr x :: Ptr StgInfoTable
conDescAddress <- getConDescAddress dflags ptr
peekArray0 0 conDescAddress
let (pkg, mod, occ) = parse theString
pkgFS = mkFastStringByteList pkg
modFS = mkFastStringByteList mod
occFS = mkFastStringByteList occ
occName = mkOccNameFS OccName.dataName occFS
modName = mkModule (fsToUnitId pkgFS) (mkModuleNameFS modFS)
lookupOrigIO hsc_env modName occName
where
{- To find the string in the constructor's info table we need to consider
the layout of info tables relative to the entry code for a closure.
An info table can be next to the entry code for the closure, or it can
be separate. The former (faster) is used in registerised versions of ghc,
and the latter (portable) is for non-registerised versions.
The diagrams below show where the string is to be found relative to
the normal info table of the closure.
1) Code next to table:
--------------
| | <- pointer to the start of the string
--------------
| | <- the (start of the) info table structure
| |
| |
--------------
| entry code |
| .... |
In this case the pointer to the start of the string can be found in
the memory location _one word before_ the first entry in the normal info
table.
2) Code NOT next to table:
--------------
info table structure -> | *------------------> --------------
| | | entry code |
| | | .... |
--------------
ptr to start of str -> | |
--------------
In this case the pointer to the start of the string can be found
in the memory location: info_table_ptr + info_table_size
-}
getConDescAddress :: DynFlags -> Ptr StgInfoTable -> IO (Ptr Word8)
getConDescAddress dflags ptr
| ghciTablesNextToCode = do
let ptr' = ptr `plusPtr` (- wORD_SIZE dflags)
-- NB. the offset must be read as an Int32 not a Word32, so
-- that the sign is preserved when converting to an Int.
offsetToString <- fromIntegral <$> (peek ptr' :: IO Int32)
return $ (ptr `plusPtr` stdInfoTableSizeB dflags) `plusPtr` offsetToString
| otherwise =
peek $ intPtrToPtr $ ptrToIntPtr ptr + fromIntegral (stdInfoTableSizeB dflags)
-- parsing names is a little bit fiddly because we have a string in the form:
-- pkg:A.B.C.foo, and we want to split it into three parts: ("pkg", "A.B.C", "foo").
-- Thus we split at the leftmost colon and the rightmost occurrence of the dot.
-- It would be easier if the string was in the form pkg:A.B.C:foo, but alas
-- this is not the conventional way of writing Haskell names. We stick with
-- convention, even though it makes the parsing code more troublesome.
-- Warning: this code assumes that the string is well formed.
parse :: [Word8] -> ([Word8], [Word8], [Word8])
parse input
= ASSERT(all (`lengthExceeds` 0) ([pkg, mod, occ])) (pkg, mod, occ)
where
dot = fromIntegral (ord '.')
(pkg, rest1) = break (== fromIntegral (ord ':')) input
(mod, occ)
= (concat $ intersperse [dot] $ reverse modWords, occWord)
where
(modWords, occWord) = ASSERT(rest1 `lengthExceeds` 0) (parseModOcc [] (tail rest1))
parseModOcc :: [[Word8]] -> [Word8] -> ([[Word8]], [Word8])
-- We only look for dots if str could start with a module name,
-- i.e. if it starts with an upper case character.
-- Otherwise we might think that "X.:->" is the module name in
-- "X.:->.+", whereas actually "X" is the module name and
-- ":->.+" is a constructor name.
parseModOcc acc str@(c : _)
| isUpper $ chr $ fromIntegral c
= case break (== dot) str of
(top, []) -> (acc, top)
(top, _ : bot) -> parseModOcc (top : acc) bot
parseModOcc acc str = (acc, str)
...@@ -21,17 +21,14 @@ module RtClosureInspect( ...@@ -21,17 +21,14 @@ module RtClosureInspect(
-- unsafeDeepSeq, -- unsafeDeepSeq,
Closure(..), getClosureData, ClosureType(..), isConstr, isIndirection constrClosToName, isConstr, isIndirection
) where ) where
#include "HsVersions.h" #include "HsVersions.h"
import GhcPrelude import GhcPrelude
import DebuggerUtils import GHCi.RemoteTypes
import GHCi.RemoteTypes ( HValue )
import qualified GHCi.InfoTable as InfoTable
import GHCi.InfoTable (StgInfoTable, peekItbl)
import HscTypes import HscTypes
import DataCon import DataCon
...@@ -48,6 +45,9 @@ import TcEnv ...@@ -48,6 +45,9 @@ import TcEnv
import TyCon import TyCon
import Name import Name
import OccName
import Module
import IfaceEnv
import Util import Util
import VarSet import VarSet
import BasicTypes ( Boxity(..) ) import BasicTypes ( Boxity(..) )
...@@ -56,16 +56,14 @@ import PrelNames ...@@ -56,16 +56,14 @@ import PrelNames
import TysWiredIn import TysWiredIn
import DynFlags import DynFlags
import Outputable as Ppr import Outputable as Ppr
import GHC.Arr ( Array(..) )
import GHC.Char import GHC.Char
import GHC.Exts import GHC.Exts
import GHC.Exts.Heap
import GHC.IO ( IO(..) ) import GHC.IO ( IO(..) )
import SMRep ( roundUpTo ) import SMRep ( roundUpTo )
import Control.Monad import Control.Monad
import Data.Maybe import Data.Maybe
import Data.Array.Base
import Data.Ix
import Data.List import Data.List
import qualified Data.Sequence as Seq import qualified Data.Sequence as Seq
import Data.Sequence (viewl, ViewL(..)) import Data.Sequence (viewl, ViewL(..))
...@@ -86,7 +84,7 @@ data Term = Term { ty :: RttiType ...@@ -86,7 +84,7 @@ data Term = Term { ty :: RttiType
, subTerms :: [Term] } , subTerms :: [Term] }
| Prim { ty :: RttiType | Prim { ty :: RttiType
, value :: [Word] } , valRaw :: [Word] }
| Suspension { ctype :: ClosureType | Suspension { ctype :: ClosureType
, ty :: RttiType , ty :: RttiType
...@@ -114,7 +112,13 @@ isPrim _ = False ...@@ -114,7 +112,13 @@ isPrim _ = False
isNewtypeWrap NewtypeWrap{} = True isNewtypeWrap NewtypeWrap{} = True
isNewtypeWrap _ = False isNewtypeWrap _ = False
isFun Suspension{ctype=Fun} = True 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 isFun _ = False
isFunLike s@Suspension{ty=ty} = isFun s || isFunTy ty isFunLike s@Suspension{ty=ty} = isFun s || isFunTy ty
...@@ -134,101 +138,30 @@ instance Outputable (Term) where ...@@ -134,101 +138,30 @@ instance Outputable (Term) where
ppr t | Just doc <- cPprTerm cPprTermBase t = doc ppr t | Just doc <- cPprTerm cPprTermBase t = doc
| otherwise = panic "Outputable Term instance" | otherwise = panic "Outputable Term instance"
------------------------------------------------------------------------- ----------------------------------------
-- Runtime Closure Datatype and functions for retrieving closure related stuff -- Runtime Closure information functions
------------------------------------------------------------------------- ----------------------------------------
data ClosureType = Constr
| Fun
| Thunk Int
| ThunkSelector
| Blackhole
| AP
| PAP
| Indirection Int
| MutVar Int
| MVar Int
| Other Int
deriving (Show, Eq)
data ClosureNonPtrs = ClosureNonPtrs ByteArray#
data Closure = Closure { tipe :: ClosureType
, infoPtr :: Ptr ()
, infoTable :: StgInfoTable
, ptrs :: Array Int HValue
, nonPtrs :: ClosureNonPtrs
}
instance Outputable ClosureType where isConstr, isIndirection, isThunk :: GenClosure a -> Bool
ppr = text . show isConstr ConstrClosure{} = True
#include "../includes/rts/storage/ClosureTypes.h"
aP_CODE, pAP_CODE :: Int
aP_CODE = AP
pAP_CODE = PAP
#undef AP
#undef PAP
getClosureData :: DynFlags -> a -> IO Closure
getClosureData dflags a =
case unpackClosure# a of
(# iptr, ptrs, nptrs #) -> do
let iptr0 = Ptr iptr
let iptr1
| ghciTablesNextToCode = iptr0
| otherwise =
-- the info pointer we get back from unpackClosure#
-- is to the beginning of the standard info table,
-- but the Storable instance for info tables takes
-- into account the extra entry pointer when
-- !ghciTablesNextToCode, so we must adjust here:
iptr0 `plusPtr` negate (wORD_SIZE dflags)
itbl <- peekItbl iptr1
let tipe = readCType (InfoTable.tipe itbl)
elems = fromIntegral (InfoTable.ptrs itbl)
ptrsList = Array 0 (elems - 1) elems ptrs
nptrs_data = ClosureNonPtrs nptrs
ASSERT(elems >= 0) return ()
ptrsList `seq`
return (Closure tipe iptr0 itbl ptrsList nptrs_data)
readCType :: Integral a => a -> ClosureType
readCType i
| i >= CONSTR && i <= CONSTR_NOCAF = Constr
| i >= FUN && i <= FUN_STATIC = Fun
| i >= THUNK && i < THUNK_SELECTOR = Thunk i'
| i == THUNK_SELECTOR = ThunkSelector
| i == BLACKHOLE = Blackhole
| i >= IND && i <= IND_STATIC = Indirection i'
| i' == aP_CODE = AP
| i == AP_STACK = AP
| i' == pAP_CODE = PAP
| i == MUT_VAR_CLEAN || i == MUT_VAR_DIRTY= MutVar i'
| i == MVAR_CLEAN || i == MVAR_DIRTY = MVar i'
| otherwise = Other i'
where i' = fromIntegral i
isConstr, isIndirection, isThunk :: ClosureType -> Bool
isConstr Constr = True
isConstr _ = False isConstr _ = False
isIndirection (Indirection _) = True isIndirection IndClosure{} = True
isIndirection _ = False isIndirection _ = False
isThunk (Thunk _) = True isThunk ThunkClosure{} = True
isThunk ThunkSelector = True isThunk APClosure{} = True
isThunk AP = True isThunk APStackClosure{} = True
isThunk _ = False isThunk _ = False
isFullyEvaluated :: DynFlags -> a -> IO Bool isFullyEvaluated :: a -> IO Bool
isFullyEvaluated dflags a = do isFullyEvaluated a = do
closure <- getClosureData dflags a closure <- getClosureData a
case tipe closure of if isConstr closure
Constr -> do are_subs_evaluated <- amapM (isFullyEvaluated dflags) (ptrs closure) then do are_subs_evaluated <- amapM isFullyEvaluated (ptrArgs closure)
return$ and are_subs_evaluated return$ and are_subs_evaluated
_ -> return False else return False
where amapM f = sequence . amap' f where amapM f = sequence . map (\(Box x) -> f x)
-- TODO: Fix it. Probably the otherwise case is failing, trace/debug it -- TODO: Fix it. Probably the otherwise case is failing, trace/debug it
{- {-
...@@ -243,6 +176,15 @@ unsafeDeepSeq = unsafeDeepSeq1 2 ...@@ -243,6 +176,15 @@ unsafeDeepSeq = unsafeDeepSeq1 2
where tipe = unsafePerformIO (getClosureType a) 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
let occName = mkOccName OccName.dataName occ
modName = mkModule (stringToUnitId pkg) (mkModuleName mod)
Right `fmap` lookupOrigIO hsc_env modName occName
constrClosToName _hsc_env clos =
return (Left ("conClosToName: Expected ConstrClosure, got " ++ show clos))
----------------------------------- -----------------------------------
-- * Traversals for Terms -- * Traversals for Terms
----------------------------------- -----------------------------------
...@@ -374,7 +316,7 @@ ppr_termM _ _ t = ppr_termM1 t ...@@ -374,7 +316,7 @@ ppr_termM _ _ t = ppr_termM1 t
ppr_termM1 :: Monad m => Term -> m SDoc ppr_termM1 :: Monad m => Term -> m SDoc
ppr_termM1 Prim{value=words, ty=ty} = ppr_termM1 Prim{valRaw=words, ty=ty} =
return $ repPrim (tyConAppTyCon ty) words return $ repPrim (tyConAppTyCon ty) words
ppr_termM1 Suspension{ty=ty, bound_to=Nothing} = ppr_termM1 Suspension{ty=ty, bound_to=Nothing} =
return (char '_' <+> whenPprDebug (text "::" <> ppr ty)) return (char '_' <+> whenPprDebug (text "::" <> ppr ty))
...@@ -696,8 +638,6 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do ...@@ -696,8 +638,6 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do
text "Type obtained: " <> ppr (termType term)) text "Type obtained: " <> ppr (termType term))
return term return term
where where
dflags = hsc_dflags hsc_env
go :: Int -> Type -> Type -> HValue -> TcM Term go :: Int -> Type -> Type -> HValue -> TcM Term
-- I believe that my_ty should not have any enclosing -- I believe that my_ty should not have any enclosing
-- foralls, nor any free RuntimeUnk skolems; -- foralls, nor any free RuntimeUnk skolems;
...@@ -708,27 +648,30 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do ...@@ -708,27 +648,30 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do
go 0 my_ty _old_ty a = do go 0 my_ty _old_ty a = do
traceTR (text "Gave up reconstructing a term after" <> traceTR (text "Gave up reconstructing a term after" <>
int max_depth <> text " steps") int max_depth <> text " steps")
clos <- trIO $ getClosureData dflags a clos <- trIO $ getClosureData a
return (Suspension (tipe clos) my_ty a Nothing) return (Suspension (tipe (info clos)) my_ty a Nothing)
go !max_depth my_ty old_ty a = do go !max_depth my_ty old_ty a = do
let monomorphic = not(isTyVarTy my_ty) let monomorphic = not(isTyVarTy my_ty)
-- This ^^^ is a convention. The ancestor tests for -- This ^^^ is a convention. The ancestor tests for
-- monomorphism and passes a type instead of a tv -- monomorphism and passes a type instead of a tv
clos <- trIO $ getClosureData dflags a clos <- trIO $ getClosureData a
case tipe clos of case clos of
-- Thunks we may want to force -- Thunks we may want to force
t | isThunk t && force -> traceTR (text "Forcing a " <> text (show t)) >> t | isThunk t && force -> traceTR (text "Forcing a " <> text (show t)) >>
seq a (go (pred max_depth) my_ty old_ty a) seq a (go (pred max_depth) my_ty old_ty a)
-- Blackholes are indirections iff the payload is not TSO or BLOCKING_QUEUE. So we -- Blackholes are indirections iff the payload is not TSO or BLOCKING_QUEUE. So we
-- treat them like indirections; if the payload is TSO or BLOCKING_QUEUE, we'll end up -- treat them like indirections; if the payload is TSO or BLOCKING_QUEUE, we'll end up
-- showing '_' which is what we want. -- showing '_' which is what we want.
Blackhole -> do traceTR (text "Following a BLACKHOLE") BlackholeClosure{indirectee=ind} -> do
appArr (go max_depth my_ty old_ty) (ptrs clos) 0 traceTR (text "Following a BLACKHOLE")
(\(Box x) -> go max_depth my_ty old_ty (HValue x)) ind
-- We always follow indirections -- We always follow indirections
Indirection i -> do traceTR (text "Following an indirection" <> parens (int i) ) IndClosure{indirectee=ind} -> do
go max_depth my_ty old_ty $! (ptrs clos ! 0) traceTR (text "Following an indirection" )
(\(Box x) -> go max_depth my_ty old_ty (HValue x)) ind
-- We also follow references -- We also follow references
MutVar _ | Just (tycon,[world,contents_ty]) <- tcSplitTyConApp_maybe old_ty MutVarClosure{}
| Just (tycon,[world,contents_ty]) <- tcSplitTyConApp_maybe old_ty
-> do -> do
-- Deal with the MutVar# primitive -- Deal with the MutVar# primitive
-- It does not have a constructor at all, -- It does not have a constructor at all,
...@@ -745,13 +688,13 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do ...@@ -745,13 +688,13 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do
return (RefWrap my_ty x) return (RefWrap my_ty x)
-- The interesting case -- The interesting case
Constr -> do ConstrClosure{ptrArgs=pArgs} -> do
traceTR (text "entering a constructor " <> traceTR (text "entering a constructor " <>
if monomorphic if monomorphic
then parens (text "already monomorphic: " <> ppr my_ty) then parens (text "already monomorphic: " <> ppr my_ty)
else Ppr.empty) else Ppr.empty)
dcname <- liftIO $ dataConInfoPtrToName hsc_env (infoPtr clos) Right dcname <- liftIO $ constrClosToName hsc_env clos
(_,mb_dc) <- tryTc (tcLookupDataCon dcname) (_,mb_dc) <- tryTc (tcLookupDataCon dcname)
case mb_dc of case mb_dc of
Nothing -> do -- This can happen for private constructors compiled -O0 Nothing -> do -- This can happen for private constructors compiled -O0
-- where the .hi descriptor does not export them -- where the .hi descriptor does not export them
...@@ -761,10 +704,10 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do ...@@ -761,10 +704,10 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do
traceTR (text "Not constructor" <+> ppr dcname) traceTR (text "Not constructor" <+> ppr dcname)
let dflags = hsc_dflags hsc_env let dflags = hsc_dflags hsc_env
tag = showPpr dflags dcname tag = showPpr dflags dcname
vars <- replicateM (length$ elems$ ptrs clos) vars <- replicateM (length pArgs)
(newVar liftedTypeKind) (newVar liftedTypeKind)
subTerms <- sequence [appArr (go (pred max_depth) tv tv) (ptrs clos) i subTerms <- sequence $ zipWith (\(Box x) tv ->
| (i, tv) <- zip [0..] vars] go (pred max_depth) tv tv (HValue x)) pArgs vars
return (Term my_ty (Left ('<' : tag ++ ">")) a subTerms) return (Term my_ty (Left ('<' : tag ++ ">")) a subTerms)
Just dc -> do Just dc -> do
traceTR (text "Is constructor" <+> (ppr dc $$ ppr my_ty)) traceTR (text "Is constructor" <+> (ppr dc $$ ppr my_ty))
...@@ -773,9 +716,9 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do ...@@ -773,9 +716,9 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do
return (Term my_ty (Right dc) a subTerms) return (Term my_ty (Right dc) a subTerms)
-- The otherwise case: can be a Thunk,AP,PAP,etc.