From: simonpj <unknown>
Date: Tue, 14 Aug 2001 15:37:55 +0000 (+0000)
Subject: [project @ 2001-08-14 15:37:55 by simonpj]
X-Git-Tag: Approximately_9120_patches~1261
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=2b09da898f6f208ab6407aa5507fb11cf24a562e;p=ghc-hetmet.git

[project @ 2001-08-14 15:37:55 by simonpj]
Wibbles to the checking-types commit
---

diff --git a/ghc/compiler/typecheck/TcMType.lhs b/ghc/compiler/typecheck/TcMType.lhs
index cd26d59..df60bee 100644
--- a/ghc/compiler/typecheck/TcMType.lhs
+++ b/ghc/compiler/typecheck/TcMType.lhs
@@ -546,15 +546,17 @@ data UserTypeCtxt
   | ResSigCtxt		-- Result type sig
 			-- 	f x :: t = ....
   | ForSigCtxt Name	-- Foreign inport or export signature
-
-pprUserTypeCtxt (FunSigCtxt n) = ptext SLIT("the type signature for") <+> quotes (ppr n)
-pprUserTypeCtxt ExprSigCtxt    = ptext SLIT("an expression type signature")
-pprUserTypeCtxt (ConArgCtxt c) = ptext SLIT("the type of constructor") <+> quotes (ppr c)
-pprUserTypeCtxt (TySynCtxt c)  = ptext SLIT("the RHS of a type synonym declaration") <+> quotes (ppr c)
-pprUserTypeCtxt GenPatCtxt     = ptext SLIT("the type pattern of a generic definition")
-pprUserTypeCtxt PatSigCtxt     = ptext SLIT("a pattern type signature")
-pprUserTypeCtxt ResSigCtxt     = ptext SLIT("a result type signature")
-pprUserTypeCtxt (ForSigCtxt n) = ptext SLIT("the foreign signature for") <+> quotes (ppr n)
+  | RuleSigCtxt Name 	-- Signature on a forall'd variable in a RULE
+
+pprUserTypeCtxt (FunSigCtxt n) 	= ptext SLIT("the type signature for") <+> quotes (ppr n)
+pprUserTypeCtxt ExprSigCtxt    	= ptext SLIT("an expression type signature")
+pprUserTypeCtxt (ConArgCtxt c) 	= ptext SLIT("the type of constructor") <+> quotes (ppr c)
+pprUserTypeCtxt (TySynCtxt c)  	= ptext SLIT("the RHS of a type synonym declaration") <+> quotes (ppr c)
+pprUserTypeCtxt GenPatCtxt     	= ptext SLIT("the type pattern of a generic definition")
+pprUserTypeCtxt PatSigCtxt     	= ptext SLIT("a pattern type signature")
+pprUserTypeCtxt ResSigCtxt     	= ptext SLIT("a result type signature")
+pprUserTypeCtxt (ForSigCtxt n) 	= ptext SLIT("the foreign signature for") <+> quotes (ppr n)
+pprUserTypeCtxt (RuleSigCtxt n) = ptext SLIT("the type signature on") <+> quotes (ppr n)
 \end{code}
 
 \begin{code}
@@ -575,6 +577,7 @@ checkValidType ctxt ty
 		 TySynCtxt _  | gla_exts  -> 1
 			      | otherwise -> 0
 		 ForSigCtxt _		  -> 1
+		 RuleSigCtxt _		  -> 1
 
 	actual_kind = typeKind ty
 
@@ -666,9 +669,18 @@ check_tau_type rank ubx_tup_ok (NoteTy note ty)
   = check_note note `thenTc_` check_tau_type rank ubx_tup_ok ty
 
 check_tau_type rank ubx_tup_ok ty@(TyConApp tc tys)
-  = mapTc_ check_arg_type tys						`thenTc_`
-    checkTc (not (isSynTyCon tc)	  || syn_arity_ok) arity_msg	`thenTc_`
-    checkTc (not (isUnboxedTupleTyCon tc) || ubx_tup_ok)   ubx_tup_msg
+  | isSynTyCon tc
+  = checkTc syn_arity_ok arity_msg	`thenTc_`
+    mapTc_ check_arg_type tys
+    
+  | isUnboxedTupleTyCon tc
+  = checkTc ubx_tup_ok ubx_tup_msg	`thenTc_`
+    mapTc_ (check_tau_type 0 True) tys		-- Args are allowed to be unlifted, or
+						-- more unboxed tuples, so can't use check_arg_ty
+
+  | otherwise
+  = mapTc_ check_arg_type tys
+
   where
     syn_arity_ok = tc_arity <= n_args
 		-- It's OK to have an *over-applied* type synonym
diff --git a/ghc/compiler/typecheck/TcRules.lhs b/ghc/compiler/typecheck/TcRules.lhs
index 1566e44..d041fc9 100644
--- a/ghc/compiler/typecheck/TcRules.lhs
+++ b/ghc/compiler/typecheck/TcRules.lhs
@@ -133,9 +133,9 @@ tcSourceRule (HsRule name sig_tvs vars lhs rhs src_loc)
   where
     sig_tys = [t | RuleBndrSig _ t <- vars]
 
-    new_id (RuleBndr var) 	   = newTyVarTy openTypeKind		`thenNF_Tc` \ ty ->
+    new_id (RuleBndr var) 	   = newTyVarTy openTypeKind			`thenNF_Tc` \ ty ->
 		          	     returnNF_Tc (mkLocalId var ty)
-    new_id (RuleBndrSig var rn_ty) = tcHsSigType PatSigCtxt rn_ty	`thenTc` \ ty ->
+    new_id (RuleBndrSig var rn_ty) = tcHsSigType (RuleSigCtxt var) rn_ty	`thenTc` \ ty ->
 				     returnNF_Tc (mkLocalId var ty)
 
 ruleCtxt name = ptext SLIT("When checking the transformation rule") <+>