X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRules.lhs;h=0a2babe3f81f448b5053be15a0b7cf247975495b;hb=4e5faff9152918cd00dcdad9068b0f1eba1fcd68;hp=c7e951f343fa17a9d0e3de1bc9ae6fb87a9f2fca;hpb=5a8a219c131b56c75dbb3110da3ab5ae3715ff66;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcRules.lhs b/compiler/typecheck/TcRules.lhs
index c7e951f..0a2babe 100644
--- a/compiler/typecheck/TcRules.lhs
+++ b/compiler/typecheck/TcRules.lhs
@@ -1,25 +1,27 @@
 %
+% (c) The University of Glasgow 2006
 % (c) The AQUA Project, Glasgow University, 1993-1998
 %
-\section[TcRules]{Typechecking transformation rules}
+
+TcRules: Typechecking transformation rules
 
 \begin{code}
 module TcRules ( tcRules ) where
 
 #include "HsVersions.h"
 
-import HsSyn		( RuleDecl(..), LRuleDecl, RuleBndr(..), mkHsDictLet )
+import HsSyn
 import TcRnMonad
-import TcSimplify	( tcSimplifyRuleLhs, tcSimplifyInferCheck )
-import TcMType		( newFlexiTyVarTy, zonkQuantifiedTyVar, tcSkolSigTyVars )
-import TcType		( tyVarsOfTypes, openTypeKind, SkolemInfo(..), substTyWith, mkTyVarTys )
-import TcHsType		( UserTypeCtxt(..), tcHsPatSigType )
-import TcExpr		( tcMonoExpr )
-import TcEnv		( tcExtendIdEnv, tcExtendTyVarEnv )
-import Inst		( instToId )
-import Id		( idType, mkLocalId )
-import Name		( Name )
-import SrcLoc		( noLoc, unLoc )
+import TcSimplify
+import TcMType
+import TcType
+import TcHsType
+import TcExpr
+import TcEnv
+import Inst
+import Id
+import Name
+import SrcLoc
 import Outputable
 \end{code}
 
@@ -76,7 +78,8 @@ tcRule (HsRule name act vars lhs fv_lhs rhs fv_rhs)
 	--
 	-- NB: tcSimplifyInferCheck zonks the forall_tvs, and 
 	--     knocks out any that are constrained by the environment
-    tcSimplifyInferCheck (text "tcRule")
+    getInstLoc (SigOrigin (RuleSkol name))	`thenM` \ loc -> 
+    tcSimplifyInferCheck loc
 			 forall_tvs
 			 lhs_dicts rhs_lie	`thenM` \ (forall_tvs1, rhs_binds) ->
     mappM zonkQuantifiedTyVar forall_tvs1 	`thenM` \ forall_tvs2 ->
@@ -98,7 +101,7 @@ tcRuleBndrs (RuleBndrSig var rn_ty : vars) thing_inside
 --  e.g 	x :: a->a
 --  The tyvar 'a' is brought into scope first, just as if you'd written
 --		a::*, x :: a->a
-  = do	{ let ctxt = RuleSigCtxt (unLoc var)
+  = do	{ let ctxt = FunSigCtxt (unLoc var)
 	; (tyvars, ty) <- tcHsPatSigType ctxt rn_ty
 	; let skol_tvs = tcSkolSigTyVars (SigSkol ctxt) tyvars
 	      id_ty = substTyWith tyvars (mkTyVarTys skol_tvs) ty