--- tcHsPred is happy with a partial application, e.g. (ST s)
--- Used from TcDeriv
-tcHsPred pred
- = do { (kinded_pred,_) <- wrapLocFstM kc_pred pred -- kc_pred rather than kcHsPred
- -- to avoid the partial application check
- ; dsHsPred kinded_pred }
+-- Used for the deriving(...) items
+tcHsDeriv :: LHsType Name -> TcM ([TyVar], Class, [Type])
+tcHsDeriv = addLocM (tc_hs_deriv [])
+
+tc_hs_deriv tv_names (HsPredTy (L _ (HsClassP cls_name hs_tys)))
+ = kcHsTyVars tv_names $ \ tv_names' ->
+ do { cls_kind <- kcClass cls_name
+ ; (tys, res_kind) <- kcApps cls_kind (ppr cls_name) hs_tys
+ ; tcTyVarBndrs tv_names' $ \ tyvars ->
+ do { arg_tys <- dsHsTypes tys
+ ; cls <- tcLookupClass cls_name
+ ; return (tyvars, cls, arg_tys) }}
+
+tc_hs_deriv tv_names1 (HsForAllTy _ tv_names2 (L _ []) (L _ ty))
+ = -- Funny newtype deriving form
+ -- forall a. C [a]
+ -- where C has arity 2. Hence can't use regular functions
+ tc_hs_deriv (tv_names1 ++ tv_names2) ty
+
+tc_hs_deriv _ other
+ = failWithTc (ptext SLIT("Illegal deriving item") <+> ppr other)