Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Fix for 1st half of #2203

  • Loading branch information...
commit e0b93c022e39d07b871e9ed97d40617eb6bee63a 1 parent af97da8
Manuel M T Chakravarty mchakravarty authored

Showing 1 changed file with 19 additions and 15 deletions. Show diff stats Hide diff stats

  1. +19 15 compiler/typecheck/TcMType.lhs
34 compiler/typecheck/TcMType.lhs
@@ -1486,22 +1486,26 @@ checkValidInstHead ty -- Should be a source type
1486 1486
1487 1487 check_inst_head :: DynFlags -> Class -> [Type] -> TcM ()
1488 1488 check_inst_head dflags clas tys
1489   - -- If GlasgowExts then check at least one isn't a type variable
1490   - = do checkTc (dopt Opt_TypeSynonymInstances dflags ||
1491   - all tcInstHeadTyNotSynonym tys)
1492   - (instTypeErr (pprClassPred clas tys) head_type_synonym_msg)
1493   - checkTc (dopt Opt_FlexibleInstances dflags ||
1494   - all tcInstHeadTyAppAllTyVars tys)
1495   - (instTypeErr (pprClassPred clas tys) head_type_args_tyvars_msg)
1496   - checkTc (dopt Opt_MultiParamTypeClasses dflags ||
1497   - isSingleton tys)
1498   - (instTypeErr (pprClassPred clas tys) head_one_type_msg)
1499   - mapM_ check_mono_type tys
  1489 + = do { -- If GlasgowExts then check at least one isn't a type variable
  1490 + ; checkTc (dopt Opt_TypeSynonymInstances dflags ||
  1491 + all tcInstHeadTyNotSynonym tys)
  1492 + (instTypeErr (pprClassPred clas tys) head_type_synonym_msg)
  1493 + ; checkTc (dopt Opt_FlexibleInstances dflags ||
  1494 + all tcInstHeadTyAppAllTyVars tys)
  1495 + (instTypeErr (pprClassPred clas tys) head_type_args_tyvars_msg)
  1496 + ; checkTc (dopt Opt_MultiParamTypeClasses dflags ||
  1497 + isSingleton tys)
  1498 + (instTypeErr (pprClassPred clas tys) head_one_type_msg)
  1499 + -- May not contain type family applications
  1500 + ; mapM_ checkTyFamFreeness tys
  1501 +
  1502 + ; mapM_ check_mono_type tys
1500 1503 -- For now, I only allow tau-types (not polytypes) in
1501 1504 -- the head of an instance decl.
1502 1505 -- E.g. instance C (forall a. a->a) is rejected
1503 1506 -- One could imagine generalising that, but I'm not sure
1504 1507 -- what all the consequences might be
  1508 + }
1505 1509
1506 1510 where
1507 1511 head_type_synonym_msg = parens (
@@ -1719,7 +1723,7 @@ checkFamInst lhsTys famInsts
1719 1723 checkTyFamFreeness :: Type -> TcM ()
1720 1724 checkTyFamFreeness ty
1721 1725 = checkTc (isTyFamFree ty) $
1722   - tyFamInstInIndexErr ty
  1726 + tyFamInstIllegalErr ty
1723 1727
1724 1728 -- Check that a type does not contain any type family applications.
1725 1729 --
@@ -1728,9 +1732,9 @@ isTyFamFree = null . tyFamInsts
1728 1732
1729 1733 -- Error messages
1730 1734
1731   -tyFamInstInIndexErr :: Type -> SDoc
1732   -tyFamInstInIndexErr ty
1733   - = hang (ptext (sLit "Illegal type family application in type instance") <>
  1735 +tyFamInstIllegalErr :: Type -> SDoc
  1736 +tyFamInstIllegalErr ty
  1737 + = hang (ptext (sLit "Illegal type synonym family application in instance") <>
1734 1738 colon) 4 $
1735 1739 ppr ty
1736 1740

0 comments on commit e0b93c0

Please sign in to comment.
Something went wrong with that request. Please try again.