From 8ddc86a0af37093d6939a30f0912753c88d5ad0e Mon Sep 17 00:00:00 2001
From: Ian Lynagh <igloo@earth.li>
Date: Tue, 23 Jun 2009 00:19:46 +0000
Subject: [PATCH] Fix the GHCi debugger so that it can recognise Integers
 again

---
 compiler/ghci/RtClosureInspect.hs |   13 +++++--------
 compiler/prelude/PrelNames.lhs    |    9 ++++++---
 2 files changed, 11 insertions(+), 11 deletions(-)

diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index f90b1ca..95c8c91 100644
--- 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
--- 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
-- 
1.7.10.4