Commit 8ddc86a0 authored by Ian Lynagh's avatar Ian Lynagh

Fix the GHCi debugger so that it can recognise Integers again

parent 5d94414c
......@@ -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)
......
......@@ -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
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment