| null errs = returnTc ()
| otherwise = addErrsTc errs `thenNF_Tc_` failTc
where
- errs = checkInstHead dflags clas inst_tys ++
+ errs = checkInstHead dflags theta clas inst_tys ++
[err | pred <- theta, err <- checkInstConstraint dflags pred]
checkInstConstraint dflags pred
| otherwise
= [instConstraintErr pred]
-checkInstHead dflags clas inst_taus
+checkInstHead dflags theta clas inst_taus
| -- CCALL CHECK
-- A user declaration of a CCallable/CReturnable instance
-- must be for a "boxed primitive" type.
-- If GlasgowExts then check at least one isn't a type variable
| dopt Opt_GlasgowExts dflags
= -- GlasgowExts case
- check_tyvars dflags clas inst_taus ++ check_fundeps dflags clas inst_taus
+ check_tyvars dflags clas inst_taus ++ check_fundeps dflags theta clas inst_taus
-- WITH HASKELL 1.4, MUST HAVE C (T a b c)
| not (length inst_taus == 1 &&
the_err = instTypeErr clas inst_taus msg
msg = ptext SLIT("There must be at least one non-type-variable in the instance head")
-check_fundeps dflags clas inst_taus
- | checkInstFDs clas inst_taus = []
- | otherwise = [the_err]
+check_fundeps dflags theta clas inst_taus
+ | checkInstFDs theta clas inst_taus = []
+ | otherwise = [the_err]
where
the_err = instTypeErr clas inst_taus msg
msg = ptext SLIT("the instance types do not agree with the functional dependencies of the class")
import Var ( TyVar )
import Class ( Class, FunDep, classTvsFds )
-import Type ( Type, PredType(..), predTyUnique, tyVarsOfTypes, tyVarsOfPred )
+import Type ( Type, ThetaType, PredType(..), predTyUnique, tyVarsOfTypes, tyVarsOfPred )
import Subst ( mkSubst, emptyInScopeSet, substTy )
import Unify ( unifyTyListsX )
import Outputable ( Outputable, SDoc, interppSP, ptext, empty, hsep, punctuate, comma )
----------
-checkClsFD :: TyVarSet
+checkClsFD :: TyVarSet -- The quantified type variables, which
+ -- can be instantiated to make the types match
-> FunDep TyVar -> [TyVar] -- One functional dependency from the class
-> [Type] -> [Type]
-> [Equation]
\end{code}
\begin{code}
-checkInstFDs :: Class -> [Type] -> Bool
+checkInstFDs :: ThetaType -> Class -> [Type] -> Bool
-- Check that functional dependencies are obeyed in an instance decl
-- For example, if we have
--- class C a b | a -> b
+-- class theta => C a b | a -> b
-- instance C t1 t2
--- Then we require fv(t2) `subset` fv(t1)
+-- Then we require fv(t2) `subset` oclose(fv(t1), theta)
-checkInstFDs clas inst_taus
+checkInstFDs theta clas inst_taus
= all fundep_ok fds
where
(tyvars, fds) = classTvsFds clas
- fundep_ok fd = tyVarsOfTypes rs `subVarSet` tyVarsOfTypes ls
+ fundep_ok fd = tyVarsOfTypes rs `subVarSet` oclose theta (tyVarsOfTypes ls)
where
(ls,rs) = instFD fd tyvars inst_taus
\end{code}