[commit: ghc] master: Comments only (a46511a)
git at git.haskell.org
git at git.haskell.org
Mon Dec 3 13:49:19 UTC 2018
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/a46511a88e719d990285f06b29a38839b3e0a0bf/ghc
>---------------------------------------------------------------
commit a46511a88e719d990285f06b29a38839b3e0a0bf
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Mon Dec 3 13:47:55 2018 +0000
Comments only
>---------------------------------------------------------------
a46511a88e719d990285f06b29a38839b3e0a0bf
compiler/typecheck/TcInstDcls.hs | 9 +++++++--
compiler/typecheck/TcTyClsDecls.hs | 18 +++++++++++++++---
2 files changed, 22 insertions(+), 5 deletions(-)
diff --git a/compiler/typecheck/TcInstDcls.hs b/compiler/typecheck/TcInstDcls.hs
index b8eb17f..8d2ef94 100644
--- a/compiler/typecheck/TcInstDcls.hs
+++ b/compiler/typecheck/TcInstDcls.hs
@@ -799,7 +799,12 @@ tcDataFamHeader mb_clsinfo fam_tc imp_vars mb_bndrs fixity hs_ctxt hs_pats m_ksi
; lhs_ty <- checkExpectedKindX pp_lhs lhs_ty lhs_kind res_kind
; return (stupid_theta, lhs_ty, res_kind) }
- -- See Note [Generalising in tcFamTyPatsAndThen]
+ -- See TcTyClsDecls Note [Generalising in tcFamTyPatsGuts]
+ -- This code (and the stuff immediately above) is very similar
+ -- to that in tcFamTyInstEqnGuts. Maybe we should abstract the
+ -- common code; but for the moment I concluded that it's
+ -- clearer to duplicate it. Still, if you fix a bug here,
+ -- check there too!
; let scoped_tvs = imp_tvs ++ exp_tvs
; dvs <- candidateQTyVarsOfTypes (lhs_ty : mkTyVarTys scoped_tvs)
; qtvs <- quantifyTyVars emptyVarSet dvs
@@ -901,7 +906,7 @@ There are several fiddly subtleties lurking here
data family X a :: forall k. * -> * -- Note: a forall that is not used
data instance X Int b = MkX
- So the data intance is really
+ So the data instance is really
data istance X Int @k b = MkX
The axiom will look like
diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs
index eda86f9..ce7cc83 100644
--- a/compiler/typecheck/TcTyClsDecls.hs
+++ b/compiler/typecheck/TcTyClsDecls.hs
@@ -1817,8 +1817,8 @@ indexed-types/should_compile/T12369 for an example.
So, the kind-checker must return the new skolems and args (that is, Type
or (Type -> Type) for the equations above) and the instantiated kind.
-Note [Generalising in tcFamTyPatsAndThen]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Note [Generalising in tcFamTyPatsGuts]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Suppose we have something like
type instance forall (a::k) b. F t1 t2 = rhs
@@ -1872,7 +1872,12 @@ tcTyFamInstEqnGuts fam_tc mb_clsinfo imp_vars exp_bndrs hs_pats hs_rhs_ty
; rhs_ty <- tcCheckLHsType hs_rhs_ty rhs_kind
; return (lhs_ty, rhs_ty) }
- -- See Note [Generalising in tcFamTyPatsAndThen]
+ -- See Note [Generalising in tcFamTyPatsGuts]
+ -- This code (and the stuff immediately above) is very similar
+ -- to that in tcDataFamHeader. Maybe we should abstract the
+ -- common code; but for the moment I concluded that it's
+ -- clearer to duplicate it. Still, if you fix a bug here,
+ -- check there too!
; let scoped_tvs = imp_tvs ++ exp_tvs
; dvs <- candidateQTyVarsOfTypes (lhs_ty : mkTyVarTys scoped_tvs)
; qtvs <- quantifyTyVars emptyVarSet dvs
@@ -1882,6 +1887,9 @@ tcTyFamInstEqnGuts fam_tc mb_clsinfo imp_vars exp_bndrs hs_pats hs_rhs_ty
; rhs_ty <- zonkTcTypeToTypeX ze rhs_ty
; let pats = unravelFamInstPats lhs_ty
+ -- Note that we do this after solveEqualities
+ -- so that any strange coercions inside lhs_ty
+ -- have been solved before we attempt to unravel it
; traceTc "tcTyFamInstEqnGuts }" (ppr fam_tc <+> pprTyVars qtvs)
; return (qtvs, pats, rhs_ty) }
where
@@ -1963,6 +1971,10 @@ unravelFamInstPats fam_app
= case splitTyConApp_maybe fam_app of
Just (_, pats) -> pats
Nothing -> WARN( True, bad_lhs fam_app ) []
+ -- The Nothing case cannot happen for type families, because
+ -- we don't call unravelFamInstPats until we've solved the
+ -- equalities. For data families I wasn't quite as convinced
+ -- so I've let it as a warning rather than a panic.
where
bad_lhs fam_app
= hang (text "Ill-typed LHS of family instance")
More information about the ghc-commits
mailing list