X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fghci%2FRtClosureInspect.hs;h=95ae5acd02a4942c4bb9cbf7d4830a7181ddcf84;hp=f90b1ca03ce44019da5a5b9884d9073440616a4d;hb=e9f9ec1e57d53b9302a395ce0d02c0fa59e28341;hpb=1c83695b5b9ae3175c18908c1d58aeadb1f225ae diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs index f90b1ca..95ae5ac 100644 --- a/compiler/ghci/RtClosureInspect.hs +++ b/compiler/ghci/RtClosureInspect.hs @@ -54,7 +54,7 @@ import TysWiredIn import DynFlags import Outputable import FastString -import Panic +-- import Panic import Constants ( wORD_SIZE ) @@ -74,11 +74,10 @@ import Data.Ix import Data.List import qualified Data.Sequence as Seq import Data.Monoid -import Data.Sequence hiding (null, length, index, take, drop, splitAt, reverse) +import Data.Sequence (viewl, ViewL(..)) import Foreign -import System.IO.Unsafe +-- import System.IO.Unsafe -import System.IO --------------------------------------------- -- * A representation of semi evaluated Terms --------------------------------------------- @@ -166,7 +165,7 @@ data Closure = Closure { tipe :: ClosureType instance Outputable ClosureType where ppr = text . show -#include "../includes/ClosureTypes.h" +#include "../includes/rts/storage/ClosureTypes.h" aP_CODE, pAP_CODE :: Int aP_CODE = AP @@ -382,12 +381,12 @@ ppr_termM1 Term{} = panic "ppr_termM1 - Term" ppr_termM1 RefWrap{} = panic "ppr_termM1 - RefWrap" ppr_termM1 NewtypeWrap{} = panic "ppr_termM1 - NewtypeWrap" -pprNewtypeWrap y p NewtypeWrap{ty=ty, wrapped_term=t} +pprNewtypeWrap y p NewtypeWrap{ty=ty, wrapped_term=t} | Just (tc,_) <- tcSplitTyConApp_maybe ty , ASSERT(isNewTyCon tc) True , Just new_dc <- tyConSingleDataCon_maybe tc = do - real_term <- y max_prec t - return$ cparen (p >= app_prec) (ppr new_dc <+> real_term) + real_term <- y max_prec t + return $ cparen (p >= app_prec) (ppr new_dc <+> real_term) pprNewtypeWrap _ _ _ = panic "pprNewtypeWrap" ------------------------------------------------------- @@ -438,10 +437,6 @@ cPprTermBase y = | pred t = Just `liftM` f prec t ifTerm _ _ _ _ = return Nothing - isIntegerTy ty = fromMaybe False $ do - (tc,_) <- tcSplitTyConApp_maybe ty - return (tyConName tc == integerTyConName) - isTupleTy ty = fromMaybe False $ do (tc,_) <- tcSplitTyConApp_maybe ty return (isBoxedTupleTyCon tc) @@ -450,6 +445,10 @@ cPprTermBase y = (tc,_) <- tcSplitTyConApp_maybe ty return (a_tc == tc) + isIntegerTy ty = fromMaybe False $ do + (tc,_) <- tcSplitTyConApp_maybe ty + return (tyConName tc == integerTyConName) + coerceShow f _p = return . text . show . f . unsafeCoerce# . val --Note pprinting of list terms is not lazy @@ -859,7 +858,7 @@ improveRTTIType hsc_env _ty rtti_ty = runTR_maybe hsc_env $ do (ty_tvs, _, _) <- tcInstType return ty (ty_tvs', _, ty') <- tcInstType (mapM tcInstTyVar) ty (_, _, rtti_ty') <- tcInstType (mapM tcInstTyVar) (sigmaType rtti_ty) - getLIE(boxyUnify rtti_ty' ty') + _ <- getLIE(boxyUnify rtti_ty' ty') tvs1_contents <- zonkTcTyVars ty_tvs' let subst = (uncurry zipTopTvSubst . unzip) [(tv,ty) | (tv,ty) <- zip ty_tvs tvs1_contents @@ -1099,7 +1098,7 @@ congruenceNewtypes lhs rhs = go lhs rhs >>= \rhs' -> return (lhs,rhs') text " in presence of newtype evidence " <> ppr new_tycon) vars <- mapM (newVar . tyVarKind) (tyConTyVars new_tycon) let ty' = mkTyConApp new_tycon vars - liftTcM (boxyUnify ty (repType ty')) + _ <- liftTcM (boxyUnify ty (repType ty')) -- assumes that reptype doesn't ^^^^ touch tyconApp args return ty'