From 3c8e76dc677b4b427c7696f0f563224b548bf43b Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Thu, 19 Apr 2007 11:53:37 +0000 Subject: [PATCH] add some DEBUG assertions --- compiler/basicTypes/DataCon.lhs | 17 ++++++++++------- compiler/ghci/RtClosureInspect.hs | 11 ++++++----- 2 files changed, 16 insertions(+), 12 deletions(-) diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs index c75f1b4..5211fc8 100644 --- a/compiler/basicTypes/DataCon.lhs +++ b/compiler/basicTypes/DataCon.lhs @@ -644,10 +644,12 @@ dataConInstArgTys :: DataCon -- NB: these INCLUDE the existentially quantified dict args -- but EXCLUDE the data-decl context which is discarded -- It's all post-flattening etc; this is a representation type -dataConInstArgTys (MkData {dcRepArgTys = arg_tys, - dcUnivTyVars = univ_tvs, - dcExTyVars = ex_tvs}) inst_tys - = ASSERT( length tyvars == length inst_tys ) +dataConInstArgTys dc@(MkData {dcRepArgTys = arg_tys, + dcUnivTyVars = univ_tvs, + dcExTyVars = ex_tvs}) inst_tys + = ASSERT2 ( length tyvars == length inst_tys + , ptext SLIT("dataConInstArgTys") <+> ppr dc $$ ppr tyvars $$ ppr inst_tys) + map (substTyWith tyvars inst_tys) arg_tys where tyvars = univ_tvs ++ ex_tvs @@ -656,9 +658,10 @@ dataConInstArgTys (MkData {dcRepArgTys = arg_tys, -- And the same deal for the original arg tys dataConInstOrigArgTys :: DataCon -> [Type] -> [Type] dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys, - dcUnivTyVars = univ_tvs, - dcExTyVars = ex_tvs}) inst_tys - = ASSERT2( length tyvars == length inst_tys, ptext SLIT("dataConInstOrigArgTys") <+> ppr dc <+> ppr inst_tys ) + dcUnivTyVars = univ_tvs, + dcExTyVars = ex_tvs}) inst_tys + = ASSERT2( length tyvars == length inst_tys + , ptext SLIT("dataConInstOrigArgTys") <+> ppr dc $$ ppr tyvars $$ ppr inst_tys ) map (substTyWith tyvars inst_tys) arg_tys where tyvars = univ_tvs ++ ex_tvs diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs index 96edf90..aecd00c 100644 --- a/compiler/ghci/RtClosureInspect.hs +++ b/compiler/ghci/RtClosureInspect.hs @@ -555,11 +555,12 @@ cvObtainTerm1 hsc_env force mb_ty hval = runTR hsc_env $ do -- correct order. reOrderTerms _ _ [] = [] reOrderTerms pointed unpointed (ty:tys) - | isPointed ty = head pointed : reOrderTerms (tailSafe "reorderTerms1" pointed) unpointed tys - | otherwise = head unpointed : reOrderTerms pointed (tailSafe "reorderTerms2" unpointed) tys - -tailSafe msg [] = error msg -tailSafe _ (x:xs) = xs + | isPointed ty = ASSERT2(not(null pointed) + , ptext SLIT("reOrderTerms") $$ (ppr pointed $$ ppr unpointed)) + head pointed : reOrderTerms (tail pointed) unpointed tys + | otherwise = ASSERT2(not(null unpointed) + , ptext SLIT("reOrderTerms") $$ (ppr pointed $$ ppr unpointed)) + head unpointed : reOrderTerms pointed (tail unpointed) tys isMonomorphic = isEmptyVarSet . tyVarsOfType -- 1.7.10.4