import SrcLoc
import Outputable
-import Control.Monad ( when )
+import Control.Monad ( when, unless )
import Data.List ( (\\) )
\end{code}
-- type Foo a = Tree [a]
-- f :: Foo a b -> ...
; case tcView ty of
- Just ty' -> check_tau_type rank ubx_tup ty' -- Check expansion
- Nothing -> failWithTc arity_msg
+ Just ty' -> check_tau_type rank ubx_tup ty' -- Check expansion
+ Nothing -> unless (isOpenTyCon tc -- No expansion if open
+ && tyConArity tc <= length tys) $
+ failWithTc arity_msg
; gla_exts <- doptM Opt_GlasgowExts
- ; if gla_exts then
- -- If -fglasgow-exts then don't check the type arguments
+ ; if gla_exts && not (isOpenTyCon tc) then
+ -- If -fglasgow-exts then don't check the type arguments of
+ -- *closed* synonyms.
-- This allows us to instantiate a synonym defn with a
-- for-all type, or with a partially-applied type synonym.
-- e.g. type T a b = a
-------------------------
check_pred_ty dflags ctxt pred@(ClassP cls tys)
- = -- Class predicates are valid in all contexts
- checkTc (arity == n_tys) arity_err `thenM_`
-
- -- Check the form of the argument types
- mappM_ check_arg_type tys `thenM_`
- checkTc (check_class_pred_tys dflags ctxt tys)
- (predTyVarErr pred $$ how_to_allow)
-
+ = do { -- Class predicates are valid in all contexts
+ ; checkTc (arity == n_tys) arity_err
+
+ -- Check the form of the argument types
+ ; mappM_ check_arg_type tys
+ ; checkTc (check_class_pred_tys dflags ctxt tys)
+ (predTyVarErr pred $$ how_to_allow)
+ }
where
class_name = className cls
arity = classArity cls
arity_err = arityErr "Class" class_name arity n_tys
how_to_allow = parens (ptext SLIT("Use -fglasgow-exts to permit this"))
+check_pred_ty dflags ctxt pred@(EqPred ty1 ty2)
+ = do { -- Equational constraints are valid in all contexts if indexed
+ -- types are permitted
+ ; checkTc (dopt Opt_IndexedTypes dflags) (eqPredTyErr pred)
+
+ -- Check the form of the argument types
+ ; check_eq_arg_type ty1
+ ; check_eq_arg_type ty2
+ }
+ where
+ check_eq_arg_type = check_poly_type (Rank 0) UT_NotOk
+
check_pred_ty dflags SigmaCtxt (IParam _ ty) = check_arg_type ty
- -- Implicit parameters only allows in type
+ -- Implicit parameters only allowed in type
-- signatures; not in instance decls, superclasses etc
- -- The reason for not allowing implicit params in instances is a bit subtle
+ -- The reason for not allowing implicit params in instances is a bit
+ -- subtle.
-- If we allowed instance (?x::Int, Eq a) => Foo [a] where ...
-- then when we saw (e :: (?x::Int) => t) it would be unclear how to
-- discharge all the potential usas of the ?x in e. For example, a
ptext SLIT("While checking") <+> pprSourceTyCtxt ctxt ]
badPredTyErr sty = ptext SLIT("Illegal constraint") <+> pprPred sty
+eqPredTyErr sty = ptext SLIT("Illegal equational constraint") <+> pprPred sty
+ $$
+ parens (ptext SLIT("Use -findexed-types to permit this"))
predTyVarErr pred = sep [ptext SLIT("Non type-variable argument"),
nest 2 (ptext SLIT("in the constraint:") <+> pprPred pred)]
dupPredWarn dups = ptext SLIT("Duplicate constraint(s):") <+> pprWithCommas pprPred (map head dups)
-- Check that instance inference will terminate (if we care)
-- For Haskell 98, checkValidTheta has already done that
; when (gla_exts && not undecidable_ok) $
- mapM_ failWithTc (checkInstTermination inst_tys theta)
+ mapM_ addErrTc (checkInstTermination inst_tys theta)
-- The Coverage Condition
; checkTc (undecidable_ok || checkInstCoverage clas inst_tys)