+ 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
+ { checkTc (notProcPat (pat_ctxt pstate))
+ (existentialProcPat data_con)
+ -- See Note [Arrows and patterns]
+
+ -- 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 explicitly or implicitly (by a GADT def) have 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'
+ no_equalities = not (any isEqPred theta')
+ pstate' | no_equalities = pstate
+ | otherwise = pstate { pat_eqs = True }
+
+ ; gadts_on <- doptM Opt_GADTs
+ ; checkTc (no_equalities || gadts_on)
+ (ptext (sLit "A pattern match on a GADT requires -XGADTs"))
+ -- Trac #2905 decided that a *pattern-match* of a GADT
+ -- should require the GADT language flag
+
+ ; unless no_equalities $ checkTc (isRigidTy pat_ty) $
+ nonRigidMatch (pat_ctxt pstate) data_con