Commit 290a553e authored by Simon Peyton Jones's avatar Simon Peyton Jones

Tidy up tidySkolemInfo

Previously tidySkolemInfo used tidyOpenType, and returned a new
TidyEnv.  But that's not needed any more, because all the skolems
should be in scope in the constraint tree.

I also removed a (now-unnecessary) field of UnifyForAllSkol
parent 97c49e9e
......@@ -298,11 +298,11 @@ reportImplic ctxt implic@(Implic { ic_skols = tvs, ic_given = given
where
insoluble = isInsolubleStatus status
(env1, tvs') = mapAccumL tidyTyCoVarBndr (cec_tidy ctxt) tvs
(env2, info') = tidySkolemInfo env1 info
info' = tidySkolemInfo env1 info
implic' = implic { ic_skols = tvs'
, ic_given = map (tidyEvVar env2) given
, ic_given = map (tidyEvVar env1) given
, ic_info = info' }
ctxt' = ctxt { cec_tidy = env2
ctxt' = ctxt { cec_tidy = env1
, cec_encl = implic' : cec_encl ctxt
, cec_suppress = insoluble -- Suppress inessential errors if there
-- are are insolubles anywhere in the
......
......@@ -1207,8 +1207,8 @@ mkTypeErrorThingArgs ty num_args
zonkTidyOrigin :: TidyEnv -> CtOrigin -> TcM (TidyEnv, CtOrigin)
zonkTidyOrigin env (GivenOrigin skol_info)
= do { skol_info1 <- zonkSkolemInfo skol_info
; let (env1, skol_info2) = tidySkolemInfo env skol_info1
; return (env1, GivenOrigin skol_info2) }
; let skol_info2 = tidySkolemInfo env skol_info1
; return (env, GivenOrigin skol_info2) }
zonkTidyOrigin env orig@(TypeEqOrigin { uo_actual = act
, uo_expected = exp
, uo_thing = m_thing })
......@@ -1267,25 +1267,9 @@ tidyEvVar :: TidyEnv -> EvVar -> EvVar
tidyEvVar env var = setVarType var (tidyType env (varType var))
----------------
tidySkolemInfo :: TidyEnv -> SkolemInfo -> (TidyEnv, SkolemInfo)
tidySkolemInfo env (SigSkol cx ty)
= (env', SigSkol cx ty')
where
(env', ty') = tidyOpenType env ty
tidySkolemInfo env (InferSkol ids)
= (env', InferSkol ids')
where
(env', ids') = mapAccumL do_one env ids
do_one env (name, ty) = (env', (name, ty'))
where
(env', ty') = tidyOpenType env ty
tidySkolemInfo env (UnifyForAllSkol skol_tvs ty)
= (env1, UnifyForAllSkol skol_tvs' ty')
where
env1 = tidyFreeTyCoVars env (tyCoVarsOfType ty `delVarSetList` skol_tvs)
(env2, skol_tvs') = tidyTyCoVarBndrs env1 skol_tvs
ty' = tidyType env2 ty
tidySkolemInfo env info = (env, info)
tidySkolemInfo :: TidyEnv -> SkolemInfo -> SkolemInfo
tidySkolemInfo env (DerivSkol ty) = DerivSkol (tidyType env ty)
tidySkolemInfo env (SigSkol cx ty) = SigSkol cx (tidyType env ty)
tidySkolemInfo env (InferSkol ids) = InferSkol (mapSnd (tidyType env) ids)
tidySkolemInfo env (UnifyForAllSkol ty) = UnifyForAllSkol (tidyType env ty)
tidySkolemInfo _ info = info
......@@ -2513,7 +2513,6 @@ data SkolemInfo
| BracketSkol -- Template Haskell bracket
| UnifyForAllSkol -- We are unifying two for-all types
[TcTyVar] -- The instantiated skolem variables
TcType -- The instantiated type *inside* the forall
| UnkSkol -- Unhelpful info (until I improve it)
......@@ -2539,7 +2538,7 @@ pprSkolInfo (PatSkol cl mc) = sep [ pprPatSkolInfo cl
pprSkolInfo (InferSkol ids) = sep [ ptext (sLit "the inferred type of")
, vcat [ ppr name <+> dcolon <+> ppr ty
| (name,ty) <- ids ]]
pprSkolInfo (UnifyForAllSkol tvs ty) = ptext (sLit "the type") <+> ppr (mkInvForAllTys tvs ty)
pprSkolInfo (UnifyForAllSkol ty) = ptext (sLit "the type") <+> ppr ty
-- UnkSkol
-- For type variables the others are dealt with by pprSkolTvBinding.
......
......@@ -1513,10 +1513,12 @@ addInertSafehask _ item
= pprPanic "addInertSafehask: can't happen! Inserting " $ ppr item
insertSafeOverlapFailureTcS :: Ct -> TcS ()
-- See Note [Safe Haskell Overlapping Instances Implementation] in TcSimplify
insertSafeOverlapFailureTcS item
= updInertCans (\ics -> addInertSafehask ics item)
getSafeOverlapFailures :: TcS Cts
-- See Note [Safe Haskell Overlapping Instances Implementation] in TcSimplify
getSafeOverlapFailures
= do { IC { inert_safehask = safehask } <- getInertCans
; return $ foldDicts consCts safehask emptyCts }
......@@ -3027,7 +3029,7 @@ deferTcSForAllEq role loc kind_cos (bndrs1,body1) (bndrs2,body2)
; (subst, skol_tvs) <- wrapTcS $ TcM.tcInstSkolTyVars tvs1
; let phi1 = Type.substTy subst body1
phi2 = Type.substTy subst body2'
skol_info = UnifyForAllSkol skol_tvs phi1
skol_info = UnifyForAllSkol phi1
; (ctev, hole_co) <- newWantedEq loc role phi1 phi2
; env <- getLclEnv
......
T7148a.hs:19:50: error:
Couldn't match representation of type ‘b’ with that of ‘Result a b’
arising from the coercion of the method ‘coerce’
from type ‘forall b. Proxy b -> a -> Result a b’
to type ‘forall b.
Proxy b -> IS_NO_LONGER a -> Result (IS_NO_LONGER a) b’
‘b’ is a rigid type variable bound by
the type forall b1. Proxy b1 -> a -> Result a b1 at T7148a.hs:19:50
When deriving the instance for (Convert (IS_NO_LONGER a))
• Couldn't match representation of type ‘b’
with that of ‘Result a b’
arising from the coercion of the method ‘coerce’
from type ‘forall b. Proxy b -> a -> Result a b’
to type ‘forall b.
Proxy b -> IS_NO_LONGER a -> Result (IS_NO_LONGER a) b’
‘b’ is a rigid type variable bound by
the type Proxy b -> a -> Result a b at T7148a.hs:19:50
• When deriving the instance for (Convert (IS_NO_LONGER a))
......@@ -3,7 +3,7 @@ tcfail174.hs:14:14: error:
• Couldn't match type ‘a’ with ‘a1’
because type variable ‘a1’ would escape its scope
This (rigid, skolem) type variable is bound by
the type forall a2. a2 -> a2
the type a1 -> a1
at tcfail174.hs:14:1-14
Expected type: Capture (forall x. x -> a)
Actual type: Capture (forall a. a -> a)
......@@ -16,7 +16,7 @@ tcfail174.hs:14:14: error:
tcfail174.hs:17:14: error:
• Couldn't match type ‘a’ with ‘b’
‘a’ is a rigid type variable bound by
the type forall a1. a1 -> a1 at tcfail174.hs:1:1
the type a -> a at tcfail174.hs:1:1
‘b’ is a rigid type variable bound by
the type signature for:
h2 :: forall b. Capture b
......
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