X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FRtClosureInspect.hs;h=c0b91405254d45cecc66447e32eddf81061766ea;hb=a2a67cd520b9841114d69a87a423dabcb3b4368e;hp=95c8c910921617da4e6aa5d572c9d4f51eb99fb6;hpb=8ddc86a0af37093d6939a30f0912753c88d5ad0e;p=ghc-hetmet.git

diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index 95c8c91..c0b9140 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 )
 
@@ -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 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
@@ -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 
-         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"
 
 -------------------------------------------------------
@@ -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 (isIntegerTy         . ty) (coerceShow$ \(a::Integer)->a)
   ]
      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)
 
+           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
@@ -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)
-    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
@@ -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
-               liftTcM (boxyUnify ty (repType ty'))
+               _ <- liftTcM (boxyUnify ty (repType ty'))
         -- assumes that reptype doesn't ^^^^ touch tyconApp args 
                return ty'