projects
/
ghc-hetmet.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (from parent 1:
f264382
)
Fix imports & add missing type signatures
author
Pepe Iborra
<mnislaih@gmail.com>
Wed, 11 Jul 2007 10:17:49 +0000
(10:17 +0000)
committer
Pepe Iborra
<mnislaih@gmail.com>
Wed, 11 Jul 2007 10:17:49 +0000
(10:17 +0000)
compiler/ghci/RtClosureInspect.hs
patch
|
blob
|
history
diff --git
a/compiler/ghci/RtClosureInspect.hs
b/compiler/ghci/RtClosureInspect.hs
index
19403ae
..
e30d1b8
100644
(file)
--- a/
compiler/ghci/RtClosureInspect.hs
+++ b/
compiler/ghci/RtClosureInspect.hs
@@
-37,12
+37,12
@@
import HscTypes ( HscEnv )
import DataCon
import Type
import DataCon
import Type
-import TcRnMonad ( TcM, initTcPrintErrors, ioToTcRn, recoverM
- , writeMutVar )
+import TcRnMonad ( TcM, initTcPrintErrors, ioToTcRn, recoverM)
import TcType
import TcMType
import TcUnify
import TcGadt
import TcType
import TcMType
import TcUnify
import TcGadt
+import TcEnv
import TyCon
import Var
import Name
import TyCon
import Var
import Name
@@
-103,6
+103,7
@@
data Term = Term { ty :: Type
, bound_to :: Maybe Name -- Useful for printing
}
, bound_to :: Maybe Name -- Useful for printing
}
+isTerm, isSuspension, isPrim :: Term -> Bool
isTerm Term{} = True
isTerm _ = False
isSuspension Suspension{} = True
isTerm Term{} = True
isTerm _ = False
isSuspension Suspension{} = True
@@
-110,6
+111,7
@@
isSuspension _ = False
isPrim Prim{} = True
isPrim _ = False
isPrim Prim{} = True
isPrim _ = False
+termType :: Term -> Maybe Type
termType t@(Suspension {}) = mb_ty t
termType t = Just$ ty t
termType t@(Suspension {}) = mb_ty t
termType t = Just$ ty t
@@
-178,7
+180,7
@@
readCType i
| fromIntegral i == pAP_CODE = PAP
| otherwise = Other (fromIntegral i)
| fromIntegral i == pAP_CODE = PAP
| otherwise = Other (fromIntegral i)
-isConstr, isIndirection :: ClosureType -> Bool
+isConstr, isIndirection, isThunk :: ClosureType -> Bool
isConstr Constr = True
isConstr _ = False
isConstr Constr = True
isConstr _ = False
@@
-262,11
+264,13
@@
idTermFoldM = TermFold {
fSuspension = (((return.).).). Suspension
}
fSuspension = (((return.).).). Suspension
}
+mapTermType :: (Type -> Type) -> Term -> Term
mapTermType f = foldTerm idTermFold {
fTerm = \ty dc hval tt -> Term (f ty) dc hval tt,
fSuspension = \ct mb_ty hval n ->
Suspension ct (fmap f mb_ty) hval n }
mapTermType f = foldTerm idTermFold {
fTerm = \ty dc hval tt -> Term (f ty) dc hval tt,
fSuspension = \ct mb_ty hval n ->
Suspension ct (fmap f mb_ty) hval n }
+termTyVars :: Term -> TyVarSet
termTyVars = foldTerm TermFold {
fTerm = \ty _ _ tt ->
tyVarsOfType ty `plusVarEnv` concatVarEnv tt,
termTyVars = foldTerm TermFold {
fTerm = \ty _ _ tt ->
tyVarsOfType ty `plusVarEnv` concatVarEnv tt,
@@
-315,7
+319,7
@@
pprTermM1 _ Suspension{mb_ty=Just ty, bound_to=Just n}
cPprTerm :: forall m. Monad m =>
((Int->Term->m SDoc)->[Int->Term->m (Maybe SDoc)]) -> Term -> m SDoc
cPprTerm custom = go 0 where
cPprTerm :: forall m. Monad m =>
((Int->Term->m SDoc)->[Int->Term->m (Maybe SDoc)]) -> Term -> m SDoc
cPprTerm custom = go 0 where
- go prec t@Term{subTerms=tt, dc=dc} = do
+ go prec t@Term{} = do
let default_ prec t = Just `liftM` pprTermM go prec t
mb_customDocs = [pp prec t | pp <- custom go ++ [default_]]
Just doc <- firstJustM mb_customDocs
let default_ prec t = Just `liftM` pprTermM go prec t
mb_customDocs = [pp prec t | pp <- custom go ++ [default_]]
Just doc <- firstJustM mb_customDocs
@@
-431,6
+435,7
@@
runTR hsc_env c = do
trIO :: IO a -> TR a
trIO = liftTcM . ioToTcRn
trIO :: IO a -> TR a
trIO = liftTcM . ioToTcRn
+liftTcM :: TcM a -> TR a
liftTcM = id
newVar :: Kind -> TR TcTyVar
liftTcM = id
newVar :: Kind -> TR TcTyVar