- complain sig_tys globals
- = -- "check" checks each sig tyvar in turn
- foldlM check
- (env2, emptyVarEnv, [])
- (tidy_tvs `zip` tidy_tys) `thenM` \ (env3, _, msgs) ->
-
- failWithTcM (env3, main_msg $$ nest 2 (vcat msgs))
- where
- (env1, tidy_tvs) = tidyOpenTyVars emptyTidyEnv sig_tvs
- (env2, tidy_tys) = tidyOpenTypes env1 sig_tys
-
- main_msg = ptext SLIT("Inferred type is less polymorphic than expected")
-
- check (tidy_env, acc, msgs) (sig_tyvar,ty)
- -- sig_tyvar is from the signature;
- -- ty is what you get if you zonk sig_tyvar and then tidy it
- --
- -- acc maps a zonked type variable back to a signature type variable
- = case tcGetTyVar_maybe ty of {
- Nothing -> -- Error (a)!
- returnM (tidy_env, acc, unify_msg sig_tyvar (quotes (ppr ty)) : msgs) ;
-
- Just tv ->
-
- case lookupVarEnv acc tv of {
- Just sig_tyvar' -> -- Error (b)!
- returnM (tidy_env, acc, unify_msg sig_tyvar thing : msgs)
- where
- thing = ptext SLIT("another quantified type variable") <+> quotes (ppr sig_tyvar')
-
- ; Nothing ->
-
- if tv `elemVarSet` globals -- Error (c) or (d)! Type variable escapes
- -- The least comprehensible, so put it last
- -- Game plan:
- -- get the local TcIds and TyVars from the environment,
- -- and pass them to find_globals (they might have tv free)
- then findGlobals (unitVarSet tv) tidy_env `thenM` \ (tidy_env1, globs) ->
- returnM (tidy_env1, acc, escape_msg sig_tyvar tv globs : msgs)
-
- else -- All OK
- returnM (tidy_env, extendVarEnv acc tv sig_tyvar, msgs)
- }}
-\end{code}