Commit 2d1987b1 authored by simonpj's avatar simonpj
Browse files

[project @ 2000-10-05 16:04:36 by simonpj]

Add a test to reject things like:

	instance Ord a => Ord (forall s. T s a)

	g :: T s (forall b.b)

The for-alls are illegal in type arguments!
parent 6f80ddc8
......@@ -46,7 +46,7 @@ import Type ( Type, Kind, PredType(..), ThetaType, UsageAnn(..),
mkArrowKinds, getTyVar_maybe, getTyVar, splitFunTy_maybe,
tidyOpenType, tidyOpenTypes, tidyTyVar, tidyTyVars,
tyVarsOfType, tyVarsOfPred, mkForAllTys,
classesOfPreds, isUnboxedTupleType
classesOfPreds, isUnboxedTupleType, isForAllTy
)
import PprType ( pprType, pprPred )
import Subst ( mkTopTyVarSubst, substTy )
......@@ -332,11 +332,11 @@ tcHsType ty@(HsTyVar name)
= tc_app ty []
tcHsType (HsListTy ty)
= tcHsType ty `thenTc` \ tau_ty ->
= tcHsArgType ty `thenTc` \ tau_ty ->
returnTc (mkListTy tau_ty)
tcHsType (HsTupleTy (HsTupCon _ boxity) tys)
= mapTc tcHsType tys `thenTc` \ tau_tys ->
= mapTc tcHsArgType tys `thenTc` \ tau_tys ->
returnTc (mkTupleTy boxity (length tys) tau_tys)
tcHsType (HsFunTy ty1 ty2)
......@@ -348,10 +348,10 @@ tcHsType (HsNumTy n)
= ASSERT(n== 1)
returnTc (mkTyConApp genUnitTyCon [])
tcHsType (HsOpTy ty1 op ty2) =
tcHsType ty1 `thenTc` \ tau_ty1 ->
tcHsType ty2 `thenTc` \ tau_ty2 ->
tc_fun_type op [tau_ty1,tau_ty2]
tcHsType (HsOpTy ty1 op ty2)
= tcHsArgType ty1 `thenTc` \ tau_ty1 ->
tcHsArgType ty2 `thenTc` \ tau_ty2 ->
tc_fun_type op [tau_ty1,tau_ty2]
tcHsType (HsAppTy ty1 ty2)
= tc_app ty1 [ty2]
......@@ -457,7 +457,7 @@ tc_app (HsAppTy ty1 ty2) tys
tc_app ty tys
= tcAddErrCtxt (appKindCtxt pp_app) $
mapTc tcHsType tys `thenTc` \ arg_tys ->
mapTc tcHsArgType tys `thenTc` \ arg_tys ->
case ty of
HsTyVar fun -> tc_fun_type fun arg_tys
other -> tcHsType ty `thenTc` \ fun_ty ->
......@@ -465,6 +465,13 @@ tc_app ty tys
where
pp_app = ppr ty <+> sep (map pprParendHsType tys)
tcHsArgType arg_ty -- Check that the argument of a type appplication
-- isn't a for-all type
= tcHsType arg_ty `thenTc` \ arg_ty' ->
checkTc (not (isForAllTy arg_ty'))
(argTyErr arg_ty) `thenTc_`
returnTc arg_ty'
-- (tc_fun_type ty arg_tys) returns (mkAppTys ty arg_tys)
-- But not quite; for synonyms it checks the correct arity, and builds a SynTy
-- hence the rather strange functionality.
......@@ -508,7 +515,7 @@ tcContext context = mapTc (tcClassAssertion False) context
tcClassAssertion ccall_ok assn@(HsPClass class_name tys)
= tcAddErrCtxt (appKindCtxt (ppr assn)) $
mapTc tcHsType tys `thenTc` \ arg_tys ->
mapTc tcHsArgType tys `thenTc` \ arg_tys ->
tcLookupTy class_name `thenTc` \ thing ->
case thing of
AClass clas -> checkTc (arity == n_tys) err `thenTc_`
......@@ -921,4 +928,6 @@ freeErr pred ty
unboxedTupleErr ty
= sep [ptext (SLIT("Illegal unboxed tuple as a function or contructor argument:")), nest 4 (ppr ty)]
argTyErr ty = ptext SLIT("Illegal polymorphic type as argument:") <+> ppr ty
\end{code}
......@@ -43,7 +43,7 @@ module Type (
mkUsForAllTy, mkUsForAllTys, splitUsForAllTys, substUsTy,
mkForAllTy, mkForAllTys, splitForAllTy_maybe, splitForAllTys,
applyTy, applyTys, hoistForAllTys,
applyTy, applyTys, hoistForAllTys, isForAllTy,
TauType, RhoType, SigmaType, PredType(..), ThetaType,
ClassPred, ClassContext, mkClassPred,
......@@ -565,6 +565,11 @@ mkForAllTys tyvars ty = case splitUsgTy_maybe ty of
(foldr ForAllTy ty' tyvars)
Nothing -> foldr ForAllTy ty tyvars
isForAllTy :: Type -> Bool
isForAllTy (NoteTy _ ty) = isForAllTy ty
isForAllTy (ForAllTy _ _) = True
isForAllTy other_ty = False
splitForAllTy_maybe :: Type -> Maybe (TyVar, Type)
splitForAllTy_maybe ty = case splitUsgTy_maybe ty of
Just (usg,ty') -> do (tyvar,ty'') <- splitFAT_m ty'
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment