[commit: ghc] master: Add two small optimizations. (#11196) (0706a10)

git at git.haskell.org git at git.haskell.org
Mon Mar 21 20:10:18 UTC 2016


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/0706a103ae8c9c61e6bbaadd16b32da76aa5a749/ghc

>---------------------------------------------------------------

commit 0706a103ae8c9c61e6bbaadd16b32da76aa5a749
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.


>---------------------------------------------------------------

0706a103ae8c9c61e6bbaadd16b32da76aa5a749
 compiler/types/Type.hs              |  2 ++
 compiler/types/Unify.hs             | 20 ++++++++++++--------
 testsuite/tests/perf/compiler/all.T | 10 +++++++---
 3 files changed, 21 insertions(+), 11 deletions(-)

diff --git a/compiler/types/Type.hs b/compiler/types/Type.hs
index f7aea67..180624d 100644
--- a/compiler/types/Type.hs
+++ b/compiler/types/Type.hs
@@ -470,6 +470,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 5edb09d..ed4b224 100644
--- a/compiler/types/Unify.hs
+++ b/compiler/types/Unify.hs
@@ -977,11 +977,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 ()
@@ -991,13 +995,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 a1ebe11..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'])
 
@@ -704,12 +707,13 @@ test('T9872c',
 test('T9872d',
      [ only_ways(['normal']),
        compiler_stats_num_field('bytes allocated',
-          [(wordsize(64), 534693648, 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