Commit 6585b15d authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Remove dead code

parent 2126f7a8
......@@ -542,7 +542,6 @@ trySpontaneousEqTwoWay d eqv gw tv1 tv2
k1 = tyVarKind tv1
k2 = tyVarKind tv2
nicer_to_update_tv2 = isSigTyVar tv1 || isSystemName (Var.varName tv2)
\end{code}
Note [Kind errors]
......
......@@ -16,7 +16,7 @@ Type subsumption and unification
module TcUnify (
-- Full-blown subsumption
tcWrapResult, tcSubType, tcGen,
checkConstraints, newImplication, sigCtxt,
checkConstraints, newImplication,
-- Various unifications
unifyType, unifyTypeList, unifyTheta, unifyKind, unifyKindEq,
......@@ -1210,131 +1210,3 @@ kindOccurCheckErr tyvar ty
= hang (ptext (sLit "Occurs check: cannot construct the infinite kind:"))
2 (sep [ppr tyvar, char '=', ppr ty])
\end{code}
%************************************************************************
%* *
\subsection{Checking signature type variables}
%* *
%************************************************************************
@checkSigTyVars@ checks that a set of universally quantified type varaibles
are not mentioned in the environment. In particular:
(a) Not mentioned in the type of a variable in the envt
eg the signature for f in this:
g x = ... where
f :: a->[a]
f y = [x,y]
Here, f is forced to be monorphic by the free occurence of x.
(d) Not (unified with another type variable that is) in scope.
eg f x :: (r->r) = (\y->y) :: forall a. a->r
when checking the expression type signature, we find that
even though there is nothing in scope whose type mentions r,
nevertheless the type signature for the expression isn't right.
Another example is in a class or instance declaration:
class C a where
op :: forall b. a -> b
op x = x
Here, b gets unified with a
Before doing this, the substitution is applied to the signature type variable.
-- \begin{code}
checkSigTyVars :: [TcTyVar] -> TcM ()
checkSigTyVars sig_tvs = check_sig_tyvars emptyVarSet sig_tvs
checkSigTyVarsWrt :: TcTyVarSet -> [TcTyVar] -> TcM ()
-- The extra_tvs can include boxy type variables;
-- e.g. TcMatches.tcCheckExistentialPat
checkSigTyVarsWrt extra_tvs sig_tvs
= do { extra_tvs' <- zonkTcTyVarsAndFV extra_tvs
; check_sig_tyvars extra_tvs' sig_tvs }
check_sig_tyvars
:: TcTyVarSet -- Global type variables. The universally quantified
-- tyvars should not mention any of these
-- Guaranteed already zonked.
-> [TcTyVar] -- Universally-quantified type variables in the signature
-- Guaranteed to be skolems
-> TcM ()
check_sig_tyvars _ []
= return ()
check_sig_tyvars extra_tvs sig_tvs
= ASSERT( all isTcTyVar sig_tvs && all isSkolemTyVar sig_tvs )
do { gbl_tvs <- tcGetGlobalTyVars
; traceTc "check_sig_tyvars" $ vcat
[ text "sig_tys" <+> ppr sig_tvs
, text "gbl_tvs" <+> ppr gbl_tvs
, text "extra_tvs" <+> ppr extra_tvs]
; let env_tvs = gbl_tvs `unionVarSet` extra_tvs
; when (any (`elemVarSet` env_tvs) sig_tvs)
(bleatEscapedTvs env_tvs sig_tvs sig_tvs)
}
bleatEscapedTvs :: TcTyVarSet -- The global tvs
-> [TcTyVar] -- The possibly-escaping type variables
-> [TcTyVar] -- The zonked versions thereof
-> TcM ()
-- Complain about escaping type variables
-- We pass a list of type variables, at least one of which
-- escapes. The first list contains the original signature type variable,
-- while the second contains the type variable it is unified to (usually itself)
bleatEscapedTvs globals sig_tvs zonked_tvs
= do { env0 <- tcInitTidyEnv
; let (env1, tidy_tvs) = tidyOpenTyVars env0 sig_tvs
(env2, tidy_zonked_tvs) = tidyOpenTyVars env1 zonked_tvs
; (env3, msgs) <- foldlM check (env2, []) (tidy_tvs `zip` tidy_zonked_tvs)
; failWithTcM (env3, main_msg $$ nest 2 (vcat msgs)) }
where
main_msg = ptext (sLit "Inferred type is less polymorphic than expected")
check (tidy_env, msgs) (sig_tv, zonked_tv)
| not (zonked_tv `elemVarSet` globals) = return (tidy_env, msgs)
| otherwise
= do { lcl_env <- getLclTypeEnv
; (tidy_env1, globs) <- findGlobals (unitVarSet zonked_tv) lcl_env tidy_env
; return (tidy_env1, escape_msg sig_tv zonked_tv globs : msgs) }
-----------------------
escape_msg :: Var -> Var -> [SDoc] -> SDoc
escape_msg sig_tv zonked_tv globs
| notNull globs
= vcat [sep [msg, ptext (sLit "is mentioned in the environment:")],
nest 2 (vcat globs)]
| otherwise
= msg <+> ptext (sLit "escapes")
-- Sigh. It's really hard to give a good error message
-- all the time. One bad case is an existential pattern match.
-- We rely on the "When..." context to help.
where
msg = ptext (sLit "Quantified type variable") <+> quotes (ppr sig_tv) <+> is_bound_to
is_bound_to
| sig_tv == zonked_tv = empty
| otherwise = ptext (sLit "is unified with") <+> quotes (ppr zonked_tv) <+> ptext (sLit "which")
-- \end{code}
These two context are used with checkSigTyVars
\begin{code}
sigCtxt :: Id -> [TcTyVar] -> TcThetaType -> TcTauType
-> TidyEnv -> TcM (TidyEnv, MsgDoc)
sigCtxt id sig_tvs sig_theta sig_tau tidy_env = do
actual_tau <- zonkTcType sig_tau
let
(env1, tidy_sig_tvs) = tidyOpenTyVars tidy_env sig_tvs
(env2, tidy_sig_rho) = tidyOpenType env1 (mkPhiTy sig_theta sig_tau)
(env3, tidy_actual_tau) = tidyOpenType env2 actual_tau
sub_msg = vcat [ptext (sLit "Signature type: ") <+> pprType (mkForAllTys tidy_sig_tvs tidy_sig_rho),
ptext (sLit "Type to generalise:") <+> pprType tidy_actual_tau
]
msg = vcat [ptext (sLit "When trying to generalise the type inferred for") <+> quotes (ppr id),
nest 2 sub_msg]
return (env3, msg)
\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