Commit ba7c8891 authored by simonpj's avatar simonpj
Browse files

[project @ 2001-08-14 16:28:00 by simonpj]

More wibbles in checking type validity
parent 2b09da89
......@@ -831,19 +831,19 @@ freeErr pred
nest 4 (ptext SLIT("At least one must be universally quantified here"))
]
forAllTyErr ty = ptext SLIT("Illegal polymorphic type:") <+> ppr ty
usageTyErr ty = ptext SLIT("Illegal usage type:") <+> ppr ty
unliftedArgErr ty = ptext SLIT("Illegal unlifted type argument:") <+> ppr ty
ubxArgTyErr ty = ptext SLIT("Illegal unboxed tuple type as function argument:") <+> ppr ty
forAllTyErr ty = ptext SLIT("Illegal polymorphic type:") <+> ppr_ty ty
usageTyErr ty = ptext SLIT("Illegal usage type:") <+> ppr_ty ty
unliftedArgErr ty = ptext SLIT("Illegal unlifted type argument:") <+> ppr_ty ty
ubxArgTyErr ty = ptext SLIT("Illegal unboxed tuple type as function argument:") <+> ppr_ty ty
badSourceTyErr sty = ptext SLIT("Illegal constraint") <+> pprSourceType sty
predTyVarErr pred = ptext SLIT("Non-type variables in constraint:") <+> pprPred pred
kindErr kind = ptext SLIT("Expecting an ordinary type, but found a type of kind") <+> ppr kind
dupPredWarn dups = ptext SLIT("Duplicate constraint(s):") <+> pprWithCommas pprPred (map head dups)
checkTypeCtxt ctxt ty
= vcat [ptext SLIT("In the type:") <+> ppr_ty,
= vcat [ptext SLIT("In the type:") <+> ppr_ty ty,
ptext SLIT("While checking") <+> pprUserTypeCtxt ctxt ]
where
-- Hack alert. If there are no tyvars, (ppr sigma_ty) will print
-- something strange like {Eq k} -> k -> k, because there is no
-- ForAll at the top of the type. Since this is going to the user
......@@ -852,9 +852,10 @@ checkTypeCtxt ctxt ty
-- This shows up in the complaint about
-- case C a where
-- op :: Eq a => a -> a
ppr_ty | null forall_tyvars = pprTheta theta <+> ptext SLIT("=>") <+> ppr tau
| otherwise = ppr ty
(forall_tyvars, theta, tau) = tcSplitSigmaTy ty
ppr_ty ty | null forall_tvs && not (null theta) = pprTheta theta <+> ptext SLIT("=>") <+> ppr tau
| otherwise = ppr ty
where
(forall_tvs, theta, tau) = tcSplitSigmaTy ty
checkThetaCtxt ctxt theta
= vcat [ptext SLIT("In the context:") <+> pprTheta theta,
......
......@@ -173,10 +173,12 @@ tcGroup unf_env this_mod scc
) `thenTc` \ (_, tyclss, env) ->
-- Step 7: Check validity; but only for things defined in this module
traceTc (text "ready for validity check") `thenTc_`
mapTc_ checkValidTyCl (filter (isLocalThing this_mod) tyclss) `thenTc_`
traceTc (text "done") `thenTc_`
-- Step 7: Check validity
traceTc (text "ready for validity check") `thenTc_`
tcSetEnv env (
mapTc_ (checkValidTyCl this_mod) decls
) `thenTc_`
traceTc (text "done") `thenTc_`
returnTc env
......@@ -193,8 +195,16 @@ tcTyClDecl1 unf_env decl
| isClassDecl decl = tcAddDeclCtxt decl (tcClassDecl1 unf_env decl)
| otherwise = tcAddDeclCtxt decl (tcTyDecl unf_env decl)
checkValidTyCl (ATyCon tc) = checkValidTyCon tc
checkValidTyCl (AClass cl) = checkValidClass cl
checkValidTyCl this_mod decl
= tcLookup (tcdName decl) `thenNF_Tc` \ (AGlobal thing) ->
if not (isLocalThing this_mod thing) then
-- Don't bother to check validity for non-local things
returnTc ()
else
tcAddDeclCtxt decl $
case thing of
ATyCon tc -> checkValidTyCon tc
AClass cl -> checkValidClass cl
\end{code}
......
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