summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2018-08-01 06:42:19 -0400
committerBen Gamari <ben@smart-cactus.org>2018-08-01 06:54:23 -0400
commit1df50a0f61f320428f2e6dd07b3c9ce49c4acd31 (patch)
tree07b9441b6f64d129ed183a69516fa3392ea86a93
parent9bd48643c917f8e38a0ddca0b6ac1777bbf66f99 (diff)
downloadhaskell-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.hs10
-rw-r--r--compiler/basicTypes/MkId.hs2
-rw-r--r--compiler/specialise/Rules.hs49
-rw-r--r--compiler/stranal/WorkWrap.hs4
-rw-r--r--testsuite/tests/simplCore/should_compile/T15445.hs8
-rw-r--r--testsuite/tests/simplCore/should_compile/T15445.stderr13
-rw-r--r--testsuite/tests/simplCore/should_compile/T15445a.hs10
-rw-r--r--testsuite/tests/simplCore/should_compile/all.T1
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'])