RTS tidyup sweep, first phase

[ghc-hetmet.git] / compiler / ghci / RtClosureInspect.hs

diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index 95c8c91..c0b9140 100644 (file)
--- a/compiler/ghci/RtClosureInspect.hs
+++ b/compiler/ghci/RtClosureInspect.hs
@@ -54,7 +54,7 @@ import TysWiredIn
 import DynFlags
 import Outputable
 import FastString
 import DynFlags
 import Outputable
 import FastString

-import Panic
+-- import Panic

 
 import Constants        ( wORD_SIZE )
 
 
 import Constants        ( wORD_SIZE )
 

@@ -76,9 +76,8 @@ import qualified Data.Sequence as Seq
 import Data.Monoid
 import Data.Sequence hiding (null, length, index, take, drop, splitAt, reverse)
 import Foreign
 import Data.Monoid
 import Data.Sequence hiding (null, length, index, take, drop, splitAt, reverse)
 import Foreign

-import System.IO.Unsafe
+-- import System.IO.Unsafe

 
 

-import System.IO

 ---------------------------------------------
 -- * A representation of semi evaluated Terms
 ---------------------------------------------
 ---------------------------------------------
 -- * A representation of semi evaluated Terms
 ---------------------------------------------

@@ -166,7 +165,7 @@ data Closure = Closure { tipe         :: ClosureType
 instance Outputable ClosureType where
   ppr = text . show 
 
 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
 
 aP_CODE, pAP_CODE :: Int
 aP_CODE = AP

@@ -386,10 +385,8 @@ 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 
   | Just (tc,_) <- tcSplitTyConApp_maybe ty
   , ASSERT(isNewTyCon tc) True
   , Just new_dc <- tyConSingleDataCon_maybe tc = do 

-         if integerDataConName == dataConName new_dc
-             then return $ text $ show $ (unsafeCoerce# $ val t :: Integer)
-             else 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"
 
 -------------------------------------------------------
 pprNewtypeWrap _ _ _ = panic "pprNewtypeWrap"
 
 -------------------------------------------------------

@@ -434,6 +431,7 @@ cPprTermBase y =
   , ifTerm (isTyCon charTyCon   . ty) (coerceShow$ \(a::Char)->a)
   , ifTerm (isTyCon floatTyCon  . ty) (coerceShow$ \(a::Float)->a)
   , ifTerm (isTyCon doubleTyCon . ty) (coerceShow$ \(a::Double)->a)
   , ifTerm (isTyCon charTyCon   . ty) (coerceShow$ \(a::Char)->a)
   , ifTerm (isTyCon floatTyCon  . ty) (coerceShow$ \(a::Float)->a)
   , ifTerm (isTyCon doubleTyCon . ty) (coerceShow$ \(a::Double)->a)

+  , ifTerm (isIntegerTy         . ty) (coerceShow$ \(a::Integer)->a)

   ]
      where ifTerm pred f prec t@Term{}
                | pred t    = Just `liftM` f prec t
   ]
      where ifTerm pred f prec t@Term{}
                | pred t    = Just `liftM` f prec t

@@ -447,6 +445,10 @@ cPprTermBase y =
              (tc,_) <- tcSplitTyConApp_maybe ty
              return (a_tc == tc)
 
              (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
            coerceShow f _p = return . text . show . f . unsafeCoerce# . val
 
            --Note pprinting of list terms is not lazy

@@ -856,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)
     (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
     tvs1_contents     <- zonkTcTyVars ty_tvs'
     let subst = (uncurry zipTopTvSubst . unzip)
                  [(tv,ty) | (tv,ty) <- zip ty_tvs tvs1_contents

@@ -1096,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
                         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'
 
         -- assumes that reptype doesn't ^^^^ touch tyconApp args 
                return ty'