projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Add several new record features
[ghc-hetmet.git]
/
compiler
/
typecheck
/
TcMType.lhs
diff --git
a/compiler/typecheck/TcMType.lhs
b/compiler/typecheck/TcMType.lhs
index
ca5ca0e
..
87e2d94
100644
(file)
--- a/
compiler/typecheck/TcMType.lhs
+++ b/
compiler/typecheck/TcMType.lhs
@@
-161,7
+161,7
@@
tcSkolSigTyVars :: SkolemInfo -> [TyVar] -> [TcTyVar]
tcSkolSigTyVars info tyvars = [ mkSkolTyVar (tyVarName tv) (tyVarKind tv) info
| tv <- tyvars ]
tcSkolSigTyVars info tyvars = [ mkSkolTyVar (tyVarName tv) (tyVarKind tv) info
| tv <- tyvars ]
-tcInstSkolTyVar :: SkolemInfo -> Maybe SrcLoc -> TyVar -> TcM TcTyVar
+tcInstSkolTyVar :: SkolemInfo -> Maybe SrcSpan -> TyVar -> TcM TcTyVar
-- Instantiate the tyvar, using
-- * the occ-name and kind of the supplied tyvar,
-- * the unique from the monad,
-- Instantiate the tyvar, using
-- * the occ-name and kind of the supplied tyvar,
-- * the unique from the monad,
@@
-171,7
+171,7
@@
tcInstSkolTyVar info mb_loc tyvar
= do { uniq <- newUnique
; let old_name = tyVarName tyvar
kind = tyVarKind tyvar
= do { uniq <- newUnique
; let old_name = tyVarName tyvar
kind = tyVarKind tyvar
- loc = mb_loc `orElse` getSrcLoc old_name
+ loc = mb_loc `orElse` getSrcSpan old_name
new_name = mkInternalName uniq (nameOccName old_name) loc
; return (mkSkolTyVar new_name kind info) }
new_name = mkInternalName uniq (nameOccName old_name) loc
; return (mkSkolTyVar new_name kind info) }
@@
-179,7
+179,7
@@
tcInstSkolTyVars :: SkolemInfo -> [TyVar] -> TcM [TcTyVar]
-- Get the location from the monad
tcInstSkolTyVars info tyvars
= do { span <- getSrcSpanM
-- Get the location from the monad
tcInstSkolTyVars info tyvars
= do { span <- getSrcSpanM
- ; mapM (tcInstSkolTyVar info (Just (srcSpanStart span))) tyvars }
+ ; mapM (tcInstSkolTyVar info (Just span)) tyvars }
tcInstSkolType :: SkolemInfo -> TcType -> TcM ([TcTyVar], TcThetaType, TcType)
-- Instantiate a type with fresh skolem constants
tcInstSkolType :: SkolemInfo -> TcType -> TcM ([TcTyVar], TcThetaType, TcType)
-- Instantiate a type with fresh skolem constants
@@
-422,7
+422,7
@@
zonkTcTyVarsAndFV tyvars = mappM zonkTcTyVar tyvars `thenM` \ tys ->
returnM (tyVarsOfTypes tys)
zonkTcTyVar :: TcTyVar -> TcM TcType
returnM (tyVarsOfTypes tys)
zonkTcTyVar :: TcTyVar -> TcM TcType
-zonkTcTyVar tyvar = ASSERT( isTcTyVar tyvar )
+zonkTcTyVar tyvar = ASSERT2( isTcTyVar tyvar, ppr tyvar)
zonk_tc_tyvar (\ tv -> returnM (TyVarTy tv)) tyvar
\end{code}
zonk_tc_tyvar (\ tv -> returnM (TyVarTy tv)) tyvar
\end{code}
@@
-943,9
+943,9
@@
check_pred_ty dflags ctxt pred@(ClassP cls tys)
how_to_allow = parens (ptext SLIT("Use -fglasgow-exts to permit this"))
check_pred_ty dflags ctxt pred@(EqPred ty1 ty2)
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)
+ = do { -- Equational constraints are valid in all contexts if type
+ -- families are permitted
+ ; checkTc (dopt Opt_TypeFamilies dflags) (eqPredTyErr pred)
-- Check the form of the argument types
; check_eq_arg_type ty1
-- Check the form of the argument types
; check_eq_arg_type ty1
@@
-1075,7
+1075,7
@@
checkThetaCtxt ctxt theta
badPredTyErr sty = ptext SLIT("Illegal constraint") <+> pprPred sty
eqPredTyErr sty = ptext SLIT("Illegal equational constraint") <+> pprPred sty
$$
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"))
+ parens (ptext SLIT("Use -ftype-families 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)
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)
@@
-1136,8
+1136,8
@@
check_inst_head dflags clas tys
where
(first_ty : _) = tys
where
(first_ty : _) = tys
- head_shape_msg = parens (text "The instance type must be of form (T a b c)" $$
- text "where T is not a synonym, and a,b,c are distinct type variables")
+ head_shape_msg = parens (text "The instance type must be of form (T a1 ... an)" $$
+ text "where T is not a synonym, and a1 ... an are distinct type *variables*")
-- For now, I only allow tau-types (not polytypes) in
-- the head of an instance decl.
-- For now, I only allow tau-types (not polytypes) in
-- the head of an instance decl.
@@
-1183,7
+1183,11
@@
checkValidInstance tyvars theta clas inst_tys
undecidableMsg])
\end{code}
undecidableMsg])
\end{code}
-Termination test: each assertion in the context satisfies
+Termination test: the so-called "Paterson conditions" (see Section 5 of
+"Understanding functionsl dependencies via Constraint Handling Rules,
+JFP Jan 2007).
+
+We check that each assertion in the context satisfies:
(1) no variable has more occurrences in the assertion than in the head, and
(2) the assertion has fewer constructors and variables (taken together
and counting repetitions) than the head.
(1) no variable has more occurrences in the assertion than in the head, and
(2) the assertion has fewer constructors and variables (taken together
and counting repetitions) than the head.