Fix the GHCi debugger so that it can recognise Integers again

diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index f90b1ca..95c8c91 100644 (file)
--- a/compiler/ghci/RtClosureInspect.hs
+++ b/compiler/ghci/RtClosureInspect.hs
@@ -382,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"
 
 -------------------------------------------------------
@@ -432,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)

diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
index 6fb64ba..4c13965 100644 (file)
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -111,7 +111,7 @@ basicKnownKeyNames
        stringTyConName,
        ratioDataConName,
        ratioTyConName,
-       integerTyConName, smallIntegerName,
+       integerTyConName, smallIntegerName, integerDataConName,
 
        --  Classes.  *Must* include:
        --      classes that are grabbed by key (e.g., eqClassKey)
@@ -633,7 +633,8 @@ sndName               = varQual dATA_TUPLE (fsLit "snd") sndIdKey
 
 -- Module PrelNum
 numClassName, fromIntegerName, minusName, negateName, plusIntegerName,
-    timesIntegerName, integerTyConName, smallIntegerName :: Name
+    timesIntegerName,
+    integerTyConName, integerDataConName, smallIntegerName :: Name
 numClassName     = clsQual  gHC_NUM (fsLit "Num") numClassKey
 fromIntegerName   = methName gHC_NUM (fsLit "fromInteger") fromIntegerClassOpKey
 minusName        = methName gHC_NUM (fsLit "-") minusClassOpKey
@@ -641,6 +642,7 @@ negateName    = methName gHC_NUM (fsLit "negate") negateClassOpKey
 plusIntegerName   = varQual  gHC_INTEGER (fsLit "plusInteger") plusIntegerIdKey
 timesIntegerName  = varQual  gHC_INTEGER (fsLit "timesInteger") timesIntegerIdKey
 integerTyConName  = tcQual   gHC_INTEGER (fsLit "Integer") integerTyConKey
+integerDataConName  = conName gHC_INTEGER (fsLit "Integer") integerDataConKey
 smallIntegerName = varQual gHC_INTEGER (fsLit "smallInteger") smallIntegerIdKey
 
 -- PrelReal types and classes
@@ -1062,7 +1064,7 @@ unitTyConKey = mkTupleTyConUnique Boxed 0
 charDataConKey, consDataConKey, doubleDataConKey, falseDataConKey,
     floatDataConKey, intDataConKey, nilDataConKey, ratioDataConKey,
     stableNameDataConKey, trueDataConKey, wordDataConKey,
-    ioDataConKey :: Unique
+    ioDataConKey, integerDataConKey :: Unique
 charDataConKey                         = mkPreludeDataConUnique  1
 consDataConKey                         = mkPreludeDataConUnique  2
 doubleDataConKey                       = mkPreludeDataConUnique  3
@@ -1075,6 +1077,7 @@ stableNameDataConKey                      = mkPreludeDataConUnique 14
 trueDataConKey                         = mkPreludeDataConUnique 15
 wordDataConKey                         = mkPreludeDataConUnique 16
 ioDataConKey                           = mkPreludeDataConUnique 17
+integerDataConKey                      = mkPreludeDataConUnique 18
 
 -- Generic data constructors
 crossDataConKey, inlDataConKey, inrDataConKey, genUnitDataConKey :: Unique