Remove the unused HsExpr constructor DictPat

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

diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs
index 9d4c9b0..097402f 100644 (file)
--- 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
@@ -470,7 +471,7 @@ tc_pat pstate pat@(NPlusKPat (L nm_loc name) lit ge minus) pat_ty thing_inside
        ; res <- tcExtendIdEnv1 name bndr_id (thing_inside pstate)
        ; returnM (NPlusKPat (L nm_loc bndr_id) lit' ge' minus', [], res) }
 
-tc_pat _ _other_pat _ _ = panic "tc_pat"       -- DictPat, ConPatOut, SigPatOut, VarPatOut
+tc_pat _ _other_pat _ _ = panic "tc_pat"       -- ConPatOut, SigPatOut, VarPatOut
 \end{code}
 
 
@@ -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}
 
 
@@ -955,7 +959,7 @@ badTypePat pat = ptext SLIT("Illegal type pattern") <+> ppr pat
 
 lazyPatErr pat tvs
   = failWithTc $
-    hang (ptext SLIT("A lazy (~) pattern connot bind existential type variables"))
+    hang (ptext SLIT("A lazy (~) pattern cannot bind existential type variables"))
        2 (vcat (map pprSkolTvBinding tvs))
 
 nonRigidMatch con