- kcHsSigType poly_ty `thenM` \ kinded_ty ->
- tcHsKindedType kinded_ty `thenM` \ poly_ty' ->
- let
- (tyvars, theta, tau) = tcSplitSigmaTy poly_ty'
- in
- checkValidTheta InstThetaCtxt theta `thenM_`
- checkAmbiguity tyvars theta (tyVarsOfType tau) `thenM_`
- checkValidInstHead tau `thenM` \ (clas,inst_tys) ->
- checkTc (checkInstFDs theta clas inst_tys)
- (instTypeErr (pprClassPred clas inst_tys) msg) `thenM_`
- newDFunName clas inst_tys (srcSpanStart loc) `thenM` \ dfun_name ->
- getOverlapFlag `thenM` \ overlap_flag ->
- let dfun = mkDictFunId dfun_name tyvars theta clas inst_tys
- ispec = mkLocalInstance dfun overlap_flag
- in
-
- tcIsHsBoot `thenM` \ is_boot ->
- checkTc (not is_boot || (isEmptyLHsBinds binds && null uprags))
- badBootDeclErr `thenM_`
-
- returnM (Just (InstInfo { iSpec = ispec, iBinds = VanillaInst binds uprags }))
- where
- msg = parens (ptext SLIT("the instance types do not agree with the functional dependencies of the class"))
+ ; kinded_ty <- kcHsSigType poly_ty
+ ; poly_ty' <- tcHsKindedType kinded_ty
+ ; let (tyvars, theta, tau) = tcSplitSigmaTy poly_ty'
+
+ ; (clas, inst_tys) <- checkValidInstHead tau
+ ; checkValidInstance tyvars theta clas inst_tys
+
+ ; dfun_name <- newDFunName clas inst_tys (srcSpanStart loc)
+ ; overlap_flag <- getOverlapFlag
+ ; let dfun = mkDictFunId dfun_name tyvars theta clas inst_tys
+ ispec = mkLocalInstance dfun overlap_flag
+
+ ; return (Just (InstInfo { iSpec = ispec, iBinds = VanillaInst binds uprags })) }