Commit 12eff239 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Use TyVars in PatSyns

I found that some TcTyVars were lurking in a PatSyn, because
tc_patsyn_finish was using the TcType -> TcType zonker rather
than the TcType -> Type zonker.  Eeek.

I fixing this I also tided up function naming a bit (still not
terrific), and removed the unused TcTyBinder type entirely.
parent edbe8319
......@@ -27,7 +27,7 @@ module TcHsSyn (
-- in TcMType
zonkTopDecls, zonkTopExpr, zonkTopLExpr,
zonkTopBndrs, zonkTyBndrsX,
zonkTyConBinders,
zonkTyVarBindersX, zonkTyVarBinderX,
emptyZonkEnv, mkEmptyZonkEnv,
zonkTcTypeToType, zonkTcTypeToTypes, zonkTyVarOcc,
zonkCoToCo, zonkSigType,
......@@ -335,10 +335,10 @@ zonkEvVarOcc env v
| otherwise
= return (EvId $ zonkIdOcc env v)
zonkTyBndrsX :: ZonkEnv -> [TyVar] -> TcM (ZonkEnv, [TyVar])
zonkTyBndrsX :: ZonkEnv -> [TcTyVar] -> TcM (ZonkEnv, [TyVar])
zonkTyBndrsX = mapAccumLM zonkTyBndrX
zonkTyBndrX :: ZonkEnv -> TyVar -> TcM (ZonkEnv, TyVar)
zonkTyBndrX :: ZonkEnv -> TcTyVar -> TcM (ZonkEnv, TyVar)
-- This guarantees to return a TyVar (not a TcTyVar)
-- then we add it to the envt, so all occurrences are replaced
zonkTyBndrX env tv
......@@ -348,11 +348,14 @@ zonkTyBndrX env tv
; let tv' = mkTyVar (tyVarName tv) ki
; return (extendTyZonkEnv1 env tv', tv') }
zonkTyConBinders :: ZonkEnv -> [TyConBinder] -> TcM (ZonkEnv, [TyConBinder])
zonkTyConBinders = mapAccumLM zonkTyConBinderX
zonkTyVarBindersX :: ZonkEnv -> [TyVarBndr TcTyVar vis]
-> TcM (ZonkEnv, [TyVarBndr TyVar vis])
zonkTyVarBindersX = mapAccumLM zonkTyVarBinderX
zonkTyConBinderX :: ZonkEnv -> TyConBinder -> TcM (ZonkEnv, TyConBinder)
zonkTyConBinderX env (TvBndr tv vis)
zonkTyVarBinderX :: ZonkEnv -> TyVarBndr TcTyVar vis
-> TcM (ZonkEnv, TyVarBndr TyVar vis)
-- Takes a TcTyVar and guarantees to return a TyVar
zonkTyVarBinderX env (TvBndr tv vis)
= do { (env', tv') <- zonkTyBndrX env tv
; return (env', TvBndr tv' vis) }
......
......@@ -1220,7 +1220,7 @@ Note [Dependent LHsQTyVars]
We track (in the renamer) which explicitly bound variables in a
LHsQTyVars are manifestly dependent; only precisely these variables
may be used within the LHsQTyVars. We must do this so that kcHsTyVarBndrs
can produce the right TcTyBinders, and tell Anon vs. Named. Earlier,
can produce the right TyConBinders, and tell Anon vs. Named. Earlier,
I thought it would work simply to do a free-variable check during
kcHsTyVarBndrs, but this is bogus, because there may be unsolved
equalities about. And we don't want to eagerly solve the equalities,
......@@ -1283,7 +1283,7 @@ kcHsTyVarBndrs name unsat cusk open_fam all_kind_vars
-- Now, because we're in a CUSK, quantify over the mentioned
-- kind vars, in dependency order.
; tc_binders <- mapM zonkTyConBinder tc_binders
; tc_binders <- mapM zonkTcTyVarBinder tc_binders
; res_kind <- zonkTcType res_kind
; let tc_tvs = binderVars tc_binders
qkvs = tyCoVarsOfTypeWellScoped (mkTyConKind tc_binders res_kind)
......
......@@ -75,7 +75,7 @@ module TcMType (
zonkTcTypeAndSplitDepVars, zonkTcTypesAndSplitDepVars,
zonkQuantifiedTyVar,
quantifyTyVars, quantifyZonkedTyVars,
zonkTcTyCoVarBndr, zonkTcTyBinder, zonkTyConBinder,
zonkTcTyCoVarBndr, zonkTcTyVarBinder,
zonkTcType, zonkTcTypes, zonkCo,
zonkTyCoVarKind, zonkTcTypeMapper,
......@@ -90,7 +90,6 @@ module TcMType (
import TyCoRep
import TcType
import Type
import TyCon( TyConBinder )
import Kind
import Coercion
import Class
......@@ -1435,16 +1434,8 @@ zonkTcTyCoVarBndr tyvar
= ASSERT2( isImmutableTyVar tyvar || (not $ isTyVar tyvar), pprTyVar tyvar )
updateTyVarKindM zonkTcType tyvar
-- | Zonk a TyBinder
zonkTcTyBinder :: TcTyBinder -> TcM TcTyBinder
zonkTcTyBinder (Anon ty) = Anon <$> zonkTcType ty
zonkTcTyBinder (Named tvb) = Named <$> zonkTyVarBinder tvb
zonkTyConBinder :: TyConBinder -> TcM TyConBinder
zonkTyConBinder = zonkTyVarBinder
zonkTyVarBinder :: TyVarBndr TyVar vis -> TcM (TyVarBndr TyVar vis)
zonkTyVarBinder (TvBndr tv vis)
zonkTcTyVarBinder :: TyVarBndr TcTyVar vis -> TcM (TyVarBndr TcTyVar vis)
zonkTcTyVarBinder (TvBndr tv vis)
= do { tv' <- zonkTcTyCoVarBndr tv
; return (TvBndr tv' vis) }
......
......@@ -20,6 +20,8 @@ import TcRnMonad
import TcSigs( emptyPragEnv, completeSigFromId )
import TcEnv
import TcMType
import TcHsSyn( zonkTyVarBindersX, zonkTcTypeToTypes
, zonkTcTypeToType, emptyZonkEnv )
import TysPrim
import TysWiredIn ( runtimeRepTy )
import Name
......@@ -292,18 +294,19 @@ tc_patsyn_finish :: Located Name -- ^ PatSyn Name
-- ^ Whether fields, empty if not record PatSyn
-> TcM (LHsBinds Id, TcGblEnv)
tc_patsyn_finish lname dir is_infix lpat'
(univ_bndrs, req_theta, req_ev_binds, req_dicts)
(ex_bndrs, ex_tys, prov_theta, prov_dicts)
(univ_tvs, req_theta, req_ev_binds, req_dicts)
(ex_tvs, ex_tys, prov_theta, prov_dicts)
(args, arg_tys)
pat_ty field_labels
= do { -- Zonk everything. We are about to build a final PatSyn
-- so there had better be no unification variables in there
univ_tvs' <- mapMaybeM zonk_qtv univ_bndrs
; ex_tvs' <- mapMaybeM zonk_qtv ex_bndrs
; prov_theta' <- zonkTcTypes prov_theta
; req_theta' <- zonkTcTypes req_theta
; pat_ty' <- zonkTcType pat_ty
; arg_tys' <- zonkTcTypes arg_tys
(ze, univ_tvs') <- zonkTyVarBindersX emptyZonkEnv univ_tvs
; req_theta' <- zonkTcTypeToTypes ze req_theta
; (ze, ex_tvs') <- zonkTyVarBindersX ze ex_tvs
; prov_theta' <- zonkTcTypeToTypes ze prov_theta
; pat_ty' <- zonkTcTypeToType ze pat_ty
; arg_tys' <- zonkTcTypeToTypes ze arg_tys
; let (env1, univ_tvs) = tidyTyVarBinders emptyTidyEnv univ_tvs'
(env2, ex_tvs) = tidyTyVarBinders env1 ex_tvs'
......@@ -357,14 +360,6 @@ tc_patsyn_finish lname dir is_infix lpat'
; traceTc "tc_patsyn_finish }" empty
; return (matcher_bind, tcg_env) }
where
-- This is a bit of an odd functions; why does it not occur elsewhere
zonk_qtv :: TcTyVarBinder -> TcM (Maybe TcTyVarBinder)
zonk_qtv (TvBndr tv vis)
= do { mb_tv' <- zonkQuantifiedTyVar False tv
-- ToDo: The False means that we behave here as if
-- -XPolyKinds was always on, which isn't right.
; return (fmap (\tv' -> TvBndr tv' vis) mb_tv') }
{-
************************************************************************
......
......@@ -368,7 +368,7 @@ kcTyClGroup decls
; kvs <- kindGeneralize (mkTyConKind kc_binders kc_res_kind)
; let all_binders = mkNamedTyConBinders Inferred kvs ++ kc_binders
; (env, all_binders') <- zonkTyConBinders emptyZonkEnv all_binders
; (env, all_binders') <- zonkTyVarBindersX emptyZonkEnv all_binders
; kc_res_kind' <- zonkTcTypeToType env kc_res_kind
-- Make sure kc_kind' has the final, zonked kind variables
......
......@@ -22,7 +22,7 @@ module TcType (
-- Types
TcType, TcSigmaType, TcRhoType, TcTauType, TcPredType, TcThetaType,
TcTyVar, TcTyVarSet, TcDTyVarSet, TcTyCoVarSet, TcDTyCoVarSet,
TcKind, TcCoVar, TcTyCoVar, TcTyBinder, TcTyVarBinder, TcTyCon,
TcKind, TcCoVar, TcTyCoVar, TcTyVarBinder, TcTyCon,
ExpType(..), InferResult(..), ExpSigmaType, ExpRhoType, mkCheckExpType,
......@@ -309,7 +309,6 @@ type TcTyCoVar = Var -- Either a TcTyVar or a CoVar
-- T is "flattened" before quantifying over a
type TcTyVarBinder = TyVarBinder
type TcTyBinder = TyBinder
type TcTyCon = TyCon -- these can be the TcTyCon constructor
-- These types do not have boxy type variables in them
......
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