Commit 98d5ffd5 authored by simonmar's avatar simonmar
Browse files

[project @ 1999-06-23 10:38:13 by simonmar]

Make scoped type variables work.
parent 14a17049
......@@ -182,7 +182,14 @@ checkPat e [] = case e of
ELazyPat e -> checkPat e [] `thenP` (returnP . LazyPatIn)
EAsPat n e -> checkPat e [] `thenP` (returnP . AsPatIn n)
ExprWithTySig e t -> checkPat e [] `thenP` \e ->
returnP (SigPatIn e t)
-- pattern signatures are parsed as sigtypes,
-- but they aren't explicit forall points. Hence
-- we have to remove the implicit forall here.
let t' = case t of
HsForAllTy Nothing [] ty -> ty
other -> other
in
returnP (SigPatIn e t')
OpApp (HsVar n) (HsVar plus) _ (HsLit k@(HsInt _)) | plus == plus_RDR
-> returnP (NPlusKPatIn n k)
......
......@@ -48,7 +48,9 @@ module RdrHsSyn (
RdrNameGenPragmas,
RdrNameInstancePragmas,
extractHsTyRdrNames,
extractPatsTyVars, extractRuleBndrsTyVars,
extractHsTyRdrTyVars,
extractPatsTyVars,
extractRuleBndrsTyVars,
mkOpApp, mkClassDecl, mkClassOpSig,
......@@ -133,6 +135,9 @@ It's used when making the for-alls explicit.
extractHsTyRdrNames :: HsType RdrName -> [RdrName]
extractHsTyRdrNames ty = nub (extract_ty ty [])
extractHsTyRdrTyVars :: RdrNameHsType -> [RdrName]
extractHsTyRdrTyVars ty = filter isRdrTyVar (extractHsTyRdrNames ty)
extractRuleBndrsTyVars :: [RuleBndr RdrName] -> [RdrName]
extractRuleBndrsTyVars bndrs = filter isRdrTyVar (nub (foldr go [] bndrs))
where
......@@ -146,13 +151,14 @@ extract_ctxt ctxt acc = foldr extract_ass acc ctxt
where
extract_ass (cls, tys) acc = foldr extract_ty (cls : acc) tys
extract_ty (MonoTyApp ty1 ty2) acc = extract_ty ty1 (extract_ty ty2 acc)
extract_ty (MonoListTy ty) acc = extract_ty ty acc
extract_ty (MonoTupleTy tys _) acc = foldr extract_ty acc tys
extract_ty (MonoFunTy ty1 ty2) acc = extract_ty ty1 (extract_ty ty2 acc)
extract_ty (MonoDictTy cls tys) acc = foldr extract_ty (cls : acc) tys
extract_ty (MonoUsgTy usg ty) acc = extract_ty ty acc
extract_ty (MonoTyVar tv) acc = tv : acc
extract_ty (MonoTyApp ty1 ty2) acc = extract_ty ty1 (extract_ty ty2 acc)
extract_ty (MonoListTy ty) acc = extract_ty ty acc
extract_ty (MonoTupleTy tys _) acc = foldr extract_ty acc tys
extract_ty (MonoFunTy ty1 ty2) acc = extract_ty ty1 (extract_ty ty2 acc)
extract_ty (MonoDictTy cls tys) acc = foldr extract_ty (cls : acc) tys
extract_ty (MonoUsgTy usg ty) acc = extract_ty ty acc
extract_ty (MonoTyVar tv) acc = tv : acc
extract_ty (HsForAllTy Nothing ctxt ty) acc = extract_ctxt ctxt (extract_ty ty acc)
extract_ty (HsForAllTy (Just tvs) ctxt ty)
acc = acc ++
(filter (`notElem` locals) $
......@@ -162,7 +168,7 @@ extract_ty (HsForAllTy (Just tvs) ctxt ty)
extractPatsTyVars :: [RdrNamePat] -> [RdrName]
extractPatsTyVars pats = nub (foldr extract_pat [] pats)
extractPatsTyVars pats = filter isRdrTyVar (nub (foldr extract_pat [] pats))
extract_pat (SigPatIn pat ty) acc = extract_ty ty acc
extract_pat WildPatIn acc = acc
......
......@@ -829,8 +829,8 @@ nonStdGuardErr guard
) 4 (ppr guard)
patSigErr ty
= hang (ptext SLIT("Illegal signature in pattern:") <+> ppr ty)
4 (ptext SLIT("Use -fglasgow-exts to permit it"))
= (ptext SLIT("Illegal signature in pattern:") <+> ppr ty)
$$ nest 4 (ptext SLIT("Use -fglasgow-exts to permit it"))
pp_op (op, fix) = hcat [ppr op, space, parens (ppr fix)]
\end{code}
......@@ -14,7 +14,7 @@ import HsPragmas
import HsTypes ( getTyVarName, pprClassAssertion, cmpHsTypes )
import RdrName ( RdrName, isRdrDataCon, rdrNameOcc, isRdrTyVar )
import RdrHsSyn ( RdrNameContext, RdrNameHsType, RdrNameConDecl,
extractHsTyRdrNames, extractRuleBndrsTyVars
extractRuleBndrsTyVars, extractHsTyRdrTyVars
)
import RnHsSyn
import HsCore
......@@ -565,13 +565,10 @@ checkConstraints explicit_forall doc forall_tyvars ctxt ty
| otherwise = addErrRn (ctxtErr explicit_forall doc forall_tyvars ct ty)
`thenRn_` returnRn Nothing
where
forall_mentioned = foldr ((||) . any (`elem` forall_tyvars) . extractHsTyRdrNames)
forall_mentioned = foldr ((||) . any (`elem` forall_tyvars) . extractHsTyRdrTyVars)
False
tys
freeRdrTyVars :: RdrNameHsType -> [RdrName]
freeRdrTyVars ty = filter isRdrTyVar (extractHsTyRdrNames ty)
rnHsType :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
rnHsType doc (HsForAllTy Nothing ctxt ty)
......@@ -580,7 +577,7 @@ rnHsType doc (HsForAllTy Nothing ctxt ty)
-- over FV(T) \ {in-scope-tyvars}
= getLocalNameEnv `thenRn` \ name_env ->
let
mentioned_in_tau = freeRdrTyVars ty
mentioned_in_tau = extractHsTyRdrTyVars ty
forall_tyvars = filter (not . (`elemFM` name_env)) mentioned_in_tau
in
checkConstraints False doc forall_tyvars ctxt ty `thenRn` \ ctxt' ->
......@@ -593,10 +590,10 @@ rnHsType doc (HsForAllTy (Just forall_tyvars) ctxt tau)
-- That's only a warning... unless the tyvar is constrained by a
-- context in which case it's an error
= let
mentioned_in_tau = freeRdrTyVars tau
mentioned_in_tau = extractHsTyRdrTyVars tau
mentioned_in_ctxt = nub [tv | (_,tys) <- ctxt,
ty <- tys,
tv <- freeRdrTyVars ty]
tv <- extractHsTyRdrTyVars ty]
dubious_guys = filter (`notElem` mentioned_in_tau) forall_tyvar_names
-- dubious = explicitly quantified but not mentioned in tau type
......
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