summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2017-04-12 16:20:13 +0100
committerSimon Peyton Jones <simonpj@microsoft.com>2017-04-13 09:26:42 +0100
commitfbb27d77b9c707008344f4c49fbb8d1015efb739 (patch)
treea0f408b31219658a970d50919fb70efc605fd3e9
parent0ae72512255ba66ef89bdfeea65a23ea6eb35124 (diff)
downloadhaskell-fbb27d77b9c707008344f4c49fbb8d1015efb739.tar.gz
Remove dead quantifyTyVars
This patch * removes a function TcMType.quantifyTyVars that was never called * renames quantifyZonkedTyVars to quantifyTyVars Plus a few comments. No functional change at all
-rw-r--r--compiler/typecheck/TcHsType.hs2
-rw-r--r--compiler/typecheck/TcMType.hs76
-rw-r--r--compiler/typecheck/TcRules.hs2
-rw-r--r--compiler/typecheck/TcSimplify.hs6
-rw-r--r--compiler/typecheck/TcTyClsDecls.hs24
5 files changed, 54 insertions, 56 deletions
diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs
index 0e3a43cd52..9b313f0c60 100644
--- a/compiler/typecheck/TcHsType.hs
+++ b/compiler/typecheck/TcHsType.hs
@@ -1596,7 +1596,7 @@ kindGeneralize kind_or_type
= do { kvs <- zonkTcTypeAndFV kind_or_type
; let dvs = DV { dv_kvs = kvs, dv_tvs = emptyDVarSet }
; gbl_tvs <- tcGetGlobalTyCoVars -- Already zonked
- ; quantifyZonkedTyVars gbl_tvs dvs }
+ ; quantifyTyVars gbl_tvs dvs }
{-
Note [Kind generalisation]
diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs
index 1a67875f32..6b517eb8d6 100644
--- a/compiler/typecheck/TcMType.hs
+++ b/compiler/typecheck/TcMType.hs
@@ -74,7 +74,7 @@ module TcMType (
zonkTyCoVarsAndFVList,
zonkTcTypeAndSplitDepVars, zonkTcTypesAndSplitDepVars,
zonkQuantifiedTyVar, defaultTyVar,
- quantifyTyVars, quantifyZonkedTyVars,
+ quantifyTyVars,
zonkTcTyCoVarBndr, zonkTcTyVarBinder,
zonkTcType, zonkTcTypes, zonkCo,
zonkTyCoVarKind, zonkTcTypeMapper,
@@ -907,24 +907,17 @@ For more information about deterministic sets see
Note [Deterministic UniqFM] in UniqDFM.
-}
-quantifyTyVars, quantifyZonkedTyVars
- :: TcTyCoVarSet -- global tvs
+quantifyTyVars
+ :: TcTyCoVarSet -- Global tvs; already zonked
-> CandidatesQTvs -- See Note [Dependent type variables] in TcType
+ -- Already zonked
-> TcM [TcTyVar]
-- See Note [quantifyTyVars]
-- Can be given a mixture of TcTyVars and TyVars, in the case of
-- associated type declarations. Also accepts covars, but *never* returns any.
--- The zonked variant assumes everything is already zonked.
-
-quantifyTyVars gbl_tvs (DV { dv_kvs = dep_tkvs, dv_tvs = nondep_tkvs })
- = do { dep_tkvs <- zonkTyCoVarsAndFVDSet dep_tkvs
- ; nondep_tkvs <- zonkTyCoVarsAndFVDSet nondep_tkvs
- ; gbl_tvs <- zonkTyCoVarsAndFV gbl_tvs
- ; quantifyZonkedTyVars gbl_tvs (DV { dv_kvs = dep_tkvs, dv_tvs = nondep_tkvs }) }
-
-quantifyZonkedTyVars gbl_tvs dvs@(DV{ dv_kvs = dep_tkvs, dv_tvs = nondep_tkvs })
- = do { traceTc "quantifyZonkedTyVars" (vcat [ppr dvs, ppr gbl_tvs])
+quantifyTyVars gbl_tvs dvs@(DV{ dv_kvs = dep_tkvs, dv_tvs = nondep_tkvs })
+ = do { traceTc "quantifyTyVars" (vcat [ppr dvs, ppr gbl_tvs])
; let all_cvs = filterVarSet isCoVar $ dVarSetToVarSet dep_tkvs
dep_kvs = dVarSetElemsWellScoped $
dep_tkvs `dVarSetMinusVarSet` gbl_tvs
@@ -960,7 +953,7 @@ quantifyZonkedTyVars gbl_tvs dvs@(DV{ dv_kvs = dep_tkvs, dv_tvs = nondep_tkvs })
-- mentioned in the kinds of the nondep_tvs'
-- now refer to the dep_kvs'
- ; traceTc "quantifyZonkedTyVars"
+ ; traceTc "quantifyTyVars"
(vcat [ text "globals:" <+> ppr gbl_tvs
, text "nondep:" <+> pprTyVars nondep_tvs
, text "dep:" <+> pprTyVars dep_kvs
@@ -969,19 +962,24 @@ quantifyZonkedTyVars gbl_tvs dvs@(DV{ dv_kvs = dep_tkvs, dv_tvs = nondep_tkvs })
; return (dep_kvs' ++ nondep_tvs') }
where
+ -- zonk_quant returns a tyvar if it should be quantified over;
+ -- otherwise, it returns Nothing. The latter case happens for
+ -- * Kind variables, with -XNoPolyKinds: don't quantify over these
+ -- * RuntimeRep variables: we never quantify over these
zonk_quant default_kind tkv
- | isTcTyVar tkv = zonkQuantifiedTyVar default_kind tkv
- | otherwise = return $ Just tkv
- -- For associated types, we have the class variables
- -- in scope, and they are TyVars not TcTyVars
-
-zonkQuantifiedTyVar :: Bool -- True <=> this is a kind var and -XNoPolyKinds
- -- False <=> not a kind var or -XPolyKinds
- -> TcTyVar
- -> TcM (Maybe TcTyVar)
+ | not (isTcTyVar tkv)
+ = return (Just tkv) -- For associated types, we have the class variables
+ -- in scope, and they are TyVars not TcTyVars
+ | otherwise
+ = do { deflt_done <- defaultTyVar default_kind tkv
+ ; case deflt_done of
+ True -> return Nothing
+ False -> do { tv <- zonkQuantifiedTyVar tkv
+ ; return (Just tv) } }
+
+zonkQuantifiedTyVar :: TcTyVar -> TcM TcTyVar
-- The quantified type variables often include meta type variables
--- we want to freeze them into ordinary type variables, and
--- default their kind (e.g. from TYPE v to TYPE Lifted)
+-- we want to freeze them into ordinary type variables
-- The meta tyvar is updated to point to the new skolem TyVar. Now any
-- bound occurrences of the original type variable will get zonked to
-- the immutable version.
@@ -990,33 +988,26 @@ zonkQuantifiedTyVar :: Bool -- True <=> this is a kind var and -XNoPolyKind
--
-- This function is called on both kind and type variables,
-- but kind variables *only* if PolyKinds is on.
---
--- This returns a tyvar if it should be quantified over;
--- otherwise, it returns Nothing. The latter case happens for
--- * Kind variables, with -XNoPolyKinds: don't quantify over these
--- * RuntimeRep variables: we never quantify over these
-zonkQuantifiedTyVar default_kind tv
+zonkQuantifiedTyVar tv
= case tcTyVarDetails tv of
SkolemTv {} -> do { kind <- zonkTcType (tyVarKind tv)
- ; return $ Just (setTyVarKind tv kind) }
+ ; return (setTyVarKind tv kind) }
-- It might be a skolem type variable,
-- for example from a user type signature
- MetaTv {}
- -> do { mb_tv <- defaultTyVar default_kind tv
- ; case mb_tv of
- True -> return Nothing
- False -> do { tv' <- skolemiseUnboundMetaTyVar tv
- ; return (Just tv') } }
+ MetaTv {} -> skolemiseUnboundMetaTyVar tv
_other -> pprPanic "zonkQuantifiedTyVar" (ppr tv) -- FlatSkol, RuntimeUnk
defaultTyVar :: Bool -- True <=> please default this kind variable to *
- -> TcTyVar -- Always an unbound meta tyvar
+ -> TcTyVar -- If it's a MetaTyVar then it is unbound
-> TcM Bool -- True <=> defaulted away altogether
defaultTyVar default_kind tv
+ | not (isMetaTyVar tv)
+ = return False
+
| isRuntimeRepVar tv && not_sig_tv -- We never quantify over a RuntimeRep var
= do { traceTc "Defaulting a RuntimeRep var to LiftedRep" (ppr tv)
; writeMetaTyVar tv liftedRepTy
@@ -1301,13 +1292,6 @@ zonkTyCoVarsAndFVList :: [TyCoVar] -> TcM [TyCoVar]
zonkTyCoVarsAndFVList tycovars =
tyCoVarsOfTypesList <$> mapM zonkTyCoVar tycovars
--- Takes a deterministic set of TyCoVars, zonks them and returns a
--- deterministic set of their free variables.
--- See Note [quantifyTyVars determinism].
-zonkTyCoVarsAndFVDSet :: DTyCoVarSet -> TcM DTyCoVarSet
-zonkTyCoVarsAndFVDSet tycovars =
- tyCoVarsOfTypesDSet <$> mapM zonkTyCoVar (dVarSetElems tycovars)
-
zonkTcTyVars :: [TcTyVar] -> TcM [TcType]
zonkTcTyVars tyvars = mapM zonkTcTyVar tyvars
diff --git a/compiler/typecheck/TcRules.hs b/compiler/typecheck/TcRules.hs
index dd773cf041..d80321cb39 100644
--- a/compiler/typecheck/TcRules.hs
+++ b/compiler/typecheck/TcRules.hs
@@ -106,7 +106,7 @@ tcRule (HsRule name act hs_bndrs lhs fv_lhs rhs fv_rhs)
rule_ty : map idType tpl_ids
; gbls <- tcGetGlobalTyCoVars -- Even though top level, there might be top-level
-- monomorphic bindings from the MR; test tc111
- ; qtkvs <- quantifyZonkedTyVars gbls forall_tkvs
+ ; qtkvs <- quantifyTyVars gbls forall_tkvs
; traceTc "tcRule" (vcat [ pprFullRuleName name
, ppr forall_tkvs
, ppr qtkvs
diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs
index 934e24669c..e5f3fe97cc 100644
--- a/compiler/typecheck/TcSimplify.hs
+++ b/compiler/typecheck/TcSimplify.hs
@@ -581,7 +581,7 @@ simplifyInfer rhs_tclvl infer_mode sigs name_taus wanteds
| isEmptyWC wanteds
= do { gbl_tvs <- tcGetGlobalTyCoVars
; dep_vars <- zonkTcTypesAndSplitDepVars (map snd name_taus)
- ; qtkvs <- quantifyZonkedTyVars gbl_tvs dep_vars
+ ; qtkvs <- quantifyTyVars gbl_tvs dep_vars
; traceTc "simplifyInfer: empty WC" (ppr name_taus $$ ppr qtkvs)
; return (qtkvs, [], emptyTcEvBinds) }
@@ -948,7 +948,7 @@ decideQuantifiedTyVars mono_tvs name_taus psigs candidates
grown_tvs = growThetaTyVars candidates (tyCoVarsOfTypes seed_tys)
-- Now we have to classify them into kind variables and type variables
- -- (sigh) just for the benefit of -XNoPolyKinds; see quantifyZonkedTyVars
+ -- (sigh) just for the benefit of -XNoPolyKinds; see quantifyTyVars
--
-- Keep the psig_tys first, so that candidateQTyVarsOfTypes produces
-- them in that order, so that the final qtvs quantifies in the same
@@ -960,7 +960,7 @@ decideQuantifiedTyVars mono_tvs name_taus psigs candidates
dvs_plus = DV { dv_kvs = pick cand_kvs, dv_tvs = pick cand_tvs }
; mono_tvs <- TcM.zonkTyCoVarsAndFV mono_tvs
- ; quantifyZonkedTyVars mono_tvs dvs_plus }
+ ; quantifyTyVars mono_tvs dvs_plus }
------------------
growThetaTyVars :: ThetaType -> TyCoVarSet -> TyVarSet
diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs
index e0929f494c..001049243b 100644
--- a/compiler/typecheck/TcTyClsDecls.hs
+++ b/compiler/typecheck/TcTyClsDecls.hs
@@ -608,9 +608,15 @@ kcConDecl (ConDeclGADT { con_names = names
, con_type = ty })
= addErrCtxt (dataConCtxtName names) $
do { _ <- tcGadtSigType (ppr names) (unLoc $ head names) ty
+ -- Even though the data constructor's type is closed, we
+ -- must still call tcGadtSigType, because that influences
+ -- the inferred kind of the /type/ constructor. Example:
+ -- data T f a where
+ -- MkT :: f a -> T f a
+ -- If we don't look at MkT we won't get the correct kind
+ -- for the type constructor T
; return () }
-
{-
Note [Recursion and promoting data constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1296,7 +1302,7 @@ tcFamTyPats fam_shape@(name,_,_,_) mb_clsinfo pats kind_checker thing_inside
-- replace a meta kind var with (Any *)
-- Very like kindGeneralize
; vars <- zonkTcTypesAndSplitDepVars typats
- ; qtkvs <- quantifyZonkedTyVars emptyVarSet vars
+ ; qtkvs <- quantifyTyVars emptyVarSet vars
; MASSERT( isEmptyVarSet $ coVarsOfTypes typats )
-- This should be the case, because otherwise the solveEqualities
@@ -1462,10 +1468,17 @@ tcConDecl rep_tycon tmpl_bndrs res_tmpl
, con_details = hs_details })
= addErrCtxt (dataConCtxtName [name]) $
do { traceTc "tcConDecl 1" (ppr name)
+
+ -- Get hold of the existential type variables
+ -- e.g. data T a = forall (b::k) f. MkT a (f b)
+ -- Here tmpl_bndrs = {a}
+ -- hs_kvs = {k}
+ -- hs_tvs = {f,b}
; let (hs_kvs, hs_tvs) = case hs_qvars of
Nothing -> ([], [])
Just (HsQTvs { hsq_implicit = kvs, hsq_explicit = tvs })
-> (kvs, tvs)
+
; (imp_tvs, (exp_tvs, ctxt, arg_tys, field_lbls, stricts))
<- solveEqualities $
tcImplicitTKBndrs hs_kvs $
@@ -1479,8 +1492,9 @@ tcConDecl rep_tycon tmpl_bndrs res_tmpl
allBoundVariabless arg_tys
; return ((exp_tvs, ctxt, arg_tys, field_lbls, stricts), bound_vars)
}
+
+ -- exp_tvs have explicit, user-written binding sites
-- imp_tvs are user-written kind variables, without an explicit binding site
- -- exp_tvs have binding sites
-- the kvs below are those kind variables entirely unmentioned by the user
-- and discovered only by generalization
@@ -1497,7 +1511,7 @@ tcConDecl rep_tycon tmpl_bndrs res_tmpl
-- we're doing this to get the right behavior around removing
-- any vars bound in exp_binders.
- ; kvs <- quantifyZonkedTyVars (mkVarSet (binderVars tmpl_bndrs)) vars
+ ; kvs <- quantifyTyVars (mkVarSet (binderVars tmpl_bndrs)) vars
-- Zonk to Types
; (ze, qkvs) <- zonkTyBndrsX emptyZonkEnv kvs
@@ -1541,7 +1555,7 @@ tcConDecl rep_tycon tmpl_bndrs res_tmpl
mkFunTys ctxt $
mkFunTys arg_tys $
res_ty)
- ; tkvs <- quantifyZonkedTyVars emptyVarSet vars
+ ; tkvs <- quantifyTyVars emptyVarSet vars
-- Zonk to Types
; (ze, qtkvs) <- zonkTyBndrsX emptyZonkEnv (tkvs ++ user_tvs)