[commit: ghc] ghc-8.0: Add two small optimizations. (#11196) (4183976)
git at git.haskell.org
git at git.haskell.org
Wed Mar 23 16:38:21 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : ghc-8.0
Link : http://ghc.haskell.org/trac/ghc/changeset/4183976003ab9da51583d78debec798cd53789cc/ghc
>---------------------------------------------------------------
commit 4183976003ab9da51583d78debec798cd53789cc
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date: Fri Mar 18 09:40:15 2016 -0400
Add two small optimizations. (#11196)
- Optimize zonking * to avoid allocation.
- Try to avoid looking at the free variables of a type in the
pure unifier. We need look at the variables only in the case
of a forall.
The performance results updates included in this also include
a regression, but the regression is not due to this patch. When
validating previous patches, the test case failed, but I was
unable to reproduce outside of validation, so I let it go by, thinking
the failure was spurious. Upon closer inspection, the perf number
was right at the line, and the wibble between a valiation environment
and a regular test run was enough to make the difference.
(cherry picked from commit 0706a103ae8c9c61e6bbaadd16b32da76aa5a749)
>---------------------------------------------------------------
4183976003ab9da51583d78debec798cd53789cc
compiler/types/Type.hs | 2 ++
compiler/types/Unify.hs | 20 ++++++++++++--------
testsuite/tests/perf/compiler/all.T | 17 ++++++++++++-----
3 files changed, 26 insertions(+), 13 deletions(-)
diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs
index dd142c0..726c77b 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -477,6 +477,8 @@ mapType mapper@(TyCoMapper { tcm_smart = smart, tcm_tyvar = tyvar
where
go (TyVarTy tv) = tyvar env tv
go (AppTy t1 t2) = mkappty <$> go t1 <*> go t2
+ go t@(TyConApp _ []) = return t -- avoid allocation in this exceedingly
+ -- common case (mostly, for *)
go (TyConApp tc tys) = mktyconapp tc <$> mapM go tys
go (ForAllTy (Anon arg) res) = mkfunty <$> go arg <*> go res
go (ForAllTy (Named tv vis) inner)
diff --git a/compiler/types/Unify.hs b/compiler/types/Unify.hs
index 75b65df..bc53cac 100644
--- a/compiler/types/Unify.hs
+++ b/compiler/types/Unify.hs
@@ -986,11 +986,15 @@ umRnBndr2 v1 v2 thing = UM $ \env state ->
let rn_env' = rnBndr2 (um_rn_env env) v1 v2 in
unUM thing (env { um_rn_env = rn_env' }) state
-checkRnEnv :: (RnEnv2 -> Var -> Bool) -> VarSet -> UM ()
-checkRnEnv inRnEnv varset = UM $ \env state ->
- if any (inRnEnv (um_rn_env env)) (varSetElems varset)
- then MaybeApart (state, ())
- else Unifiable (state, ())
+checkRnEnv :: (RnEnv2 -> VarSet) -> VarSet -> UM ()
+checkRnEnv get_set varset = UM $ \env state ->
+ let env_vars = get_set (um_rn_env env) in
+ if isEmptyVarSet env_vars || varset `disjointVarSet` env_vars
+ -- NB: That isEmptyVarSet is a critical optimization; it
+ -- means we don't have to calculate the free vars of
+ -- the type, often saving quite a bit of allocation.
+ then Unifiable (state, ())
+ else MaybeApart (state, ())
-- | Converts any SurelyApart to a MaybeApart
don'tBeSoSure :: UM () -> UM ()
@@ -1000,13 +1004,13 @@ don'tBeSoSure um = UM $ \env state ->
other -> other
checkRnEnvR :: Type -> UM ()
-checkRnEnvR ty = checkRnEnv inRnEnvR (tyCoVarsOfType ty)
+checkRnEnvR ty = checkRnEnv rnEnvR (tyCoVarsOfType ty)
checkRnEnvL :: Type -> UM ()
-checkRnEnvL ty = checkRnEnv inRnEnvL (tyCoVarsOfType ty)
+checkRnEnvL ty = checkRnEnv rnEnvL (tyCoVarsOfType ty)
checkRnEnvRCo :: Coercion -> UM ()
-checkRnEnvRCo co = checkRnEnv inRnEnvR (tyCoVarsOfCo co)
+checkRnEnvRCo co = checkRnEnv rnEnvR (tyCoVarsOfCo co)
umRnOccL :: TyVar -> UM TyVar
umRnOccL v = UM $ \env state ->
diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T
index 77fde50..ffcc050 100644
--- a/testsuite/tests/perf/compiler/all.T
+++ b/testsuite/tests/perf/compiler/all.T
@@ -395,7 +395,7 @@ test('T5631',
# expected value: 392904228 (x86/Linux)
# 2014-04-04: 346389856 (x86 Windows, 64 bit machine)
# 2014-12-01: 390199244 (Windows laptop)
- (wordsize(64), 1198327544, 5)]),
+ (wordsize(64), 1124068664, 5)]),
# expected value: 774595008 (amd64/Linux):
# expected value: 735486328 (amd64/Linux) 2012/12/12:
# expected value: 690742040 (amd64/Linux) Call Arity improvements
@@ -404,6 +404,7 @@ test('T5631',
# 2015-06-01: 812288344 (amd64/Linux) unknown cause
# 2015-12-11: 1128828928 (amd64/Linux) TypeInType (see #11196)
# 2015-12-21: 1198327544 (Mac) TypeApplications (will fix with #11196)
+ # 2015-03-18: 1124068664 (Mac) optimize Unify & zonking
only_ways(['normal'])
],
compile,
@@ -558,7 +559,7 @@ test('T5837',
# 2014-12-01: 135914136 (Windows laptop, regression see below)
# 2014-12-08 115905208 Constraint solver perf improvements (esp kick-out)
- (wordsize(64), 43877520, 10)])
+ (wordsize(64), 48507272, 10)])
# sample: 3926235424 (amd64/Linux, 15/2/2012)
# 2012-10-02 81879216
# 2012-09-20 87254264 amd64/Linux
@@ -575,6 +576,8 @@ test('T5837',
# 2015-03-17 53424304 Mac Better depth checking; fails earlier
# 2015-06-09 38834096 Better "improvement"; I'm not sure whey it improves things
# 2015-12-11 43877520 amd64/Linux, TypeInType (see #11196)
+ # 2016-03-18 48507272 Mac, accept small regression in exchange
+ # for other optimisations
],
compile_fail,['-freduction-depth=50'])
@@ -676,11 +679,12 @@ test('T9872a',
test('T9872b',
[ only_ways(['normal']),
compiler_stats_num_field('bytes allocated',
- [(wordsize(64), 5199926080, 5),
+ [(wordsize(64), 4918990352, 5),
# 2014-12-10 6483306280 Initally created
# 2014-12-16 6892251912 Flattener parameterized over roles
# 2014-12-18 3480212048 Reduce type families even more eagerly
# 2015-12-11 5199926080 TypeInType (see #11196)
+ # 2016-02-08 4918990352 Improved a bit by tyConRolesRepresentational
(wordsize(32), 1700000000, 5)
]),
],
@@ -689,11 +693,12 @@ test('T9872b',
test('T9872c',
[ only_ways(['normal']),
compiler_stats_num_field('bytes allocated',
- [(wordsize(64), 4723613784, 5),
+ [(wordsize(64), 4454071184, 5),
# 2014-12-10 5495850096 Initally created
# 2014-12-16 5842024784 Flattener parameterized over roles
# 2014-12-18 2963554096 Reduce type families even more eagerly
# 2015-12-11 4723613784 TypeInType (see #11196)
+ # 2016-02-08 4454071184 Improved a bit by tyConRolesRepresentational
(wordsize(32), 1500000000, 5)
]),
],
@@ -702,11 +707,13 @@ test('T9872c',
test('T9872d',
[ only_ways(['normal']),
compiler_stats_num_field('bytes allocated',
- [(wordsize(64), 566134504, 5),
+ [(wordsize(64), 506691240, 5),
# 2014-12-18 796071864 Initally created
# 2014-12-18 739189056 Reduce type families even more eagerly
# 2015-01-07 687562440 TrieMap leaf compression
# 2015-03-17 726679784 tweak to solver; probably flattens more
+ # 2016-02-08 534693648 Improved a bit by tyConRolesRepresentational
+ # 2016-03-18 506691240 optimize Unify & zonking
(wordsize(32), 59651432, 5)
# some date 328810212
# 2015-07-11 350369584
More information about the ghc-commits
mailing list