diff options
Diffstat (limited to 'compiler/typecheck')
| -rw-r--r-- | compiler/typecheck/TcHsType.hs | 2 | ||||
| -rw-r--r-- | compiler/typecheck/TcMType.hs | 44 | ||||
| -rw-r--r-- | compiler/typecheck/TcSimplify.hs | 39 | ||||
| -rw-r--r-- | compiler/typecheck/TcType.hs | 46 |
4 files changed, 98 insertions, 33 deletions
diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs index 58f9ccce85..c5333994bb 100644 --- a/compiler/typecheck/TcHsType.hs +++ b/compiler/typecheck/TcHsType.hs @@ -1441,7 +1441,7 @@ kindGeneralize :: TcType -> TcM [KindVar] -- type variables. So in both cases, all the free vars are kind vars kindGeneralize kind_or_type = do { kvs <- zonkTcTypeAndFV kind_or_type - ; let dvs = DV { dv_kvs = kvs, dv_tvs = emptyVarSet } + ; let dvs = DV { dv_kvs = kvs, dv_tvs = emptyDVarSet } ; gbl_tvs <- tcGetGlobalTyCoVars -- Already zonked ; quantifyZonkedTyVars gbl_tvs dvs } diff --git a/compiler/typecheck/TcMType.hs b/compiler/typecheck/TcMType.hs index 69de710959..222a2e230a 100644 --- a/compiler/typecheck/TcMType.hs +++ b/compiler/typecheck/TcMType.hs @@ -831,6 +831,19 @@ has free vars {f,a}, but we must add 'k' as well! Hence step (3). * quantifyTyVars never quantifies over - a coercion variable - a runtime-rep variable + +Note [quantifyTyVars determinism] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The results of quantifyTyVars are wrapped in a forall and can end up in the +interface file. One such example is inferred type signatures. They also affect +the results of optimizations, for example worker-wrapper. This means that to +get deterministic builds quantifyTyVars needs to be deterministic. + +To achieve this TcDepVars is backed by deterministic sets which allows them +to be later converted to a list in a deterministic order. + +For more information about deterministic sets see +Note [Deterministic UniqFM] in UniqDFM. -} quantifyTyVars, quantifyZonkedTyVars @@ -844,25 +857,25 @@ quantifyTyVars, quantifyZonkedTyVars -- The zonked variant assumes everything is already zonked. quantifyTyVars gbl_tvs (DV { dv_kvs = dep_tkvs, dv_tvs = nondep_tkvs }) - = do { dep_tkvs <- zonkTyCoVarsAndFV dep_tkvs - ; nondep_tkvs <- (`minusVarSet` dep_tkvs) <$> - zonkTyCoVarsAndFV nondep_tkvs + = do { dep_tkvs <- zonkTyCoVarsAndFVDSet dep_tkvs + ; nondep_tkvs <- (`minusDVarSet` dep_tkvs) <$> + zonkTyCoVarsAndFVDSet nondep_tkvs ; gbl_tvs <- zonkTyCoVarsAndFV gbl_tvs ; quantifyZonkedTyVars gbl_tvs (DV { dv_kvs = dep_tkvs, dv_tvs = nondep_tkvs }) } quantifyZonkedTyVars gbl_tvs (DV{ dv_kvs = dep_tkvs, dv_tvs = nondep_tkvs }) - = do { let all_cvs = filterVarSet isCoVar dep_tkvs - dep_kvs = varSetElemsWellScoped $ - dep_tkvs `minusVarSet` gbl_tvs - `minusVarSet` closeOverKinds all_cvs - -- varSetElemsWellScoped: put the kind variables into + = do { let all_cvs = filterVarSet isCoVar $ dVarSetToVarSet dep_tkvs + dep_kvs = dVarSetElemsWellScoped $ + dep_tkvs `dVarSetMinusVarSet` gbl_tvs + `dVarSetMinusVarSet` closeOverKinds all_cvs + -- dVarSetElemsWellScoped: put the kind variables into -- well-scoped order. -- E.g. [k, (a::k)] not the other way roud -- closeOverKinds all_cvs: do not quantify over coercion -- variables, or any any tvs that a covar depends on - nondep_tvs = varSetElems $ - nondep_tkvs `minusVarSet` gbl_tvs + nondep_tvs = dVarSetElems $ + nondep_tkvs `dVarSetMinusVarSet` gbl_tvs -- No worry about dependent covars here; they are -- all in dep_tkvs -- No worry about scoping, becuase these are all @@ -1170,7 +1183,7 @@ tcGetGlobalTyCoVars zonkTcTypeInKnot :: TcType -> TcM TcType zonkTcTypeInKnot = mapType (zonkTcTypeMapper { tcm_smart = False }) () -zonkTcTypeAndFV :: TcType -> TcM TyCoVarSet +zonkTcTypeAndFV :: TcType -> TcM DTyCoVarSet -- Zonk a type and take its free variables -- With kind polymorphism it can be essential to zonk *first* -- so that we find the right set of free variables. Eg @@ -1180,7 +1193,7 @@ zonkTcTypeAndFV :: TcType -> TcM TyCoVarSet -- NB: This might be called from within the knot, so don't use -- smart constructors. See Note [Zonking within the knot] in TcHsType zonkTcTypeAndFV ty - = tyCoVarsOfType <$> zonkTcTypeInKnot ty + = tyCoVarsOfTypeDSet <$> zonkTcTypeInKnot ty -- | Zonk a type and call 'splitDepVarsOfType' on it. -- Works within the knot. @@ -1206,6 +1219,13 @@ zonkTyCoVar tv | isTcTyVar tv = zonkTcTyVar tv zonkTyCoVarsAndFV :: TyCoVarSet -> TcM TyCoVarSet zonkTyCoVarsAndFV tycovars = tyCoVarsOfTypes <$> mapM zonkTyCoVar (varSetElems 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/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs index f7344afdb9..4fce9de695 100644 --- a/compiler/typecheck/TcSimplify.hs +++ b/compiler/typecheck/TcSimplify.hs @@ -624,7 +624,9 @@ simplifyInfer rhs_tclvl apply_mr sigs name_taus wanteds -- so we must promote it! The inferred type is just -- f :: beta -> beta ; zonked_tau_tkvs <- TcM.zonkTyCoVarsAndFV $ - dv_kvs zonked_tau_dvs `unionVarSet` dv_tvs zonked_tau_dvs + dVarSetToVarSet (dv_kvs zonked_tau_dvs) + `unionVarSet` + dVarSetToVarSet (dv_tvs zonked_tau_dvs) -- decideQuantification turned some meta tyvars into -- quantified skolems, so we have to zonk again @@ -747,7 +749,8 @@ decideQuantification apply_mr sigs name_taus constraints zonked_dvs@(DV { dv_kvs = zonked_tau_kvs, dv_tvs = zonked_tau_tvs }) | apply_mr -- Apply the Monomorphism restriction = do { gbl_tvs <- tcGetGlobalTyCoVars - ; let zonked_tkvs = zonked_tau_kvs `unionVarSet` zonked_tau_tvs + ; let zonked_tkvs = dVarSetToVarSet zonked_tau_kvs `unionVarSet` + dVarSetToVarSet zonked_tau_tvs constrained_tvs = tyCoVarsOfTypes constraints `unionVarSet` filterVarSet isCoVar zonked_tkvs mono_tvs = gbl_tvs `unionVarSet` constrained_tvs @@ -771,7 +774,7 @@ decideQuantification apply_mr sigs name_taus constraints | otherwise = do { gbl_tvs <- tcGetGlobalTyCoVars ; let mono_tvs = growThetaTyVars equality_constraints gbl_tvs - tau_tvs_plus = growThetaTyVars constraints zonked_tau_tvs + tau_tvs_plus = growThetaTyVarsDSet constraints zonked_tau_tvs dvs_plus = DV { dv_kvs = zonked_tau_kvs, dv_tvs = tau_tvs_plus } ; qtvs <- quantify_tvs sigs mono_tvs dvs_plus -- We don't grow the kvs, as there's no real need to. Recall @@ -811,8 +814,8 @@ quantify_tvs sigs mono_tvs dep_tvs@(DV { dv_tvs = tau_tvs }) -- NB: don't use quantifyZonkedTyVars because the sig stuff might -- be unzonked = quantifyTyVars (mono_tvs `delVarSetList` sig_qtvs) - (dep_tvs { dv_tvs = tau_tvs `extendVarSetList` sig_qtvs - `extendVarSetList` sig_wcs }) + (dep_tvs { dv_tvs = tau_tvs `extendDVarSetList` sig_qtvs + `extendDVarSetList` sig_wcs }) -- NB: quantifyTyVars zonks its arguments where sig_qtvs = [ skol | sig <- sigs, (_, skol) <- sig_skols sig ] @@ -842,6 +845,32 @@ growThetaTyVars theta tvs where pred_tvs = tyCoVarsOfType pred +------------------ +growThetaTyVarsDSet :: ThetaType -> DTyCoVarSet -> DTyVarSet +-- See Note [Growing the tau-tvs using constraints] +-- NB: only returns tyvars, never covars +-- It takes a deterministic set of TyCoVars and returns a deterministic set +-- of TyVars. +-- The implementation mirrors growThetaTyVars, the only difference is that +-- it avoids unionDVarSet and uses more efficient extendDVarSetList. +growThetaTyVarsDSet theta tvs + | null theta = tvs_only + | otherwise = filterDVarSet isTyVar $ + transCloDVarSet mk_next seed_tvs + where + tvs_only = filterDVarSet isTyVar tvs + seed_tvs = tvs `extendDVarSetList` tyCoVarsOfTypesList ips + (ips, non_ips) = partition isIPPred theta + -- See Note [Inheriting implicit parameters] in TcType + + mk_next :: DVarSet -> DVarSet -- Maps current set to newly-grown ones + mk_next so_far = foldr (grow_one so_far) emptyDVarSet non_ips + grow_one so_far pred tvs + | any (`elemDVarSet` so_far) pred_tvs = tvs `extendDVarSetList` pred_tvs + | otherwise = tvs + where + pred_tvs = tyCoVarsOfTypeList pred + {- Note [Which type variables to quantify] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When choosing type variables to quantify, the basic plan is to diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index 83d491f3dc..230c5626fb 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -851,13 +851,14 @@ allBoundVariabless = mapUnionVarSet allBoundVariables * * ********************************************************************* -} -data TcDepVars -- See note [Dependent type variables] - = DV { dv_kvs :: TyCoVarSet -- "kind" variables (dependent) - , dv_tvs :: TyVarSet -- "type" variables (non-dependent) - -- The two are disjoint sets +data TcDepVars -- See Note [Dependent type variables] + -- See Note [TcDepVars determinism] + = DV { dv_kvs :: DTyCoVarSet -- "kind" variables (dependent) + , dv_tvs :: DTyVarSet -- "type" variables (non-dependent) + -- The two are disjoint sets } -depVarsTyVars :: TcDepVars -> TyVarSet +depVarsTyVars :: TcDepVars -> DTyVarSet depVarsTyVars = dv_tvs instance Outputable TcDepVars where @@ -895,13 +896,26 @@ Note that (k1 :: k2), (k2 :: *) The "type variables" do not depend on each other; if one did, it'd be classified as a kind variable! + +Note [TcDepVars determinism] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When we quantify over type variables we decide the order in which they +appear in the final type. Because the order of type variables in the type +can end up in the interface file and affects some optimizations like +worker-wrapper we want this order to be deterministic. + +To achieve that we use deterministic sets of variables that can be converted to +lists in a deterministic order. + +For more information about deterministic sets see +Note [Deterministic UniqFM] in UniqDFM. -} splitDepVarsOfType :: Type -> TcDepVars -- See Note [Dependent type variables] splitDepVarsOfType ty = DV { dv_kvs = dep_vars - , dv_tvs = nondep_vars `minusVarSet` dep_vars } + , dv_tvs = nondep_vars `minusDVarSet` dep_vars } where Pair dep_vars nondep_vars = split_dep_vars ty @@ -910,28 +924,30 @@ splitDepVarsOfTypes :: [Type] -> TcDepVars -- See Note [Dependent type variables] splitDepVarsOfTypes tys = DV { dv_kvs = dep_vars - , dv_tvs = nondep_vars `minusVarSet` dep_vars } + , dv_tvs = nondep_vars `minusDVarSet` dep_vars } where Pair dep_vars nondep_vars = foldMap split_dep_vars tys -- | Worker for 'splitDepVarsOfType'. This might output the same var -- in both sets, if it's used in both a type and a kind. -split_dep_vars :: Type -> Pair TyCoVarSet -- Pair kvs tvs +-- See Note [TcDepVars determinism] +split_dep_vars :: Type -> Pair DTyCoVarSet -- Pair kvs tvs split_dep_vars = go where - go (TyVarTy tv) = Pair (tyCoVarsOfType $ tyVarKind tv) - (unitVarSet tv) + go (TyVarTy tv) = Pair (tyCoVarsOfTypeDSet $ tyVarKind tv) + (unitDVarSet tv) go (AppTy t1 t2) = go t1 `mappend` go t2 go (TyConApp _ tys) = foldMap go tys go (ForAllTy (Anon arg) res) = go arg `mappend` go res go (ForAllTy (Named tv _) ty) = let Pair kvs tvs = go ty in - Pair (kvs `delVarSet` tv `unionVarSet` tyCoVarsOfType (tyVarKind tv)) - (tvs `delVarSet` tv) + Pair (kvs `delDVarSet` tv + `extendDVarSetList` tyCoVarsOfTypeList (tyVarKind tv)) + (tvs `delDVarSet` tv) go (LitTy {}) = mempty - go (CastTy ty co) = go ty `mappend` Pair (tyCoVarsOfCo co) - emptyVarSet - go (CoercionTy co) = Pair (tyCoVarsOfCo co) emptyVarSet + go (CastTy ty co) = go ty `mappend` Pair (tyCoVarsOfCoDSet co) + emptyDVarSet + go (CoercionTy co) = Pair (tyCoVarsOfCoDSet co) emptyDVarSet {- ************************************************************************ |