diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2016-11-25 11:39:38 +0000 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2016-11-25 17:46:50 +0000 |
commit | 12eff239236c43ee903d8e29287a36c3d8e24747 (patch) | |
tree | 77638971482dad42693471804f48c687b44cb8dc /compiler | |
parent | edbe83190582f5dad2603c0929d6b3aa41ce314e (diff) | |
download | haskell-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.hs | 17 | ||||
-rw-r--r-- | compiler/typecheck/TcHsType.hs | 4 | ||||
-rw-r--r-- | compiler/typecheck/TcMType.hs | 15 | ||||
-rw-r--r-- | compiler/typecheck/TcPatSyn.hs | 27 | ||||
-rw-r--r-- | compiler/typecheck/TcTyClsDecls.hs | 2 | ||||
-rw-r--r-- | compiler/typecheck/TcType.hs | 3 |
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 |