diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2017-04-12 16:20:13 +0100 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2017-04-13 09:26:42 +0100 |
commit | fbb27d77b9c707008344f4c49fbb8d1015efb739 (patch) | |
tree | a0f408b31219658a970d50919fb70efc605fd3e9 | |
parent | 0ae72512255ba66ef89bdfeea65a23ea6eb35124 (diff) | |
download | haskell-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.hs | 2 | ||||
-rw-r--r-- | compiler/typecheck/TcMType.hs | 76 | ||||
-rw-r--r-- | compiler/typecheck/TcRules.hs | 2 | ||||
-rw-r--r-- | compiler/typecheck/TcSimplify.hs | 6 | ||||
-rw-r--r-- | compiler/typecheck/TcTyClsDecls.hs | 24 |
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) |