Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/6585b15d02846877432b6c8a65d7cf98d38093b5 >--------------------------------------------------------------- commit 6585b15d02846877432b6c8a65d7cf98d38093b5 Author: Simon Peyton Jones <[email protected]> Date: Thu Feb 16 13:41:42 2012 +0000 Remove dead code >--------------------------------------------------------------- compiler/typecheck/TcInteract.lhs | 1 - compiler/typecheck/TcUnify.lhs | 130 +------------------------------------ 2 files changed, 1 insertions(+), 130 deletions(-) diff --git a/compiler/typecheck/TcInteract.lhs b/compiler/typecheck/TcInteract.lhs index 3b46af4..7bb068e 100644 --- a/compiler/typecheck/TcInteract.lhs +++ b/compiler/typecheck/TcInteract.lhs @@ -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] diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs index a6e1db1..8c1fa17 100644 --- a/compiler/typecheck/TcUnify.lhs +++ b/compiler/typecheck/TcUnify.lhs @@ -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} _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
