- = getLclEnv `thenM` \ env ->
- let
- extra_global_tyvars = tcTyVarsOfTypes [idType id | (_,id) <- names_w_ids]
- th_lvl = thLevel (tcl_th_ctxt env)
- extra_env = [ (name, ATcId { tct_id = id,
- tct_level = th_lvl,
- tct_type = id_ty,
- tct_co = if isRefineableTy id_ty
- then Just idHsWrapper
- else Nothing })
- | (name,id) <- names_w_ids, let id_ty = idType id]
- le' = extendNameEnvList (tcl_env env) extra_env
- rdr_env' = extendLocalRdrEnv (tcl_rdr env) [name | (name,_) <- names_w_ids]
- in
- traceTc (text "env2") `thenM_`
- traceTc (text "env3" <+> ppr extra_env) `thenM_`
- tc_extend_gtvs (tcl_tyvars env) extra_global_tyvars `thenM` \ gtvs' ->
- (traceTc (text "env4") `thenM_`
- setLclEnv (env {tcl_env = le', tcl_tyvars = gtvs', tcl_rdr = rdr_env'}) thing_inside)
-\end{code}
-
-
-\begin{code}
------------------------
--- findGlobals looks at the value environment and finds values
--- whose types mention the offending type variable. It has to be
--- careful to zonk the Id's type first, so it has to be in the monad.
--- We must be careful to pass it a zonked type variable, too.
-
-findGlobals :: TcTyVarSet
- -> TidyEnv
- -> TcM (TidyEnv, [SDoc])
-
-findGlobals tvs tidy_env
- = getLclEnv `thenM` \ lcl_env ->
- go tidy_env [] (lclEnvElts lcl_env)
- where
- go tidy_env acc [] = returnM (tidy_env, acc)
- go tidy_env acc (thing : things)
- = find_thing ignore_it tidy_env thing `thenM` \ (tidy_env1, maybe_doc) ->
- case maybe_doc of
- Just d -> go tidy_env1 (d:acc) things
- Nothing -> go tidy_env1 acc things
-
- ignore_it ty = tvs `disjointVarSet` tyVarsOfType ty
-
------------------------
-find_thing ignore_it tidy_env (ATcId { tct_id = id })
- = zonkTcType (idType id) `thenM` \ id_ty ->
- if ignore_it id_ty then
- returnM (tidy_env, Nothing)
- else let
- (tidy_env', tidy_ty) = tidyOpenType tidy_env id_ty
- msg = sep [ppr id <+> dcolon <+> ppr tidy_ty,
- nest 2 (parens (ptext SLIT("bound at") <+>
- ppr (getSrcLoc id)))]
- in
- returnM (tidy_env', Just msg)
-
-find_thing ignore_it tidy_env (ATyVar tv ty)
- = zonkTcType ty `thenM` \ tv_ty ->
- if ignore_it tv_ty then
- returnM (tidy_env, Nothing)
- else let
- -- The name tv is scoped, so we don't need to tidy it
- (tidy_env1, tidy_ty) = tidyOpenType tidy_env tv_ty
- msg = sep [ptext SLIT("Scoped type variable") <+> quotes (ppr tv) <+> eq_stuff, nest 2 bound_at]
-
- eq_stuff | Just tv' <- Type.getTyVar_maybe tv_ty,
- getOccName tv == getOccName tv' = empty
- | otherwise = equals <+> ppr tidy_ty
- -- It's ok to use Type.getTyVar_maybe because ty is zonked by now
- bound_at = parens $ ptext SLIT("bound at:") <+> ppr (getSrcLoc tv)
- in
- returnM (tidy_env1, Just msg)
-
-find_thing _ _ thing = pprPanic "find_thing" (ppr thing)
-\end{code}
-
-\begin{code}
-refineEnvironment :: Refinement -> TcM a -> TcM a
--- I don't think I have to refine the set of global type variables in scope
--- Reason: the refinement never increases that set
-refineEnvironment reft thing_inside
- | isEmptyRefinement reft -- Common case
- = thing_inside
- | otherwise