projects
/
ghc-hetmet.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
25f8fc6
)
Reject polytypes in instance declarations (for now anyway)
author
simonpj@microsoft.com
<unknown>
Thu, 23 Feb 2006 12:59:58 +0000
(12:59 +0000)
committer
simonpj@microsoft.com
<unknown>
Thu, 23 Feb 2006 12:59:58 +0000
(12:59 +0000)
ghc/compiler/typecheck/TcMType.lhs
patch
|
blob
|
history
diff --git
a/ghc/compiler/typecheck/TcMType.lhs
b/ghc/compiler/typecheck/TcMType.lhs
index
e865ecf
..
6c1814e
100644
(file)
--- a/
ghc/compiler/typecheck/TcMType.lhs
+++ b/
ghc/compiler/typecheck/TcMType.lhs
@@
-93,7
+93,7
@@
import TcRnMonad -- TcType, amongst others
import FunDeps ( grow, checkInstCoverage )
import Name ( Name, setNameUnique, mkSysTvName )
import VarSet
import FunDeps ( grow, checkInstCoverage )
import Name ( Name, setNameUnique, mkSysTvName )
import VarSet
-import DynFlags ( dopt, DynFlag(..), DynFlags )
+import DynFlags ( dopt, DynFlag(..) )
import Util ( nOfThem, isSingleton, notNull )
import ListSetOps ( removeDups )
import Outputable
import Util ( nOfThem, isSingleton, notNull )
import ListSetOps ( removeDups )
import Outputable
@@
-1075,24
+1075,27
@@
checkValidInstHead ty -- Should be a source type
check_inst_head dflags clas tys
-- If GlasgowExts then check at least one isn't a type variable
| dopt Opt_GlasgowExts dflags
check_inst_head dflags clas tys
-- If GlasgowExts then check at least one isn't a type variable
| dopt Opt_GlasgowExts dflags
- = returnM ()
+ = mapM_ check_one tys
-- WITH HASKELL 98, MUST HAVE C (T a b c)
-- WITH HASKELL 98, MUST HAVE C (T a b c)
- | isSingleton tys,
- tcValidInstHeadTy first_ty
- = returnM ()
-
| otherwise
| otherwise
- = failWithTc (instTypeErr (pprClassPred clas tys) head_shape_msg)
+ = checkTc (isSingleton tys && tcValidInstHeadTy first_ty)
+ (instTypeErr (pprClassPred clas tys) head_shape_msg)
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")
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")
-\end{code}
-\begin{code}
+ -- 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
+ check_one ty = do { check_tau_type (Rank 0) UT_NotOk ty
+ ; checkTc (not (isUnLiftedType ty)) (unliftedArgErr ty) }
+
instTypeErr pp_ty msg
= sep [ptext SLIT("Illegal instance declaration for") <+> quotes pp_ty,
nest 4 msg]
instTypeErr pp_ty msg
= sep [ptext SLIT("Illegal instance declaration for") <+> quotes pp_ty,
nest 4 msg]