[commit: ghc] master: Make tagForCon non-linear (faf60e8)

[git at git.haskell.org]

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

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

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

commit faf60e858a293affca463043c830e1edb5685003
Author: Bartosz Nitka <bnitka at fb.com>
Date:   Fri Oct 20 20:30:52 2017 +0100

    Make tagForCon non-linear
    
    Computing the number of constructors for TyCon is linear
    in the number of constructors.
    That's wasteful if all you want to check is if that
    number is smaller than what fits in tag bits
    (usually 8 things).
    
    What this change does is to use a function that can
    determine the ineqaulity without computing the size.
    
    This improves compile time on a module with a
    data type that has 10k constructors.
    The variance in total time is (suspiciously) high,
    but going by the best of 3 the numbers are 8.186s vs 7.511s.
    For 1000 constructors the difference isn't noticeable:
    0.646s vs 0.624s.
    The hot spots were cgDataCon and cgEnumerationTyCon
    where tagForCon is called in a loop.
    
    One alternative would be to pass down the size.
    
    Test Plan: harbormaster
    
    Reviewers: bgamari, simonmar, austin
    
    Reviewed By: simonmar
    
    Subscribers: rwbarton, thomie
    
    Differential Revision: https://phabricator.haskell.org/D4116


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

faf60e858a293affca463043c830e1edb5685003
 compiler/codeGen/StgCmmClosure.hs | 11 ++++++++---
 compiler/types/TyCon.hs           | 16 +++++++++++++++-
 2 files changed, 23 insertions(+), 4 deletions(-)

diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs
index 1da1f70..2501ec9 100644
--- a/compiler/codeGen/StgCmmClosure.hs
+++ b/compiler/codeGen/StgCmmClosure.hs
@@ -361,13 +361,18 @@ type DynTag = Int       -- The tag on a *pointer*
 isSmallFamily :: DynFlags -> Int -> Bool
 isSmallFamily dflags fam_size = fam_size <= mAX_PTR_TAG dflags
 
+-- | Faster version of isSmallFamily if you haven't computed the size yet.
+isSmallFamilyTyCon :: DynFlags -> TyCon -> Bool
+isSmallFamilyTyCon dflags tycon =
+  tyConFamilySizeAtMost tycon (mAX_PTR_TAG dflags)
+
 tagForCon :: DynFlags -> DataCon -> DynTag
 tagForCon dflags con
-  | isSmallFamily dflags fam_size = con_tag
-  | otherwise                     = 1
+  | isSmallFamilyTyCon dflags tycon = con_tag
+  | otherwise                       = 1
   where
     con_tag  = dataConTag con -- NB: 1-indexed
-    fam_size = tyConFamilySize (dataConTyCon con)
+    tycon = dataConTyCon con
 
 tagForArity :: DynFlags -> RepArity -> DynTag
 tagForArity dflags arity
diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs
index 39d2e9b..103c824 100644
--- a/compiler/types/TyCon.hs
+++ b/compiler/types/TyCon.hs
@@ -78,7 +78,7 @@ module TyCon(
         tyConDataCons, tyConDataCons_maybe,
         tyConSingleDataCon_maybe, tyConSingleDataCon,
         tyConSingleAlgDataCon_maybe,
-        tyConFamilySize,
+        tyConFamilySize, tyConFamilySizeAtMost,
         tyConStupidTheta,
         tyConArity,
         tyConRoles,
@@ -2205,6 +2205,20 @@ tyConFamilySize tc@(AlgTyCon { algTcRhs = rhs })
       _                              -> pprPanic "tyConFamilySize 1" (ppr tc)
 tyConFamilySize tc = pprPanic "tyConFamilySize 2" (ppr tc)
 
+-- | Determine if number of value constructors a 'TyCon' has is smaller
+-- than n. Faster than tyConFamilySize tc <= n.
+-- Panics if the 'TyCon' is not algebraic or a tuple
+tyConFamilySizeAtMost  :: TyCon -> Int -> Bool
+tyConFamilySizeAtMost tc@(AlgTyCon { algTcRhs = rhs }) n
+  = case rhs of
+      DataTyCon { data_cons = cons } -> lengthAtMost cons n
+      NewTyCon {}                    -> 1 <= n
+      TupleTyCon {}                  -> 1 <= n
+      SumTyCon { data_cons = cons }  -> lengthAtMost cons n
+      _                              -> pprPanic "tyConFamilySizeAtMost 1"
+                                          (ppr tc)
+tyConFamilySizeAtMost tc _ = pprPanic "tyConFamilySizeAtMost 2" (ppr tc)
+
 -- | Extract an 'AlgTyConRhs' with information about data constructors from an
 -- algebraic or tuple 'TyCon'. Panics for any other sort of 'TyCon'
 algTyConRhs :: TyCon -> AlgTyConRhs