X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcPat.lhs;h=ff08a2880c6cb529c1259513de86d68b161c40eb;hb=970d5b88b1554bbdd7e459dae41aab3668ae897a;hp=5384e4afbc095da6bfcd4603ff16671ca68768d8;hpb=ffd3438020584591b1c73d44bb1f1a731402cfe6;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs
index 5384e4a..ff08a28 100644
--- a/compiler/typecheck/TcPat.lhs
+++ b/compiler/typecheck/TcPat.lhs
@@ -34,6 +34,7 @@ import Type
 import StaticFlags
 import TyCon
 import DataCon
+import DynFlags
 import PrelNames
 import BasicTypes hiding (SuccessFlag(..))
 import SrcLoc
@@ -729,8 +730,11 @@ refineAlt con pstate ex_tvs [] pat_ty
   = return pstate	-- Common case: no equational constraints
 
 refineAlt con pstate ex_tvs co_vars pat_ty
-  | not (isRigidTy pat_ty)
-  = failWithTc (nonRigidMatch con)
+  = do	{ opt_gadt <- doptM Opt_GADTs	-- No type-refinement unless GADTs are on
+	; if (not opt_gadt) then return pstate
+	  else do 
+
+	{ checkTc (isRigidTy pat_ty) (nonRigidMatch con)
 	-- We are matching against a GADT constructor with non-trivial
 	-- constraints, but pattern type is wobbly.  For now we fail.
 	-- We can make sense of this, however:
@@ -745,8 +749,8 @@ refineAlt con pstate ex_tvs co_vars pat_ty
 	-- then unify these constraints to make pat_ty the right shape;
 	-- then proceed exactly as in the rigid case
 
-  | otherwise	-- In the rigid case, we perform type refinement
-  = case gadtRefine (pat_reft pstate) ex_tvs co_vars of {
+		-- In the rigid case, we perform type refinement
+	; case gadtRefine (pat_reft pstate) ex_tvs co_vars of {
 	    Failed msg     -> failWithTc (inaccessibleAlt msg) ;
 	    Succeeded reft -> do { traceTc trace_msg
 			  	 ; return (pstate { pat_reft = reft }) }
@@ -758,7 +762,7 @@ refineAlt con pstate ex_tvs co_vars pat_ty
 				vcat [ ppr con <+> ppr ex_tvs,
 				       ppr [(v, tyVarKind v) | v <- co_vars],
 				       ppr reft]
-	}
+	} } }
 \end{code}