Commit f8618a9b authored by Richard Eisenberg's avatar Richard Eisenberg

Remove the type-checking knot.

Bug #15380 hangs because a knot-tied TyCon ended up in a kind.
Looking at the code in tcInferApps, I'm amazed this hasn't happened
before! I couldn't think of a good way to fix it (with dependent
types, we can't really keep types out of kinds, after all), so
I just went ahead and removed the knot.

This was remarkably easy to do. In tcTyVar, when we find a TcTyCon,
just use it. (Previously, we looked up the knot-tied TyCon and used
that.) Then, during the final zonk, replace TcTyCons with the real,
full-blooded TyCons in the global environment. It's all very easy.

The new bit is explained in the existing
Note [Type checking recursive type and class declarations]
in TcTyClsDecls.

Naturally, I removed various references to the knot and the
zonkTcTypeInKnot (and related) functions. Now, we can print types
during type checking with abandon!

NB: There is a teensy error message regression with this patch,
around the ordering of quantified type variables. This ordering
problem is fixed (I believe) with the patch for #14880. The ordering
affects only internal variables that cannot be instantiated with
any kind of visible type application.

There is also a teensy regression around the printing of types
in TH splices. I think this is really a TH bug and will file
separately.

Test case: dependent/should_fail/T15380
parent 1df50a0f
......@@ -844,27 +844,27 @@ isMarkedStrict _ = True -- All others are strict
-- | Build a new data constructor
mkDataCon :: Name
-> Bool -- ^ Is the constructor declared infix?
-> TyConRepName -- ^ TyConRepName for the promoted TyCon
-> [HsSrcBang] -- ^ Strictness/unpack annotations, from user
-> [FieldLabel] -- ^ Field labels for the constructor,
-- if it is a record, otherwise empty
-> [TyVar] -- ^ Universals.
-> [TyVar] -- ^ Existentials.
-> [TyVarBinder] -- ^ User-written 'TyVarBinder's.
-- These must be Inferred/Specified.
-- See @Note [TyVarBinders in DataCons]@
-> [EqSpec] -- ^ GADT equalities
-> ThetaType -- ^ Theta-type occuring before the arguments proper
-> [Type] -- ^ Original argument types
-> Type -- ^ Original result type
-> RuntimeRepInfo -- ^ See comments on 'TyCon.RuntimeRepInfo'
-> TyCon -- ^ Representation type constructor
-> ConTag -- ^ Constructor tag
-> ThetaType -- ^ The "stupid theta", context of the data
-- declaration e.g. @data Eq a => T a ...@
-> Id -- ^ Worker Id
-> DataConRep -- ^ Representation
-> Bool -- ^ Is the constructor declared infix?
-> TyConRepName -- ^ TyConRepName for the promoted TyCon
-> [HsSrcBang] -- ^ Strictness/unpack annotations, from user
-> [FieldLabel] -- ^ Field labels for the constructor,
-- if it is a record, otherwise empty
-> [TyVar] -- ^ Universals.
-> [TyVar] -- ^ Existentials.
-> [TyVarBinder] -- ^ User-written 'TyVarBinder's.
-- These must be Inferred/Specified.
-- See @Note [TyVarBinders in DataCons]@
-> [EqSpec] -- ^ GADT equalities
-> KnotTied ThetaType -- ^ Theta-type occuring before the arguments proper
-> [KnotTied Type] -- ^ Original argument types
-> KnotTied Type -- ^ Original result type
-> RuntimeRepInfo -- ^ See comments on 'TyCon.RuntimeRepInfo'
-> KnotTied TyCon -- ^ Representation type constructor
-> ConTag -- ^ Constructor tag
-> ThetaType -- ^ The "stupid theta", context of the data
-- declaration e.g. @data Eq a => T a ...@
-> Id -- ^ Worker Id
-> DataConRep -- ^ Representation
-> DataCon
-- Can get the tag from the TyCon
......@@ -1429,8 +1429,8 @@ buildAlgTyCon tc_name ktvs roles cType stupid_theta rhs
where
binders = mkTyConBindersPreferAnon ktvs liftedTypeKind
buildSynTyCon :: Name -> [TyConBinder] -> Kind -- ^ /result/ kind
-> [Role] -> Type -> TyCon
buildSynTyCon :: Name -> [KnotTied TyConBinder] -> Kind -- ^ /result/ kind
-> [Role] -> KnotTied Type -> TyCon
buildSynTyCon name binders res_kind roles rhs
= mkSynonymTyCon name binders res_kind roles rhs is_tau is_fam_free
where
......
......@@ -8,7 +8,7 @@
module BuildTyCl (
buildDataCon,
buildPatSyn,
TcMethInfo, buildClass,
TcMethInfo, MethInfo, buildClass,
mkNewTyConRhs,
newImplicitBinder, newTyConRepName
) where
......@@ -104,10 +104,11 @@ buildDataCon :: FamInstEnvs
-> [TyVar] -- Existentials
-> [TyVarBinder] -- User-written 'TyVarBinder's
-> [EqSpec] -- Equality spec
-> ThetaType -- Does not include the "stupid theta"
-> KnotTied ThetaType -- Does not include the "stupid theta"
-- or the GADT equalities
-> [Type] -> Type -- Argument and result types
-> TyCon -- Rep tycon
-> [KnotTied Type] -- Arguments
-> KnotTied Type -- Result types
-> KnotTied TyCon -- Rep tycon
-> NameEnv ConTag -- Maps the Name of each DataCon to its
-- ConTag
-> TcRnIf m n DataCon
......@@ -213,7 +214,8 @@ buildPatSyn src_name declared_infix matcher@(matcher_id,_) builder
------------------------------------------------------
type TcMethInfo -- A temporary intermediate, to communicate
type TcMethInfo = MethInfo -- this variant needs zonking
type MethInfo -- A temporary intermediate, to communicate
-- between tcClassSigs and buildClass.
= ( Name -- Name of the class op
, Type -- Type of the class op
......@@ -237,7 +239,7 @@ buildClass :: Name -- Name of the class/tycon (they have the same Name)
-> [FunDep TyVar] -- Functional dependencies
-- Super classes, associated types, method info, minimal complete def.
-- This is Nothing if the class is abstract.
-> Maybe (ThetaType, [ClassATItem], [TcMethInfo], ClassMinimalDef)
-> Maybe (KnotTied ThetaType, [ClassATItem], [KnotTied MethInfo], ClassMinimalDef)
-> TcRnIf m n Class
buildClass tycon_name binders roles fds Nothing
......
......@@ -443,7 +443,7 @@ checkFamInstConsistency directlyImpMods
-- as quickly as possible, so that we aren't typechecking
-- values with inconsistent axioms in scope.
--
-- See also Note [Tying the knot] and Note [Type-checking inside the knot]
-- See also Note [Tying the knot]
-- for why we are doing this at all.
; let check_now = famInstEnvElts env1
; mapM_ (checkForConflicts (emptyFamInstEnv, env2)) check_now
......
......@@ -18,7 +18,7 @@ module TcEnv(
tcExtendGlobalEnv, tcExtendTyConEnv,
tcExtendGlobalEnvImplicit, setGlobalTypeEnv,
tcExtendGlobalValEnv,
tcLookupLocatedGlobal, tcLookupGlobal,
tcLookupLocatedGlobal, tcLookupGlobal, tcLookupGlobalOnly,
tcLookupTyCon, tcLookupClass,
tcLookupDataCon, tcLookupPatSyn, tcLookupConLike,
tcLookupLocatedGlobalId, tcLookupLocatedTyCon,
......@@ -229,6 +229,15 @@ tcLookupGlobal name
Failed msg -> failWithTc msg
}}}
-- Look up only in this module's global env't. Don't look in imports, etc.
-- Panic if it's not there.
tcLookupGlobalOnly :: Name -> TcM TyThing
tcLookupGlobalOnly name
= do { env <- getGblEnv
; return $ case lookupNameEnv (tcg_type_env env) name of
Just thing -> thing
Nothing -> pprPanic "tcLookupGlobalOnly" (ppr name) }
tcLookupDataCon :: Name -> TcM DataCon
tcLookupDataCon name = do
thing <- tcLookupGlobal name
......
......@@ -34,8 +34,9 @@ module TcHsSyn (
zonkTyVarBindersX, zonkTyVarBinderX,
emptyZonkEnv, mkEmptyZonkEnv,
zonkTcTypeToType, zonkTcTypeToTypes, zonkTyVarOcc,
zonkCoToCo, zonkSigType,
zonkEvBinds, zonkTcEvBinds
zonkCoToCo,
zonkEvBinds, zonkTcEvBinds,
zonkTcMethInfoToMethInfo
) where
#include "HsVersions.h"
......@@ -47,11 +48,13 @@ import Id
import IdInfo
import TcRnMonad
import PrelNames
import BuildTyCl ( TcMethInfo, MethInfo )
import TcType
import TcMType
import TcEnv ( tcLookupGlobalOnly )
import TcEvidence
import TysPrim
import TyCon ( isUnboxedTupleTyCon )
import TyCon
import TysWiredIn
import TyCoRep( CoercionHole(..) )
import Type
......@@ -1675,11 +1678,20 @@ zonkCoHole env hole@(CoercionHole { ch_ref = ref, ch_co_var = cv })
zonk_tycomapper :: TyCoMapper ZonkEnv TcM
zonk_tycomapper = TyCoMapper
{ tcm_smart = True -- Establish type invariants
-- See Note [Type-checking inside the knot] in TcHsType
, tcm_tyvar = zonkTyVarOcc
, tcm_covar = zonkCoVarOcc
, tcm_hole = zonkCoHole
, tcm_tybinder = \env tv _vis -> zonkTyBndrX env tv }
, tcm_tybinder = \env tv _vis -> zonkTyBndrX env tv
, tcm_tycon = zonkTcTyConToTyCon }
-- Zonk a TyCon by changing a TcTyCon to a regular TyCon
zonkTcTyConToTyCon :: TcTyCon -> TcM TyCon
zonkTcTyConToTyCon tc
| isTcTyCon tc = do { thing <- tcLookupGlobalOnly (getName tc)
; case thing of
ATyCon real_tc -> return real_tc
_ -> pprPanic "zonkTcTyCon" (ppr tc $$ ppr thing) }
| otherwise = return tc -- it's already zonked
-- Confused by zonking? See Note [What is zonking?] in TcMType.
zonkTcTypeToType :: ZonkEnv -> TcType -> TcM Type
......@@ -1691,18 +1703,19 @@ zonkTcTypeToTypes env tys = mapM (zonkTcTypeToType env) tys
zonkCoToCo :: ZonkEnv -> Coercion -> TcM Coercion
zonkCoToCo = mapCoercion zonk_tycomapper
zonkSigType :: TcType -> TcM Type
-- Zonk the type obtained from a user type signature
-- We want to turn any quantified (forall'd) variables into TyVars
-- but we may find some free TcTyVars, and we want to leave them
-- completely alone. They may even have unification variables inside
-- e.g. f (x::a) = ...(e :: a -> a)....
-- The type sig for 'e' mentions a free 'a' which will be a
-- unification SigTv variable.
zonkSigType = zonkTcTypeToType (mkEmptyZonkEnv zonk_unbound_tv)
zonkTcMethInfoToMethInfo :: TcMethInfo -> TcM MethInfo
zonkTcMethInfoToMethInfo (name, ty, gdm_spec)
= do { ty' <- zonkTcTypeToType emptyZonkEnv ty
; gdm_spec' <- zonk_gdm gdm_spec
; return (name, ty', gdm_spec') }
where
zonk_unbound_tv :: UnboundTyVarZonker
zonk_unbound_tv tv = return (mkTyVarTy tv)
zonk_gdm :: Maybe (DefMethSpec (SrcSpan, TcType))
-> TcM (Maybe (DefMethSpec (SrcSpan, Type)))
zonk_gdm Nothing = return Nothing
zonk_gdm (Just VanillaDM) = return (Just VanillaDM)
zonk_gdm (Just (GenericDM (loc, ty)))
= do { ty' <- zonkTcTypeToType emptyZonkEnv ty
; return (Just (GenericDM (loc, ty'))) }
zonkTvSkolemising :: UnboundTyVarZonker
-- This variant is used for the LHS of rules
......
This diff is collapsed.
......@@ -74,7 +74,6 @@ module TcMType (
zonkTcTyCoVarBndr, zonkTcTyVarBinder,
zonkTcType, zonkTcTypes, zonkCo,
zonkTyCoVarKind, zonkTcTypeMapper,
zonkTcTypeInKnot,
zonkEvVar, zonkWC, zonkSimples,
zonkId, zonkCoVar,
......@@ -306,8 +305,7 @@ unpackCoercionHole_maybe :: CoercionHole -> TcM (Maybe Coercion)
unpackCoercionHole_maybe (CoercionHole { ch_ref = ref }) = readTcRef ref
-- | Check that a coercion is appropriate for filling a hole. (The hole
-- itself is needed only for printing. NB: This must be /lazy/ in the coercion,
-- as it's used in TcHsSyn in the presence of knots.
-- itself is needed only for printing.
-- Always returns the checked coercion, but this return value is necessary
-- so that the input coercion is forced only when the output is forced.
checkCoercionHole :: CoVar -> Coercion -> TcM Coercion
......@@ -1317,11 +1315,6 @@ tcGetGlobalTyCoVars
; writeMutVar gtv_var gbl_tvs'
; return gbl_tvs' }
-- | Zonk a type without using the smart constructors; the result type
-- is available for inspection within the type-checking knot.
zonkTcTypeInKnot :: TcType -> TcM TcType
zonkTcTypeInKnot = mapType (zonkTcTypeMapper { tcm_smart = False }) ()
zonkTcTypeAndFV :: TcType -> TcM DTyCoVarSet
-- Zonk a type and take its free variables
-- With kind polymorphism it can be essential to zonk *first*
......@@ -1329,20 +1322,17 @@ zonkTcTypeAndFV :: TcType -> TcM DTyCoVarSet
-- forall k1. forall (a:k2). a
-- where k2:=k1 is in the substitution. We don't want
-- k2 to look free in this type!
-- NB: This might be called from within the knot, so don't use
-- smart constructors. See Note [Type-checking inside the knot] in TcHsType
zonkTcTypeAndFV ty
= tyCoVarsOfTypeDSet <$> zonkTcTypeInKnot ty
= tyCoVarsOfTypeDSet <$> zonkTcType ty
-- | Zonk a type and call 'candidateQTyVarsOfType' on it.
-- Works within the knot.
zonkTcTypeAndSplitDepVars :: TcType -> TcM CandidatesQTvs
zonkTcTypeAndSplitDepVars ty
= candidateQTyVarsOfType <$> zonkTcTypeInKnot ty
= candidateQTyVarsOfType <$> zonkTcType ty
zonkTcTypesAndSplitDepVars :: [TcType] -> TcM CandidatesQTvs
zonkTcTypesAndSplitDepVars tys
= candidateQTyVarsOfTypes <$> mapM zonkTcTypeInKnot tys
= candidateQTyVarsOfTypes <$> mapM zonkTcType tys
zonkTyCoVar :: TyCoVar -> TcM TcType
-- Works on TyVars and TcTyVars
......@@ -1527,7 +1517,7 @@ zonkId id
zonkCoVar :: CoVar -> TcM CoVar
zonkCoVar = zonkId
-- | A suitable TyCoMapper for zonking a type inside the knot, and
-- | A suitable TyCoMapper for zonking a type during type-checking,
-- before all metavars are filled in.
zonkTcTypeMapper :: TyCoMapper () TcM
zonkTcTypeMapper = TyCoMapper
......@@ -1535,7 +1525,8 @@ zonkTcTypeMapper = TyCoMapper
, tcm_tyvar = const zonkTcTyVar
, tcm_covar = const (\cv -> mkCoVarCo <$> zonkTyCoVarKind cv)
, tcm_hole = hole
, tcm_tybinder = \_env tv _vis -> ((), ) <$> zonkTcTyCoVarBndr tv }
, tcm_tybinder = \_env tv _vis -> ((), ) <$> zonkTcTyCoVarBndr tv
, tcm_tycon = return }
where
hole :: () -> CoercionHole -> TcM Coercion
hole _ hole@(CoercionHole { ch_ref = ref, ch_co_var = cv })
......@@ -1546,7 +1537,6 @@ zonkTcTypeMapper = TyCoMapper
Nothing -> do { cv' <- zonkCoVar cv
; return $ HoleCo (hole { ch_co_var = cv' }) } }
-- For unbound, mutable tyvars, zonkType uses the function given to it
-- For tyvars bound at a for-all, zonkType zonks them to an immutable
-- type variable and zonks the kind too
......
......@@ -213,7 +213,7 @@ tcTyClDecls tyclds role_annots
; tcExtendRecEnv (zipRecTyClss tc_tycons rec_tyclss) $
-- Also extend the local type envt with bindings giving
-- the (polymorphic) kind of each knot-tied TyCon or Class
-- a TcTyCon for each each knot-tied TyCon or Class
-- See Note [Type checking recursive type and class declarations]
-- and Note [Type environment evolution]
tcExtendKindEnvWithTyCons tc_tycons $
......@@ -225,7 +225,8 @@ tcTyClDecls tyclds role_annots
promotion_err_env = mkPromotionErrorEnv tyclds
ppr_tc_tycon tc = parens (sep [ ppr (tyConName tc) <> comma
, ppr (tyConBinders tc) <> comma
, ppr (tyConResKind tc) ])
, ppr (tyConResKind tc)
, ppr (isTcTyCon tc) ])
zipRecTyClss :: [TcTyCon]
-> [TyCon] -- Knot-tied
......@@ -374,6 +375,8 @@ TcTyCons are used for two distinct purposes
In a TcTyCon, everything is zonked after the kind-checking pass (S2).
See also Note [Type checking recursive type and class declarations].
Note [Check telescope again during generalisation]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The telescope check before kind generalisation is useful to catch something
......@@ -907,12 +910,11 @@ without looking at T? Delicate answer: during tcTyClDecl, we extend
Then:
* During TcHsType.kcTyVar we look in the *local* env, to get the
known kind for T.
* During TcHsType.tcTyVar we look in the *local* env, to get the
fully-known, not knot-tied TcTyCon for T.
* But in TcHsType.ds_type (and ds_var_app in particular) we look in
the *global* env to get the TyCon. But we must be careful not to
force the TyCon or we'll get a loop.
* Then, in TcHsSyn.zonkTcTypeToType (and zonkTcTyCon in particular) we look in
the *global* env to get the TyCon.
This fancy footwork (with two bindings for T) is only necessary for the
TyCons or Classes of this recursive group. Earlier, finished groups,
......@@ -1008,11 +1010,17 @@ tcTyClDecl1 _parent roles_info
-- TODO: Allow us to distinguish between abstract class,
-- and concrete class with no methods (maybe by
-- specifying a trailing where or not
; sig_stuff' <- mapM zonkTcMethInfoToMethInfo sig_stuff
-- this zonk is really just to squeeze out the TcTyCons
-- and convert, e.g., Skolems to tyvars. We won't
-- see any unfilled metavariables here.
; is_boot <- tcIsHsBootOrSig
; let body | is_boot, null ctxt', null at_stuff, null sig_stuff
= Nothing
| otherwise
= Just (ctxt', at_stuff, sig_stuff, mindef)
= Just (ctxt', at_stuff, sig_stuff', mindef)
; clas <- buildClass class_name binders roles fds' body
; traceTc "tcClassDecl" (ppr fundeps $$ ppr binders $$
ppr fds')
......@@ -1096,13 +1104,7 @@ tcFamDecl1 parent (FamilyDecl { fdInfo = fam_info, fdLName = tc_lname@(L _ tc_na
-- for this afterwards, in TcValidity.checkValidCoAxiom
-- Example: tc265
-- Create a CoAxiom, with the correct src location. It is Vitally
-- Important that we do not pass the branches into
-- newFamInstAxiomName. They have types that have been zonked inside
-- the knot and we will die if we look at them. This is OK here
-- because there will only be one axiom, so we don't need to
-- differentiate names.
-- See [Zonking inside the knot] in TcHsType
-- Create a CoAxiom, with the correct src location.
; co_ax_name <- newFamInstAxiomName tc_lname []
; let mb_co_ax
......@@ -1301,7 +1303,7 @@ tcClassATs class_name cls ats at_defs
-------------------------
tcDefaultAssocDecl :: TyCon -- ^ Family TyCon (not knot-tied)
-> [LTyFamDefltEqn GhcRn] -- ^ Defaults
-> TcM (Maybe (Type, SrcSpan)) -- ^ Type checked RHS
-> TcM (Maybe (KnotTied Type, SrcSpan)) -- ^ Type checked RHS
tcDefaultAssocDecl _ []
= return Nothing -- No default declaration
......@@ -1384,7 +1386,15 @@ F's own type variables, so we need to convert it to (Proxy a -> b).
We do this by calling tcMatchTys to match them up. This also ensures
that x's kind matches a's and similarly for y and b. The error
message isn't great, mind you. (Trac #11361 was caused by not doing a
proper tcMatchTys here.) -}
proper tcMatchTys here.)
Recall also that the left-hand side of an associated type family
default is always just variables -- no tycons here. Accordingly,
the patterns used in the tcMatchTys won't actually be knot-tied,
even though we're in the knot. This is too delicate for my taste,
but it works.
-}
-------------------------
kcTyFamInstEqn :: TcTyCon -> LTyFamInstEqn GhcRn -> TcM ()
......@@ -1438,7 +1448,7 @@ kcTyFamEqnRhs mb_clsinfo rhs_hs_ty lhs_ki
mb_kind_env = thdOf3 <$> mb_clsinfo
tcTyFamInstEqn :: TcTyCon -> Maybe ClsInstInfo -> LTyFamInstEqn GhcRn
-> TcM CoAxBranch
-> TcM (KnotTied CoAxBranch)
-- Needs to be here, not in TcInstDcls, because closed families
-- (typechecked here) have TyFamInstEqns
tcTyFamInstEqn fam_tc mb_clsinfo
......@@ -1457,7 +1467,6 @@ tcTyFamInstEqn fam_tc mb_clsinfo
; pats' <- zonkTcTypeToTypes ze pats
; rhs_ty' <- zonkTcTypeToType ze rhs_ty
; traceTc "tcTyFamInstEqn" (ppr fam_tc <+> pprTyVars tvs')
-- don't print out the pats here, as they might be zonked inside the knot
; return (mkCoAxBranch tvs' [] pats' rhs_ty'
(map (const Nominal) tvs')
loc) }
......@@ -1680,7 +1689,7 @@ tcFamTyPats fam_tc mb_clsinfo
; qtkvs <- quantifyTyVars emptyVarSet vars
; when debugIsOn $
do { all_pats <- mapM zonkTcTypeInKnot all_pats
do { all_pats <- mapM zonkTcType all_pats
; MASSERT2( isEmptyVarSet $ coVarsOfTypes all_pats, ppr all_pats ) }
-- This should be the case, because otherwise the solveEqualities
-- above would fail. TODO (RAE): Update once the solveEqualities
......@@ -1688,7 +1697,6 @@ tcFamTyPats fam_tc mb_clsinfo
; traceTc "tcFamTyPats" (ppr (getName fam_tc)
$$ ppr all_pats $$ ppr qtkvs)
-- Don't print out too much, as we might be in the knot
-- See Note [Free-floating kind vars] in TcHsType
; let all_mentioned_tvs = mkVarSet qtkvs
......@@ -1842,7 +1850,7 @@ consUseGadtSyntax _ = False
-- All constructors have same shape
-----------------------------------
tcConDecls :: TyCon -> ([TyConBinder], Type)
tcConDecls :: KnotTied TyCon -> ([KnotTied TyConBinder], KnotTied Type)
-> [LConDecl GhcRn] -> TcM [DataCon]
-- Why both the tycon tyvars and binders? Because the tyvars
-- have all the names and the binders have the visibilities.
......@@ -1852,9 +1860,9 @@ tcConDecls rep_tycon (tmpl_bndrs, res_tmpl)
-- It's important that we pay for tag allocation here, once per TyCon,
-- See Note [Constructor tag allocation], fixes #14657
tcConDecl :: TyCon -- Representation tycon. Knot-tied!
tcConDecl :: KnotTied TyCon -- Representation tycon. Knot-tied!
-> NameEnv ConTag
-> [TyConBinder] -> Type
-> [KnotTied TyConBinder] -> KnotTied Type
-- Return type template (with its template tyvars)
-- (tvs, T tys), where T is the family TyCon
-> ConDecl GhcRn
......@@ -2024,7 +2032,7 @@ tcConDecl _ _ _ _ (XConDecl _) = panic "tcConDecl"
quantifyConDecl :: TcTyCoVarSet -- outer tvs, not to be quantified over; zonked
-> TcType -> TcM [TcTyVar]
quantifyConDecl gbl_tvs ty
= do { ty <- zonkTcTypeInKnot ty
= do { ty <- zonkTcType ty
; let fvs = candidateQTyVarsOfType ty
; quantifyTyVars gbl_tvs fvs }
......@@ -2129,7 +2137,7 @@ errors reported in one pass. See Trac #7175, and #10836.
-- TI :: forall b1 c1. (b1 ~ c1) => b1 -> :R7T b1 c1
-- In this case orig_res_ty = T (e,e)
rejigConRes :: [TyConBinder] -> Type -- Template for result type; e.g.
rejigConRes :: [KnotTied TyConBinder] -> KnotTied Type -- Template for result type; e.g.
-- data instance T [a] b c ...
-- gives template ([a,b,c], T [a] b c)
-- Type must be of kind *!
......@@ -2137,7 +2145,7 @@ rejigConRes :: [TyConBinder] -> Type -- Template for result type; e.g.
-- type variables
-> [TyVar] -- The constructor's user-written, specified
-- type variables
-> Type -- res_ty type must be of kind *
-> KnotTied Type -- res_ty type must be of kind *
-> ([TyVar], -- Universal
[TyVar], -- Existential (distinct OccNames from univs)
[TyVar], -- The constructor's rejigged, user-written,
......@@ -2148,7 +2156,7 @@ rejigConRes :: [TyConBinder] -> Type -- Template for result type; e.g.
TCvSubst) -- Substitution to apply to argument types
-- We don't check that the TyCon given in the ResTy is
-- the same as the parent tycon, because checkValidDataCon will do it
-- NB: All arguments may potentially be knot-tied
rejigConRes tmpl_bndrs res_tmpl dc_inferred_tvs dc_specified_tvs res_ty
-- E.g. data T [a] b c where
-- MkT :: forall x y z. T [(x,y)] z z
......
......@@ -23,6 +23,7 @@ module TcType (
TcType, TcSigmaType, TcRhoType, TcTauType, TcPredType, TcThetaType,
TcTyVar, TcTyVarSet, TcDTyVarSet, TcTyCoVarSet, TcDTyCoVarSet,
TcKind, TcCoVar, TcTyCoVar, TcTyVarBinder, TcTyCon,
KnotTied,
ExpType(..), InferResult(..), ExpSigmaType, ExpRhoType, mkCheckExpType,
......@@ -51,8 +52,7 @@ module TcType (
--------------------------------
-- Builders
mkPhiTy, mkInfSigmaTy, mkSpecSigmaTy, mkSigmaTy,
mkNakedTyConApp, mkNakedAppTys, mkNakedAppTy,
mkNakedCastTy, nakedSubstTy,
mkNakedAppTy, mkNakedAppTys, mkNakedCastTy, nakedSubstTy,
--------------------------------
-- Splitters
......@@ -353,7 +353,6 @@ type TcTyCoVarSet = TyCoVarSet
type TcDTyVarSet = DTyVarSet
type TcDTyCoVarSet = DTyCoVarSet
{- *********************************************************************
* *
ExpType: an "expected type" in the type checker
......@@ -1451,27 +1450,17 @@ Notes:
not substTy, because the latter uses smart constructors that do
Refl-elimination.
* None of this is to do with knot-tying, which is the (quite distinct)
motivation for mkNakedTyConApp
-}
---------------
mkNakedTyConApp :: TyCon -> [Type] -> Type
-- Builds a TyConApp
-- * without being strict in TyCon,
-- * without satisfying the invariants of TyConApp
-- A subsequent zonking will establish the invariants
-- See Note [Type-checking inside the knot] in TcHsType
mkNakedTyConApp tc tys = TyConApp tc tys
mkNakedAppTys :: Type -> [Type] -> Type
-- See Note [Type-checking inside the knot] in TcHsType
-- See Note [The well-kinded type invariant]
mkNakedAppTys ty1 [] = ty1
mkNakedAppTys (TyConApp tc tys1) tys2 = mkNakedTyConApp tc (tys1 ++ tys2)
mkNakedAppTys (TyConApp tc tys1) tys2 = mkTyConApp tc (tys1 ++ tys2)
mkNakedAppTys ty1 tys2 = foldl AppTy ty1 tys2
mkNakedAppTy :: Type -> Type -> Type
-- See Note [Type-checking inside the knot] in TcHsType
-- See Note [The well-kinded type invariant]
mkNakedAppTy ty1 ty2 = mkNakedAppTys ty1 [ty2]
mkNakedCastTy :: Type -> Coercion -> Type
......@@ -1499,7 +1488,8 @@ nakedSubstMapper
, tcm_tyvar = \subst tv -> return (substTyVar subst tv)
, tcm_covar = \subst cv -> return (substCoVar subst cv)
, tcm_hole = \_ hole -> return (HoleCo hole)
, tcm_tybinder = \subst tv _ -> return (substTyVarBndr subst tv) }
, tcm_tybinder = \subst tv _ -> return (substTyVarBndr subst tv)
, tcm_tycon = return }
{-
************************************************************************
......
......@@ -26,6 +26,7 @@ module TyCoRep (
Type(..),
TyLit(..),
KindOrType, Kind,
KnotTied,
PredType, ThetaType, -- Synonyms
ArgFlag(..),
......@@ -468,6 +469,11 @@ These invariants are all documented above, in the declaration for Type.
-}
-- | A type labeled 'KnotTied' might have knot-tied tycons in it. See
-- Note [Type checking recursive type and class declarations] in
-- TcTyClsDecls
type KnotTied ty = ty
{- **********************************************************************
* *
TyBinder and ArgFlag
......
......@@ -10,7 +10,8 @@ The @TyCon@ datatype
module TyCon(
-- * Main TyCon data types
TyCon, AlgTyConRhs(..), visibleDataCons,
TyCon,
AlgTyConRhs(..), visibleDataCons,
AlgTyConFlav(..), isNoParent,
FamTyConFlav(..), Role(..), Injectivity(..),
RuntimeRepInfo(..), TyConFlavour(..),
......@@ -812,7 +813,8 @@ data TyCon
promDcRepInfo :: RuntimeRepInfo -- ^ See comments with 'RuntimeRepInfo'
}
-- | These exist only during a recursive type/class type-checking knot.
-- | These exist only during type-checking. See Note [How TcTyCons work]
-- in TcTyClsDecls
| TcTyCon {
tyConUnique :: Unique,
tyConName :: Name,
......@@ -1530,10 +1532,11 @@ mkSumTyCon name binders res_kind arity tyvars cons parent
algTcParent = parent
}
-- | Makes a tycon suitable for use during type-checking.
-- The only real need for this is for printing error messages during
-- a recursive type/class type-checking knot. It has a kind because
-- TcErrors sometimes calls typeKind.
-- | Makes a tycon suitable for use during type-checking. It stores
-- a variety of details about the definition of the TyCon, but no
-- right-hand side. It lives only during the type-checking of a
-- mutually-recursive group of tycons; it is then zonked to a proper
-- TyCon in zonkTcTyCon.
-- See also Note [Kind checking recursive type and class declarations]
-- in TcTyClsDecls.
mkTcTyCon :: Name
......@@ -2383,7 +2386,11 @@ instance Uniquable TyCon where
instance Outputable TyCon where
-- At the moment a promoted TyCon has the same Name as its
-- corresponding TyCon, so we add the quote to distinguish it here
ppr tc = pprPromotionQuote tc <> ppr (tyConName tc)
ppr tc = pprPromotionQuote tc <> ppr (tyConName tc) <> pp_tc
where
pp_tc = getPprStyle $ \sty -> if ((debugStyle sty || dumpStyle sty) && isTcTyCon tc)
then text "[tc]"
else empty
-- | Paints a picture of what a 'TyCon' represents, in broad strokes.
-- This is used towards more informative error messages.
......
......@@ -16,6 +16,7 @@ module Type (
-- $representation_types
TyThing(..), Type, ArgFlag(..), KindOrType, PredType, ThetaType,
Var, TyVar, isTyVar, TyCoVar, TyBinder, TyVarBinder,
KnotTied,
-- ** Constructing and deconstructing types
mkTyVarTy, mkTyVarTys, getTyVar, getTyVar_maybe, repGetTyVar_maybe,
......@@ -505,7 +506,7 @@ this one change made a 20% allocation difference in perf/compiler/T5030.
data TyCoMapper env m
= TyCoMapper
{ tcm_smart :: Bool -- ^ Should the new type be created with smart
-- constructors?
-- constructors?
, tcm_tyvar :: env -> TyVar -> m Type
, tcm_covar :: env -> CoVar -> m Coercion
, tcm_hole :: env -> CoercionHole -> m Coercion
......@@ -514,20 +515,28 @@ data TyCoMapper env m
, tcm_tybinder :: env -> TyVar -> ArgFlag -> m (env, TyVar)
-- ^ The returned env is used in the extended scope
, tcm_tycon :: TyCon -> m TyCon
-- ^ This is used only to turn 'TcTyCon's into 'TyCon's.
-- See Note [Type checking recursive type and class declarations]
-- in TcTyClsDecls
}
{-# INLINABLE mapType #-} -- See Note [Specialising mappers]
mapType :: Monad m => TyCoMapper env m -> env -> Type -> m Type
mapType mapper@(TyCoMapper { tcm_smart = smart, tcm_tyvar = tyvar
, tcm_tybinder = tybinder })
, tcm_tybinder = tybinder, tcm_tycon = tycon })
env ty
= go ty
where
go (TyVarTy tv) = tyvar env tv
go (AppTy t1 t2) = mkappty <$> go t1 <*> go t2
go t@(TyConApp _ []) = return t -- avoid allocation in this exceedingly
-- common case (mostly, for *)
go (TyConApp tc tys) = mktyconapp tc <$> mapM go tys
go t@(TyConApp tc []) | not (isTcTyCon tc)
= return t -- avoid allocation in this exceedingly
-- common case (mostly, for *)
go (TyConApp tc tys)
= do { tc' <- tycon tc
; mktyconapp tc' <$> mapM go tys }
go (FunTy arg res) = FunTy <$> go arg <*> go res
go (ForAllTy (TvBndr tv vis) inner)
= do { (env', tv') <- tybinder env tv vis
......@@ -545,7 +554,8 @@ mapType mapper@(TyCoMapper { tcm_smart = smart, tcm_tyvar = tyvar
mapCoercion :: Monad m
=> TyCoMapper env m -> env -> Coercion -> m Coercion
mapCoercion mapper@(TyCoMapper { tcm_smart = smart, tcm_covar = covar
, tcm_hole = cohole, tcm_tybinder = tybinder })
, tcm_hole = cohole, tcm_tybinder = tybinder
, tcm_tycon = tycon })
env co
= go co
where
......@@ -555,7 +565,8 @@ mapCoercion mapper@(TyCoMapper { tcm_smart = smart, tcm_covar = covar
go (Refl ty) = Refl <$> mapType mapper env ty
go (GRefl r ty mco) = mkgreflco r <$> mapType mapper env ty <*> (go_mco mco)
go (TyConAppCo r tc args)
= mktyconappco r tc <$> mapM go args
= do { tc' <- tycon tc
; mktyconappco r tc' <$> mapM go args }
go (AppCo c1 c2) = mkappco <$> go c1 <*> go c2
go (ForAllCo tv kind_co co)
= do { kind_co' <- go kind_co
......
T14066a.hs:13:3: warning:
Type family instance equation is overlapped:
forall c d (x :: c) (y :: d).
forall d c (x :: c) (y :: d).
Bar x y = Bool -- Defined at T14066a.hs:13:3
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE TypeOperators #-}
module T15380 where
import Data.Kind
class Generic a where
type Rep a :: Type
class PGeneric a where
type To a (x :: Rep a) :: a