X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FRtClosureInspect.hs;h=84bdfecf7814fbf01f2510cbd50b6df6fd783c49;hb=9d0c8f842e35dde3d570580cf62a32779f66a6de;hp=4996fdb2b3ecbf4e003c282304dd8205b5f6e6a0;hpb=253c523f31a68f0e0e161928cc5e1de6250c2666;p=ghc-hetmet.git

diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index 4996fdb..84bdfec 100644
--- a/compiler/ghci/RtClosureInspect.hs
+++ b/compiler/ghci/RtClosureInspect.hs
@@ -60,7 +60,12 @@ import Constants        ( wORD_SIZE )
 
 import GHC.Arr          ( Array(..) )
 import GHC.Exts
-import GHC.IOBase ( IO(IO) )
+
+#if __GLASGOW_HASKELL__ >= 611
+import GHC.IO ( IO(..) )
+#else
+import GHC.IOBase ( IO(..) )
+#endif
 
 import Control.Monad
 import Data.Maybe
@@ -377,12 +382,14 @@ 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)
+         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)
 pprNewtypeWrap _ _ _ = panic "pprNewtypeWrap"
 
 -------------------------------------------------------
@@ -427,16 +434,11 @@ 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
            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)
@@ -854,7 +856,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
@@ -1094,7 +1096,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'