diff options
author | Ben Gamari <ben@smart-cactus.org> | 2018-08-01 06:42:19 -0400 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2018-08-01 06:54:23 -0400 |
commit | 1df50a0f61f320428f2e6dd07b3c9ce49c4acd31 (patch) | |
tree | 07b9441b6f64d129ed183a69516fa3392ea86a93 | |
parent | 9bd48643c917f8e38a0ddca0b6ac1777bbf66f99 (diff) | |
download | haskell-1df50a0f61f320428f2e6dd07b3c9ce49c4acd31.tar.gz |
Revert "Don't inline functions with RULES too early"
This commit causes significant performance regressions:
```
bytes allocated value is too high:
Expected T9872d(normal) bytes allocated: 578498120 +/-5%
Lower bound T9872d(normal) bytes allocated: 549573214
Upper bound T9872d(normal) bytes allocated: 607423026
Actual T9872d(normal) bytes allocated: 677179968
Deviation T9872d(normal) bytes allocated: 17.1 %
bytes allocated value is too high:
Expected T9872c(normal) bytes allocated: 3096670112 +/-5%
Lower bound T9872c(normal) bytes allocated: 2941836606
Upper bound T9872c(normal) bytes allocated: 3251503618
Actual T9872c(normal) bytes allocated: 3601872536
Deviation T9872c(normal) bytes allocated: 16.3 %
bytes allocated value is too high:
Expected T9872b(normal) bytes allocated: 3730686224 +/-5%
Lower bound T9872b(normal) bytes allocated: 3544151912
Upper bound T9872b(normal) bytes allocated: 3917220536
Actual T9872b(normal) bytes allocated: 4374298272
Deviation T9872b(normal) bytes allocated: 17.3 %
bytes allocated value is too high:
Expected T9872a(normal) bytes allocated: 2729927408 +/-5%
Lower bound T9872a(normal) bytes allocated: 2593431037
Upper bound T9872a(normal) bytes allocated: 2866423779
Actual T9872a(normal) bytes allocated: 3225788896
Deviation T9872a(normal) bytes allocated: 18.2 %
```
It's not clear that this was intentional so I'm going to revert for now.
This reverts commit 2110738b280543698407924a16ac92b6d804dc36.
-rw-r--r-- | compiler/basicTypes/BasicTypes.hs | 10 | ||||
-rw-r--r-- | compiler/basicTypes/MkId.hs | 2 | ||||
-rw-r--r-- | compiler/specialise/Rules.hs | 49 | ||||
-rw-r--r-- | compiler/stranal/WorkWrap.hs | 4 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_compile/T15445.hs | 8 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_compile/T15445.stderr | 13 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_compile/T15445a.hs | 10 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_compile/all.T | 1 |
8 files changed, 10 insertions, 87 deletions
diff --git a/compiler/basicTypes/BasicTypes.hs b/compiler/basicTypes/BasicTypes.hs index 3acd5ef4db..93010b75f9 100644 --- a/compiler/basicTypes/BasicTypes.hs +++ b/compiler/basicTypes/BasicTypes.hs @@ -81,7 +81,6 @@ module BasicTypes( Activation(..), isActive, isActiveIn, competesWith, isNeverActive, isAlwaysActive, isEarlyActive, - activeAfterInitial, activeDuringFinal, RuleMatchInfo(..), isConLike, isFunLike, InlineSpec(..), noUserInlineSpec, @@ -1143,15 +1142,6 @@ 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 47fbce7458..4cd20ffdc1 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` - activeAfterInitial + ActiveAfter NoSourceText 2 -- 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 850dba64cd..3380d02f99 100644 --- a/compiler/specialise/Rules.hs +++ b/compiler/specialise/Rules.hs @@ -46,8 +46,7 @@ import TysWiredIn ( anyTypeOfKind ) import Coercion import CoreTidy ( tidyRules ) import Id -import IdInfo ( IdInfo( ruleInfo, inlinePragInfo ) - , RuleInfo( RuleInfo ), setRuleInfo, setInlinePragInfo ) +import IdInfo ( RuleInfo( RuleInfo ) ) import Var import VarEnv import VarSet @@ -56,7 +55,7 @@ import NameSet import NameEnv import UniqFM import Unify ( ruleMatchTyKiX ) -import BasicTypes +import BasicTypes ( Activation, CompilerPhase, isActive, pprRuleName ) import DynFlags ( DynFlags ) import Outputable import FastString @@ -291,23 +290,11 @@ addRuleInfo (RuleInfo rs1 fvs1) (RuleInfo rs2 fvs2) = RuleInfo (rs1 ++ rs2) (fvs1 `unionDVarSet` fvs2) addIdSpecialisations :: Id -> [CoreRule] -> Id --- See Note [Adding specialisations to an Id] -addIdSpecialisations id rules - | null rules +addIdSpecialisations id [] = id - | otherwise - = modifyIdInfo (add_rules . add_activation) id - where - add_rules, add_activation :: IdInfo -> IdInfo - add_rules info = info `setRuleInfo` extendRuleInfo (ruleInfo info) rules - add_activation info - | AlwaysActive <- inlinePragmaActivation inl_prag - = info `setInlinePragInfo` inl_prag' - | otherwise - = info - where - inl_prag = inlinePragInfo info - inl_prag' = inl_prag `setInlinePragmaActivation` activeAfterInitial +addIdSpecialisations id rules + = setIdSpecialisation id $ + extendRuleInfo (idSpecialisation id) rules -- | Gather all the rules for locally bound identifiers from the supplied bindings rulesOfBinds :: [CoreBind] -> [CoreRule] @@ -325,29 +312,7 @@ ruleIsVisible _ BuiltinRule{} = True ruleIsVisible vis_orphs Rule { ru_orphan = orph, ru_origin = origin } = notOrphan orph || origin `elemModuleSet` vis_orphs -{- Note [Adding specialisations to an Id] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Suppose (Trac #15445) we have - f,g :: Num a => a -> a - f x = ...f (x-1)..... - g y = ...g (y-1) .... -and we make some specialisations of 'g', either automatically, or via -a SPECIALISE pragma. Then CSE kicks in and notices that the RHSs of -'f' and 'g' are identical, so we get - f x = ...f (x-1)... - g = f - {-# RULES g @Int _ = $sg #-} - -Now there is terrible danger that, in an importing module, we'll inline -'g' before we have a chance to run its specialisation! - -This is admittedly a bit of an exotic case; but in general with RULES -we want to delay inlining to give the rule a chance to fire. So we -attach a NOINLINE[2] activation to it, to ensure it's not inlined -right away. c.f. other uses of activeAfterInitial in the compiler -e.g. Note [Wrapper activation] in WorkWrap, and - Note [Activation for data constructor wrappers] in MkId - +{- Note [Where rules are found] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The rules for an Id come from two places: diff --git a/compiler/stranal/WorkWrap.hs b/compiler/stranal/WorkWrap.hs index 34cfd64ecd..6289ba039a 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 -> activeDuringFinal - _ -> activeAfterInitial + NeverActive -> ActiveAfter NoSourceText 0 + _ -> ActiveAfter NoSourceText 2 wrap_prag = InlinePragma { inl_src = SourceText "{-# INLINE" , inl_inline = NoUserInline , inl_sat = Nothing diff --git a/testsuite/tests/simplCore/should_compile/T15445.hs b/testsuite/tests/simplCore/should_compile/T15445.hs deleted file mode 100644 index 36bf61dbbb..0000000000 --- a/testsuite/tests/simplCore/should_compile/T15445.hs +++ /dev/null @@ -1,8 +0,0 @@ -module T15445 where - -import T15445a - - -foo :: IO () -foo = do { print (plusTwoRec [1..10 :: Int]) - ; print (plusTwoRec' [1..20 :: Int]) } diff --git a/testsuite/tests/simplCore/should_compile/T15445.stderr b/testsuite/tests/simplCore/should_compile/T15445.stderr deleted file mode 100644 index d5deac5a59..0000000000 --- a/testsuite/tests/simplCore/should_compile/T15445.stderr +++ /dev/null @@ -1,13 +0,0 @@ -Rule fired: Class op + (BUILTIN) -Rule fired: Class op fromInteger (BUILTIN) -Rule fired: integerToInt (BUILTIN) -Rule fired: SPEC plusTwoRec (T15445a) -Rule fired: SPEC $fShow[] (GHC.Show) -Rule fired: Class op >> (BUILTIN) -Rule fired: Class op show (BUILTIN) -Rule fired: SPEC plusTwoRec (T15445a) -Rule fired: Class op enumFromTo (BUILTIN) -Rule fired: Class op show (BUILTIN) -Rule fired: Class op enumFromTo (BUILTIN) -Rule fired: eftIntList (GHC.Enum) -Rule fired: eftIntList (GHC.Enum) diff --git a/testsuite/tests/simplCore/should_compile/T15445a.hs b/testsuite/tests/simplCore/should_compile/T15445a.hs deleted file mode 100644 index 02e5baceb5..0000000000 --- a/testsuite/tests/simplCore/should_compile/T15445a.hs +++ /dev/null @@ -1,10 +0,0 @@ -module T15445a where - -{-# SPECIALIZE plusTwoRec :: [Int] -> [Int] #-} -plusTwoRec :: Num a => [a] -> [a] -plusTwoRec [] = [] -plusTwoRec (x:xs) = x+2:plusTwoRec xs - -plusTwoRec' :: Num a => [a] -> [a] -plusTwoRec' [] = [] -plusTwoRec' (x:xs) = x+2:plusTwoRec' xs diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T index 1275012bf4..d4eaf196df 100644 --- a/testsuite/tests/simplCore/should_compile/all.T +++ b/testsuite/tests/simplCore/should_compile/all.T @@ -317,4 +317,3 @@ test('T15005', normal, compile, ['-O']) test('T15056', [extra_files(['T15056a.hs']), omit_ways(['profasm'])], multimod_compile, ['T15056', '-O -v0 -ddump-rule-firings']) test('T15186', normal, multimod_compile, ['T15186', '-v0']) test('T15453', normal, compile, ['-dcore-lint -O1']) -test('T15445', normal, multimod_compile, ['T15445', '-v0 -O -ddump-rule-firings']) |