From: simonpj@microsoft.com <unknown>
Date: Tue, 23 Sep 2008 13:54:19 +0000 (+0000)
Subject: Improve crash message from applyTys and applyTypeToArgs
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=35fb5c6ff0861be5ab72df799df536982d3966b8

Improve crash message from applyTys and applyTypeToArgs
---

diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs
index f44967e..44ca27a 100644
--- a/compiler/coreSyn/CoreUtils.lhs
+++ b/compiler/coreSyn/CoreUtils.lhs
@@ -154,7 +154,8 @@ applyTypeToArgs e op_ty (Type ty : args)
     go rev_tys rest_args        = applyTypeToArgs e op_ty' rest_args
 			 	where
 				  op_ty' = applyTysD msg op_ty (reverse rev_tys)
-				  msg = panic_msg e op_ty
+				  msg = ptext (sLit "applyTypeToArgs") <+> 
+		    			panic_msg e op_ty
 
 applyTypeToArgs e op_ty (_ : args)
   = case (splitFunTy_maybe op_ty) of
diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs
index cf38146..e2405a8 100644
--- a/compiler/types/Type.lhs
+++ b/compiler/types/Type.lhs
@@ -739,8 +739,8 @@ applyTysD doc orig_fun_ty arg_tys
 		(mkForAllTys (drop n_args tvs) rho_ty)
   | otherwise		-- Too many type args
   = 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)
+    applyTysD doc (substTyWith tvs (take n_tvs arg_tys) rho_ty)
+	          (drop n_tvs arg_tys)
   where
     (tvs, rho_ty) = splitForAllTys orig_fun_ty 
     n_tvs = length tvs