[commit: ghc] ghc-8.0: Tidy up tidySkolemInfo (bb2f21d)
git at git.haskell.org
git at git.haskell.org
Tue Feb 2 14:31:59 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : ghc-8.0
Link : http://ghc.haskell.org/trac/ghc/changeset/bb2f21ddc722190623f640e08a350c387fc32e4a/ghc
>---------------------------------------------------------------
commit bb2f21ddc722190623f640e08a350c387fc32e4a
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Wed Jan 6 17:11:34 2016 +0000
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
(cherry picked from commit 290a553e9bd98ed43765cf8e7a70ebc95c187253)
>---------------------------------------------------------------
bb2f21ddc722190623f640e08a350c387fc32e4a
compiler/typecheck/TcErrors.hs | 6 ++--
compiler/typecheck/TcMType.hs | 32 ++++++----------------
compiler/typecheck/TcRnTypes.hs | 3 +-
compiler/typecheck/TcSMonad.hs | 2 +-
testsuite/tests/deriving/should_fail/T7148a.stderr | 17 ++++++------
.../tests/typecheck/should_fail/tcfail174.stderr | 4 +--
6 files changed, 24 insertions(+), 40 deletions(-)
diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs
index 33ca07b..819a474 100644
--- a/compiler/typecheck/TcErrors.hs
+++ b/compiler/typecheck/TcErrors.hs
@@ -301,11 +301,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
diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs
index f772da5..a160d4e 100644
--- a/compiler/typecheck/TcMType.hs
+++ b/compiler/typecheck/TcMType.hs
@@ -1216,8 +1216,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 })
@@ -1276,25 +1276,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
diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs
index 7244a2a..ec285fa 100644
--- a/compiler/typecheck/TcRnTypes.hs
+++ b/compiler/typecheck/TcRnTypes.hs
@@ -2594,7 +2594,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)
@@ -2621,7 +2620,7 @@ pprSkolInfo (PatSkol cl mc) = sep [ pprPatSkolInfo cl
pprSkolInfo (InferSkol ids) = sep [ text "the inferred type of"
, vcat [ ppr name <+> dcolon <+> ppr ty
| (name,ty) <- ids ]]
-pprSkolInfo (UnifyForAllSkol tvs ty) = text "the type" <+> ppr (mkInvForAllTys tvs ty)
+pprSkolInfo (UnifyForAllSkol ty) = text "the type" <+> ppr ty
-- UnkSkol
-- For type variables the others are dealt with by pprSkolTvBinding.
diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs
index ddacdd9..aa16a80 100644
--- a/compiler/typecheck/TcSMonad.hs
+++ b/compiler/typecheck/TcSMonad.hs
@@ -3065,7 +3065,7 @@ deferTcSForAllEq role loc kind_cos (bndrs1,body1) (bndrs2,body2)
; (subst, skol_tvs) <- wrapTcS $ TcM.tcInstSkolTyVars tvs1
; let phi1 = Type.substTyUnchecked subst body1
phi2 = Type.substTyUnchecked subst body2'
- skol_info = UnifyForAllSkol skol_tvs phi1
+ skol_info = UnifyForAllSkol phi1
; (ctev, hole_co) <- newWantedEq loc role phi1 phi2
; env <- getLclEnv
diff --git a/testsuite/tests/deriving/should_fail/T7148a.stderr b/testsuite/tests/deriving/should_fail/T7148a.stderr
index 8dd23aa..9a6ea41 100644
--- a/testsuite/tests/deriving/should_fail/T7148a.stderr
+++ b/testsuite/tests/deriving/should_fail/T7148a.stderr
@@ -1,10 +1,11 @@
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))
diff --git a/testsuite/tests/typecheck/should_fail/tcfail174.stderr b/testsuite/tests/typecheck/should_fail/tcfail174.stderr
index e7ad3ca..9c473e9 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail174.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail174.stderr
@@ -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
More information about the ghc-commits
mailing list