diff options
Diffstat (limited to 'compiler/typecheck/TcValidity.lhs')
| -rw-r--r-- | compiler/typecheck/TcValidity.lhs | 19 |
1 files changed, 15 insertions, 4 deletions
diff --git a/compiler/typecheck/TcValidity.lhs b/compiler/typecheck/TcValidity.lhs index 8381533a28..288c202b58 100644 --- a/compiler/typecheck/TcValidity.lhs +++ b/compiler/typecheck/TcValidity.lhs @@ -37,6 +37,7 @@ import HsSyn -- HsType import TcRnMonad -- TcType, amongst others import FunDeps import Name +import PrelNames import VarEnv import VarSet import ErrUtils @@ -766,7 +767,7 @@ checkValidInstHead :: UserTypeCtxt -> Class -> [Type] -> TcM () checkValidInstHead ctxt clas cls_args = do { dflags <- getDynFlags - ; checkTc (clas `notElem` abstractClasses) + ; checkTc (classKey clas `notElem` abstractClasses) (instTypeErr clas cls_args abstract_class_msg) -- Check language restrictions; @@ -817,8 +818,9 @@ checkValidInstHead ctxt clas cls_args abstract_class_msg = text "The class is abstract, manual instances are not permitted." -abstractClasses :: [ Class ] -abstractClasses = [ coercibleClass ] -- See Note [Coercible Instances] +abstractClasses :: [ Unique ] +abstractClasses = [ classKey coercibleClass, recordHasClassNameKey, recordUpdClassNameKey ] + -- See Note [Coercible Instances] instTypeErr :: Class -> [Type] -> SDoc -> SDoc instTypeErr cls tys msg @@ -1117,7 +1119,11 @@ checkValidTyFamInst mb_clsinfo fam_tc (CoAxBranch { cab_tvs = tvs, cab_lhs = typats , cab_rhs = rhs, cab_loc = loc }) = setSrcSpan loc $ - do { checkValidFamPats fam_tc tvs typats + do { -- Check it's not an OverloadedRecordFields family + ; checkTc (not (isRecordsFam fam_tc)) + (recordsFamInstErr fam_tc) + + ; checkValidFamPats fam_tc tvs typats -- The argument patterns, and RHS, are all boxed tau types -- E.g Reject type family F (a :: k1) :: k2 @@ -1222,6 +1228,11 @@ famPatErr fam_tc tvs pats nestedMsg, smallerAppMsg :: SDoc nestedMsg = ptext (sLit "Nested type family application") smallerAppMsg = ptext (sLit "Application is no smaller than the instance head") + +recordsFamInstErr :: TyCon -> SDoc +recordsFamInstErr fam_tc + = hang (ptext (sLit "Illegal type instance declaration for") <+> quotes (ppr fam_tc)) + 2 (ptext (sLit "(Use -XOverloadedRecordFields instead.)")) \end{code} %************************************************************************ |