- eq_spec' = substEqSpec tenv eq_spec
- theta' = substTheta tenv theta
- arg_tys' = substTys tenv arg_tys
-
- ; co_vars <- newCoVars eq_spec' -- Make coercion variables
- ; pstate' <- refineAlt data_con pstate ex_tvs' co_vars pat_ty
+ arg_tys' = substTys tenv arg_tys
+
+ ; if null ex_tvs && null eq_spec && null full_theta
+ then do { -- The common case; no class bindings etc
+ -- (see Note [Arrows and patterns])
+ (arg_pats', inner_tvs, res) <- tcConArgs data_con arg_tys'
+ arg_pats pstate thing_inside
+ ; let res_pat = ConPatOut { pat_con = L con_span data_con,
+ pat_tvs = [], pat_dicts = [],
+ pat_binds = emptyLHsBinds,
+ pat_args = arg_pats',
+ pat_ty = pat_ty' }
+
+ ; return (wrap_res_pat res_pat, inner_tvs, res) }
+
+ else do -- The general case, with existential, and local equality
+ -- constraints
+ { let eq_preds = [mkEqPred (mkTyVarTy tv, ty) | (tv, ty) <- eq_spec]
+ theta' = substTheta tenv (eq_preds ++ full_theta)
+ -- order is *important* as we generate the list of
+ -- dictionary binders from theta'
+ ctxt = pat_ctxt pstate
+ ; checkTc (case ctxt of { ProcPat -> False; other -> True })
+ (existentialProcPat data_con)
+
+ -- Need to test for rigidity if *any* constraints in theta as class
+ -- constraints may have superclass equality constraints. However,
+ -- we don't want to check for rigidity if we got here only because
+ -- ex_tvs was non-null.
+-- ; unless (null theta') $
+ -- FIXME: AT THE MOMENT WE CHEAT! We only perform the rigidity test
+ -- if we explicit or implicit (by a GADT def) have equality
+ -- constraints.
+ ; unless (all (not . isEqPred) theta') $
+ checkTc (isRigidTy pat_ty) (nonRigidMatch data_con)