diff options
author | Bartosz Nitka <niteria@gmail.com> | 2016-04-26 05:58:24 -0700 |
---|---|---|
committer | Bartosz Nitka <niteria@gmail.com> | 2016-04-26 06:40:04 -0700 |
commit | c9bcaf3165586ac214fa694e61c55eb45eb131ab (patch) | |
tree | d01bdfd94886ff368517a6057e2dcf77ce8614cc /compiler/typecheck/TcSimplify.hs | |
parent | fd5212fdc26686a85085333af57903a59be809c6 (diff) | |
download | haskell-c9bcaf3165586ac214fa694e61c55eb45eb131ab.tar.gz |
Kill varSetElemsWellScoped in quantifyTyVars
varSetElemsWellScoped introduces unnecessary non-determinism in
inferred type signatures.
Removing this instance required changing the representation of
TcDepVars to use deterministic sets.
This is the last occurence of varSetElemsWellScoped, allowing me to
finally remove it.
Test Plan:
./validate
I will update the expected outputs when commiting, some reordering
of type variables in types is expected.
Reviewers: goldfire, simonpj, austin, bgamari
Reviewed By: simonpj
Subscribers: thomie, simonmar
Differential Revision: https://phabricator.haskell.org/D2135
GHC Trac Issues: #4012
Diffstat (limited to 'compiler/typecheck/TcSimplify.hs')
-rw-r--r-- | compiler/typecheck/TcSimplify.hs | 39 |
1 files changed, 34 insertions, 5 deletions
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 |