diff options
| author | Ian Lynagh <igloo@earth.li> | 2009-06-23 00:19:46 +0000 |
|---|---|---|
| committer | Ian Lynagh <igloo@earth.li> | 2009-06-23 00:19:46 +0000 |
| commit | 8ddc86a0af37093d6939a30f0912753c88d5ad0e (patch) | |
| tree | 73af7d7f27241d81f962af2e733fc64806b9e44a /compiler | |
| parent | 5d94414cbf9b164400651864a24826d8ee42c3f5 (diff) | |
| download | haskell-8ddc86a0af37093d6939a30f0912753c88d5ad0e.tar.gz | |
Fix the GHCi debugger so that it can recognise Integers again
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/ghci/RtClosureInspect.hs | 13 | ||||
| -rw-r--r-- | 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 f90b1ca03c..95c8c91092 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 6fb64baff8..4c13965c13 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 |