summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2016-11-25 11:39:38 +0000
committerSimon Peyton Jones <simonpj@microsoft.com>2016-11-25 17:46:50 +0000
commit12eff239236c43ee903d8e29287a36c3d8e24747 (patch)
tree77638971482dad42693471804f48c687b44cb8dc /compiler
parentedbe83190582f5dad2603c0929d6b3aa41ce314e (diff)
downloadhaskell-12eff239236c43ee903d8e29287a36c3d8e24747.tar.gz
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.
Diffstat (limited to 'compiler')
-rw-r--r--compiler/typecheck/TcHsSyn.hs17
-rw-r--r--compiler/typecheck/TcHsType.hs4
-rw-r--r--compiler/typecheck/TcMType.hs15
-rw-r--r--compiler/typecheck/TcPatSyn.hs27
-rw-r--r--compiler/typecheck/TcTyClsDecls.hs2
-rw-r--r--compiler/typecheck/TcType.hs3
6 files changed, 28 insertions, 40 deletions
diff --git a/compiler/typecheck/TcHsSyn.hs b/compiler/typecheck/TcHsSyn.hs
index 2589576910..5a455ead32 100644
--- a/compiler/typecheck/TcHsSyn.hs
+++ b/compiler/typecheck/TcHsSyn.hs
@@ -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) }
diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs
index 8fb5d16862..da1eeee579 100644
--- a/compiler/typecheck/TcHsType.hs
+++ b/compiler/typecheck/TcHsType.hs
@@ -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)
diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs
index c200b4efb8..eae7305b58 100644
--- a/compiler/typecheck/TcMType.hs
+++ b/compiler/typecheck/TcMType.hs
@@ -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) }
diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs
index 5c621213e2..47a27b3853 100644
--- a/compiler/typecheck/TcPatSyn.hs
+++ b/compiler/typecheck/TcPatSyn.hs
@@ -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') }
{-
************************************************************************
diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs
index b711ef34f3..b9bc595189 100644
--- a/compiler/typecheck/TcTyClsDecls.hs
+++ b/compiler/typecheck/TcTyClsDecls.hs
@@ -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
diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs
index bbf47121a9..099502d9a3 100644
--- a/compiler/typecheck/TcType.hs
+++ b/compiler/typecheck/TcType.hs
@@ -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