From 55a95e74e844fee27a9990beb9350b033a4e1344 Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Fri, 5 Sep 2008 17:16:39 +0000
Subject: [PATCH] Better debug panic messages in applyTys

---
 compiler/coreSyn/CoreUtils.lhs |    8 ++++++--
 compiler/types/Type.lhs        |   11 +++++++----
 2 files changed, 13 insertions(+), 6 deletions(-)

diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs
index a769dcd..07709c8 100644
--- a/compiler/coreSyn/CoreUtils.lhs
+++ b/compiler/coreSyn/CoreUtils.lhs
@@ -154,12 +154,16 @@ applyTypeToArgs e op_ty (Type ty : args)
     go rev_tys (Type ty : args) = go (ty:rev_tys) args
     go rev_tys rest_args        = applyTypeToArgs e op_ty' rest_args
 			 	where
-				  op_ty' = applyTys op_ty (reverse rev_tys)
+				  op_ty' = applyTysD msg op_ty (reverse rev_tys)
+				  msg = panic_msg e op_ty
 
 applyTypeToArgs e op_ty (_ : args)
   = case (splitFunTy_maybe op_ty) of
 	Just (_, res_ty) -> applyTypeToArgs e res_ty args
-	Nothing -> pprPanic "applyTypeToArgs" (pprCoreExpr e $$ ppr op_ty)
+	Nothing -> pprPanic "applyTypeToArgs" (panic_msg e op_ty)
+
+panic_msg :: CoreExpr -> Type -> SDoc
+panic_msg e op_ty = pprCoreExpr e $$ ppr op_ty
 \end{code}
 
 %************************************************************************
diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs
index 63633e9..7163079 100644
--- a/compiler/types/Type.lhs
+++ b/compiler/types/Type.lhs
@@ -39,7 +39,7 @@ module Type (
         splitNewTyConApp_maybe, splitNewTyConApp,
 
         mkForAllTy, mkForAllTys, splitForAllTy_maybe, splitForAllTys, 
-	applyTy, applyTys, isForAllTy, dropForAlls,
+	applyTy, applyTys, applyTysD, isForAllTy, dropForAlls,
 	
 	-- (Newtypes)
 	newTyConInstRhs,
@@ -742,15 +742,18 @@ applyTys :: Type -> [Type] -> Type
 -- > foo = case undefined :: R of
 -- >            R f -> f ()
 
-applyTys orig_fun_ty []      = orig_fun_ty
-applyTys orig_fun_ty arg_tys 
+applyTys ty args = applyTysD empty ty args
+
+applyTysD :: SDoc -> Type -> [Type] -> Type	-- Debug version
+applyTysD _   orig_fun_ty []      = orig_fun_ty
+applyTysD doc orig_fun_ty arg_tys 
   | n_tvs == n_args 	-- The vastly common case
   = substTyWith tvs arg_tys rho_ty
   | n_tvs > n_args 	-- Too many for-alls
   = substTyWith (take n_args tvs) arg_tys 
 		(mkForAllTys (drop n_args tvs) rho_ty)
   | otherwise		-- Too many type args
-  = ASSERT2( n_tvs > 0, ppr orig_fun_ty )	-- Zero case gives infnite loop!
+  = ASSERT2( n_tvs > 0, doc $$ ppr orig_fun_ty )	-- Zero case gives infnite loop!
     applyTys (substTyWith tvs (take n_tvs arg_tys) rho_ty)
 	     (drop n_tvs arg_tys)
   where
-- 
1.7.10.4