diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2021-06-01 12:24:31 +0100 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-06-18 12:27:33 -0400 |
| commit | c6a00c15b2e98d82aa279ede4100030b462ef629 (patch) | |
| tree | a72cfaba3d3d1aaf25282c47f89d9042751cd84b | |
| parent | 3b783496aa6b74cdca767347916de963b34ca718 (diff) | |
| download | haskell-c6a00c15b2e98d82aa279ede4100030b462ef629.tar.gz | |
Improve abstractVars quantification ordering
When floating a binding out past some type-variable binders,
don't gratuitiously change the order of the binders.
This small change gives code that is simpler, has less risk of
non-determinism, and does not gratuitiously change type-variable
order.
See Note [Which type variables to abstract over] in
GHC.Core.Opt.Simplify.Utils.
This is really just refactoring; no change in behaviour.
| -rw-r--r-- | compiler/GHC/Core/Opt/Simplify/Utils.hs | 16 |
1 files changed, 11 insertions, 5 deletions
diff --git a/compiler/GHC/Core/Opt/Simplify/Utils.hs b/compiler/GHC/Core/Opt/Simplify/Utils.hs index 085ba41dbd..09b39cbfb2 100644 --- a/compiler/GHC/Core/Opt/Simplify/Utils.hs +++ b/compiler/GHC/Core/Opt/Simplify/Utils.hs @@ -1923,6 +1923,14 @@ new binding is abstracted. Note that otherwise we get t = /\ (f:k->*) (a:k). AccFailure @ (f a) which is obviously bogus. + + * We get the variables to abstract over by filtering down the + the main_tvs for the original function, picking only ones + mentioned in the abstracted body. This means: + - they are automatically in dependency order, because main_tvs is + - there is no issue about non-determinism + - we don't gratuitiously change order, which may help (in a tiny + way) with CSE and/or the compiler-debugging experience -} abstractFloats :: UnfoldingOpts -> TopLevelFlag -> [OutTyVar] -> SimplFloats @@ -1934,7 +1942,6 @@ abstractFloats uf_opts top_lvl main_tvs floats body ; return (float_binds, GHC.Core.Subst.substExpr subst body) } where is_top_lvl = isTopLevel top_lvl - main_tv_set = mkVarSet main_tvs body_floats = letFloatBinds (sfLetFloats floats) empty_subst = GHC.Core.Subst.mkEmptySubst (sfInScope floats) @@ -1948,10 +1955,9 @@ abstractFloats uf_opts top_lvl main_tvs floats body rhs' = GHC.Core.Subst.substExpr subst rhs -- tvs_here: see Note [Which type variables to abstract over] - tvs_here = scopedSort $ - filter (`elemVarSet` main_tv_set) $ - closeOverKindsList $ - exprSomeFreeVarsList isTyVar rhs' + tvs_here = filter (`elemVarSet` free_tvs) main_tvs + free_tvs = closeOverKinds $ + exprSomeFreeVars isTyVar rhs' abstract subst (Rec prs) = do { (poly_ids, poly_apps) <- mapAndUnzipM (mk_poly1 tvs_here) ids |