relaxed instance termination test

[ghc-hetmet.git] / ghc / compiler / typecheck / TcInstDcls.lhs

diff --git a/ghc/compiler/typecheck/TcInstDcls.lhs b/ghc/compiler/typecheck/TcInstDcls.lhs
index 88dcd8e..3fec58d 100644 (file)
--- a/ghc/compiler/typecheck/TcInstDcls.lhs
+++ b/ghc/compiler/typecheck/TcInstDcls.lhs
@@ -13,7 +13,8 @@ import TcBinds                ( mkPragFun, tcPrags, badBootDeclErr )
 import TcClassDcl      ( tcMethodBind, mkMethodBind, badMethodErr, 
                          tcClassDecl2, getGenericInstances )
 import TcRnMonad       
-import TcMType         ( tcSkolSigType, checkValidTheta, checkValidInstHead, instTypeErr, 
+import TcMType         ( tcSkolSigType, checkValidTheta, checkValidInstHead,
+                         checkInstTermination, instTypeErr, 
                          checkAmbiguity, SourceTyCtxt(..) )
 import TcType          ( mkClassPred, tyVarsOfType, 
                          tcSplitSigmaTy, tcSplitDFunHead, mkTyVarTys,
@@ -195,6 +196,7 @@ tcLocalInstDecl1 decl@(L loc (InstDecl poly_ty binds uprags))
     checkValidTheta InstThetaCtxt theta                        `thenM_`
     checkAmbiguity tyvars theta (tyVarsOfType tau)     `thenM_`
     checkValidInstHead tau                             `thenM` \ (clas,inst_tys) ->
+    checkInstTermination theta inst_tys                        `thenM_`
     checkTc (checkInstFDs theta clas inst_tys)
            (instTypeErr (pprClassPred clas inst_tys) msg)      `thenM_`
     newDFunName clas inst_tys (srcSpanStart loc)               `thenM` \ dfun_name ->