[commit: ghc] master: Define activeAfterInitial, activeDuringFinal (1152a3b)

git at git.haskell.org git at git.haskell.org
Wed Sep 5 16:26:39 UTC 2018


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

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

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

commit 1152a3bee1aef3e24a03e0c2e4e5272ca926f7ab
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Wed Sep 5 15:53:15 2018 +0100

    Define activeAfterInitial, activeDuringFinal
    
    This is pure refactoring, just adding a couple of
    definitions to BasicTypes, and using them.
    
    Plus some whitespace stuff.


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

1152a3bee1aef3e24a03e0c2e4e5272ca926f7ab
 compiler/basicTypes/BasicTypes.hs | 10 ++++++++++
 compiler/basicTypes/MkId.hs       |  2 +-
 compiler/specialise/Rules.hs      | 12 ++++++------
 compiler/stranal/WorkWrap.hs      |  4 ++--
 4 files changed, 19 insertions(+), 9 deletions(-)

diff --git a/compiler/basicTypes/BasicTypes.hs b/compiler/basicTypes/BasicTypes.hs
index ce46962..151a040 100644
--- a/compiler/basicTypes/BasicTypes.hs
+++ b/compiler/basicTypes/BasicTypes.hs
@@ -81,6 +81,7 @@ module BasicTypes(
 
         Activation(..), isActive, isActiveIn, competesWith,
         isNeverActive, isAlwaysActive, isEarlyActive,
+        activeAfterInitial, activeDuringFinal,
 
         RuleMatchInfo(..), isConLike, isFunLike,
         InlineSpec(..), noUserInlineSpec,
@@ -1142,6 +1143,15 @@ instance Outputable CompilerPhase where
    ppr (Phase n)    = int n
    ppr InitialPhase = text "InitialPhase"
 
+activeAfterInitial :: Activation
+-- Active in the first phase after the initial phase
+-- Currently we have just phases [2,1,0]
+activeAfterInitial = ActiveAfter NoSourceText 2
+
+activeDuringFinal :: Activation
+-- Active in the final simplification phase (which is repeated)
+activeDuringFinal = ActiveAfter NoSourceText 0
+
 -- See note [Pragma source text]
 data Activation = NeverActive
                 | AlwaysActive
diff --git a/compiler/basicTypes/MkId.hs b/compiler/basicTypes/MkId.hs
index 4cd20ff..47fbce7 100644
--- a/compiler/basicTypes/MkId.hs
+++ b/compiler/basicTypes/MkId.hs
@@ -594,7 +594,7 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con
                         | otherwise           = topDmd
 
              wrap_prag = alwaysInlinePragma `setInlinePragmaActivation`
-                         ActiveAfter NoSourceText 2
+                         activeAfterInitial
                          -- See Note [Activation for data constructor wrappers]
 
              -- The wrapper will usually be inlined (see wrap_unf), so its
diff --git a/compiler/specialise/Rules.hs b/compiler/specialise/Rules.hs
index 4a4abf7..ad6a075 100644
--- a/compiler/specialise/Rules.hs
+++ b/compiler/specialise/Rules.hs
@@ -55,7 +55,7 @@ import NameSet
 import NameEnv
 import UniqFM
 import Unify            ( ruleMatchTyKiX )
-import BasicTypes       ( Activation, CompilerPhase, isActive, pprRuleName )
+import BasicTypes
 import DynFlags         ( DynFlags )
 import Outputable
 import FastString
@@ -290,9 +290,10 @@ addRuleInfo (RuleInfo rs1 fvs1) (RuleInfo rs2 fvs2)
   = RuleInfo (rs1 ++ rs2) (fvs1 `unionDVarSet` fvs2)
 
 addIdSpecialisations :: Id -> [CoreRule] -> Id
-addIdSpecialisations id []
-  = id
 addIdSpecialisations id rules
+  | null rules
+  = id
+  | otherwise
   = setIdSpecialisation id $
     extendRuleInfo (idSpecialisation id) rules
 
@@ -312,9 +313,8 @@ ruleIsVisible _ BuiltinRule{} = True
 ruleIsVisible vis_orphs Rule { ru_orphan = orph, ru_origin = origin }
     = notOrphan orph || origin `elemModuleSet` vis_orphs
 
-{-
-Note [Where rules are found]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+{- Note [Where rules are found]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 The rules for an Id come from two places:
   (a) the ones it is born with, stored inside the Id iself (idCoreRules fn),
   (b) rules added in other modules, stored in the global RuleBase (imp_rules)
diff --git a/compiler/stranal/WorkWrap.hs b/compiler/stranal/WorkWrap.hs
index 6289ba0..34cfd64 100644
--- a/compiler/stranal/WorkWrap.hs
+++ b/compiler/stranal/WorkWrap.hs
@@ -551,8 +551,8 @@ splitFun dflags fam_envs fn_id fn_info wrap_dmds res_info rhs
             wrap_rhs  = wrap_fn work_id
             wrap_act  = case fn_act of  -- See Note [Wrapper activation]
                            ActiveAfter {} -> fn_act
-                           NeverActive    -> ActiveAfter NoSourceText 0
-                           _              -> ActiveAfter NoSourceText 2
+                           NeverActive    -> activeDuringFinal
+                           _              -> activeAfterInitial
             wrap_prag = InlinePragma { inl_src    = SourceText "{-# INLINE"
                                      , inl_inline = NoUserInline
                                      , inl_sat    = Nothing



More information about the ghc-commits mailing list