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