diff options
| author | Manuel M T Chakravarty <chak@cse.unsw.edu.au> | 2008-07-15 05:27:51 +0000 |
|---|---|---|
| committer | Manuel M T Chakravarty <chak@cse.unsw.edu.au> | 2008-07-15 05:27:51 +0000 |
| commit | e0b93c022e39d07b871e9ed97d40617eb6bee63a (patch) | |
| tree | 2bfb7511c4689779390d7ffa476ac101b597f4f4 | |
| parent | af97da871e57bfd256f21e3c8bff5ef34b83f7ce (diff) | |
| download | haskell-Before_cabalised-GHC.tar.gz | |
Fix for 1st half of #2203Before_cabalised-GHC
| -rw-r--r-- | compiler/typecheck/TcMType.lhs | 34 |
1 files changed, 19 insertions, 15 deletions
diff --git a/compiler/typecheck/TcMType.lhs b/compiler/typecheck/TcMType.lhs index fc620ec3de..4cdbf0131d 100644 --- a/compiler/typecheck/TcMType.lhs +++ b/compiler/typecheck/TcMType.lhs @@ -1486,22 +1486,26 @@ checkValidInstHead ty -- Should be a source type check_inst_head :: DynFlags -> Class -> [Type] -> TcM () check_inst_head dflags clas tys - -- If GlasgowExts then check at least one isn't a type variable - = do checkTc (dopt Opt_TypeSynonymInstances dflags || - all tcInstHeadTyNotSynonym tys) - (instTypeErr (pprClassPred clas tys) head_type_synonym_msg) - checkTc (dopt Opt_FlexibleInstances dflags || - all tcInstHeadTyAppAllTyVars tys) - (instTypeErr (pprClassPred clas tys) head_type_args_tyvars_msg) - checkTc (dopt Opt_MultiParamTypeClasses dflags || - isSingleton tys) - (instTypeErr (pprClassPred clas tys) head_one_type_msg) - mapM_ check_mono_type tys + = do { -- If GlasgowExts then check at least one isn't a type variable + ; checkTc (dopt Opt_TypeSynonymInstances dflags || + all tcInstHeadTyNotSynonym tys) + (instTypeErr (pprClassPred clas tys) head_type_synonym_msg) + ; checkTc (dopt Opt_FlexibleInstances dflags || + all tcInstHeadTyAppAllTyVars tys) + (instTypeErr (pprClassPred clas tys) head_type_args_tyvars_msg) + ; checkTc (dopt Opt_MultiParamTypeClasses dflags || + isSingleton tys) + (instTypeErr (pprClassPred clas tys) head_one_type_msg) + -- May not contain type family applications + ; mapM_ checkTyFamFreeness tys + + ; mapM_ check_mono_type tys -- For now, I only allow tau-types (not polytypes) in -- the head of an instance decl. -- E.g. instance C (forall a. a->a) is rejected -- One could imagine generalising that, but I'm not sure -- what all the consequences might be + } where head_type_synonym_msg = parens ( @@ -1719,7 +1723,7 @@ checkFamInst lhsTys famInsts checkTyFamFreeness :: Type -> TcM () checkTyFamFreeness ty = checkTc (isTyFamFree ty) $ - tyFamInstInIndexErr ty + tyFamInstIllegalErr ty -- Check that a type does not contain any type family applications. -- @@ -1728,9 +1732,9 @@ isTyFamFree = null . tyFamInsts -- Error messages -tyFamInstInIndexErr :: Type -> SDoc -tyFamInstInIndexErr ty - = hang (ptext (sLit "Illegal type family application in type instance") <> +tyFamInstIllegalErr :: Type -> SDoc +tyFamInstIllegalErr ty + = hang (ptext (sLit "Illegal type synonym family application in instance") <> colon) 4 $ ppr ty |