[Git][ghc/ghc][wip/T18223] Wibbles
Simon Peyton Jones
gitlab at gitlab.haskell.org
Tue Aug 25 11:51:12 UTC 2020
Simon Peyton Jones pushed to branch wip/T18223 at Glasgow Haskell Compiler / GHC
Commits:
e3c76de3 by Simon Peyton Jones at 2020-08-25T12:50:30+01:00
Wibbles
- - - - -
6 changed files:
- compiler/GHC/Core/Opt/Pipeline.hs
- compiler/GHC/Core/Opt/Specialise.hs
- testsuite/tests/perf/compiler/T16473.stdout
- testsuite/tests/printer/T18052a.stderr
- testsuite/tests/simplCore/should_compile/T17966.stdout
- testsuite/tests/stranal/should_compile/T18122.stderr
Changes:
=====================================
compiler/GHC/Core/Opt/Pipeline.hs
=====================================
@@ -311,33 +311,38 @@ getCoreToDo dflags
runWhen do_float_in CoreDoFloatInwards,
+ simplify "final", -- Final tidy-up
+
maybe_rule_check FinalPhase,
+ -------- After this we have -O2 passes -----------------
+ -- None of them run with -O
+
-- Case-liberation for -O2. This should be after
-- strictness analysis and the simplification which follows it.
- runWhen liberate_case (CoreDoPasses [
- CoreLiberateCase,
- simplify "post-liberate-case"
- ]), -- Run the simplifier after LiberateCase to vastly
- -- reduce the possibility of shadowing
- -- Reason: see Note [Shadowing] in GHC.Core.Opt.SpecConstr
+ runWhen liberate_case $ CoreDoPasses
+ [ CoreLiberateCase, simplify "post-liberate-case" ],
+ -- Run the simplifier after LiberateCase to vastly
+ -- reduce the possibility of shadowing
+ -- Reason: see Note [Shadowing] in GHC.Core.Opt.SpecConstr
- runWhen spec_constr CoreDoSpecConstr,
+ runWhen spec_constr $ CoreDoPasses
+ [ CoreDoSpecConstr, simplify "post-spec-constr"],
+ -- See Note [Simplify after SpecConstr]
maybe_rule_check FinalPhase,
- runWhen late_specialise
- (CoreDoPasses [ CoreDoSpecialising
- , simplify "post-late-spec"]),
+ runWhen late_specialise $ CoreDoPasses
+ [ CoreDoSpecialising, simplify "post-late-spec"],
-- LiberateCase can yield new CSE opportunities because it peels
-- off one layer of a recursive function (concretely, I saw this
-- in wheel-sieve1), and I'm guessing that SpecConstr can too
-- And CSE is a very cheap pass. So it seems worth doing here.
- runWhen ((liberate_case || spec_constr) && cse) CoreCSE,
+ runWhen ((liberate_case || spec_constr) && cse) $ CoreDoPasses
+ [ CoreCSE, simplify "post-final-cse" ],
- -- Final clean-up simplification:
- simplify "final",
+ --------- End of -O2 passes --------------
runWhen late_dmd_anal $ CoreDoPasses (
dmd_cpr_ww ++ [simplify "post-late-ww"]
@@ -406,6 +411,10 @@ or with -O0. Two reasons:
But watch out: list fusion can prevent floating. So use phase control
to switch off those rules until after floating.
+Note [Simplify after SpecConstr]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We want to run the simplifier after SpecConstr, and
+
************************************************************************
* *
The CoreToDo interpreter
=====================================
compiler/GHC/Core/Opt/Specialise.hs
=====================================
@@ -719,7 +719,7 @@ spec_import top_env callers rb dict_binds cis@(CIS fn _)
= do { -- debugTraceMsg (text "specImport:no valid calls")
; return ([], []) }
- | Just rhs <- maybeUnfoldingTemplate unfolding
+ | Just rhs <- canSpecImport dflags fn
= do { -- Get rules from the external package state
-- We keep doing this in case we "page-fault in"
-- more rules as we go along
@@ -757,11 +757,33 @@ spec_import top_env callers rb dict_binds cis@(CIS fn _)
where
dflags = se_dflags top_env
- unfolding = realIdUnfolding fn -- We want to see the unfolding even for loop breakers
good_calls = filterCalls cis dict_binds
-- SUPER IMPORTANT! Drop calls that (directly or indirectly) refer to fn
-- See Note [Avoiding loops in specImports]
+canSpecImport :: DynFlags -> Id -> Maybe CoreExpr
+-- See Note [Specialise imported INLINABLE things]
+canSpecImport dflags fn
+ | CoreUnfolding { uf_src = src, uf_tmpl = rhs } <- unf
+ , isStableSource src
+ = Just rhs -- By default, specialise only imported things that have a stable
+ -- unfolding; that is, have an INLINE or INLINABLE pragma
+ -- Specialise even INLINE things; it hasn't inlined yet,
+ -- so perhaps it never will. Moreover it may have calls
+ -- inside it that we want to specialise
+
+ -- CoreUnfolding case does /not/ include DFunUnfoldings;
+ -- We only specialise DFunUnfoldings with -fspecialise-aggressively
+ -- See Note [Do not specialise imported DFuns]
+
+ | gopt Opt_SpecialiseAggressively dflags
+ = maybeUnfoldingTemplate unf -- With -fspecialise-aggressively, specialise anything
+ -- with an unfolding, stable or not, DFun or not
+
+ | otherwise = Nothing
+ where
+ unf = realIdUnfolding fn -- We want to see the unfolding even for loop breakers
+
-- | Returns whether or not to show a missed-spec warning.
-- If -Wall-missed-specializations is on, show the warning.
-- Otherwise, if -Wmissed-specializations is on, only show a warning
@@ -786,8 +808,47 @@ tryWarnMissingSpecs dflags callers fn calls_for_fn
, whenPprDebug (text "calls:" <+> vcat (map (pprCallInfo fn) calls_for_fn))
, text "Probable fix: add INLINABLE pragma on" <+> quotes (ppr fn) ])
-{- Note [Avoiding loops in specImports]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+{- Note [Do not specialise imported DFuns]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Ticket #18223 shows that specialising calls of DFuns is can cause a huge
+and entirely unnecessary blowup in program size. Consider a call to
+ f @[[[[[[[[T]]]]]]]] d1 x
+where df :: C a => C [a]
+ d1 :: C [[[[[[[[T]]]]]]]] = dfC[] @[[[[[[[T]]]]]]] d1
+ d2 :: C [[[[[[[T]]]]]]] = dfC[] @[[[[[[T]]]]]] d3
+ ...
+Now we'll specialise f's RHS, which may give rise to calls to 'g',
+also overloaded, which we will specialise, and so on. However, if
+we specialise the calls to dfC[], we'll generate specialised copies of
+all methods of C, at all types; and the same for C's superclasses.
+
+And many of these specialised functions will never be called. We are
+going to call the specialised 'f', and the specialised 'g', but DFuns
+group functions into a tuple, many of whose elements may never be used.
+
+With deeply-nested types this can lead to a simply overwhelming number
+of specialisations: see #18223 for a simple example (from the wild).
+I measured the number of specialisations for various numbers of calls
+of `flip evalStateT ()`, and got this
+
+ Size after one simplification
+ #calls #SPEC rules Terms Types
+ 5 56 3100 10600
+ 9 108 13660 77206
+
+The real tests case has 60+ calls, which blew GHC out of the water.
+
+Solution: don't specialise DFuns. The downside is that if we end
+up with (h (dfun d)), /and/ we don't specialise 'h', then we won't
+pass to 'h' a tuple of specialised functions.
+
+However, the flag -fspecialise-aggressively (experimental, off by default)
+allows DFuns to specialise as well.
+
+Note [Avoiding loops in specImports]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We must take great care when specialising instance declarations
(functions like $fOrdList) lest we accidentally build a recursive
dictionary. See Note [Avoiding loops].
@@ -2502,69 +2563,16 @@ mkCallUDs' env f args
ForAllPred {} -> True
wantCallsFor :: SpecEnv -> Id -> Bool
-wantCallsFor env f
- | isLocalId f -- Local function; don't look at the unfolding, because
- = True -- unfoldings for local functions are discarded by cloneBind
- -- ToDo: we could keep a candidate set of let-binders to
- -- reduce the size of the UsageDetails
-
- | otherwise -- Imported function
- = case unf of
- NoUnfolding -> False
- BootUnfolding -> False
- OtherCon {} -> False
- CoreUnfolding { uf_src = src }
- | isStableSource src -> True -- INLINEABLE/INLINE
- -- See Note [Specialise imported INLINABLE things]
- -- Specialise even INLINE things; it hasn't inlined yet,
- -- so perhaps it never will. Moreover it may have calls
- -- inside it that we want to specialise
- | otherwise -> aggressive_only -- Imported, no INLINABLE
- DFunUnfolding {} -> aggressive_only -- See Note [Do not specialise DFuns]
- where
- aggressive_only = gopt Opt_SpecialiseAggressively (se_dflags env)
- unf = realIdUnfolding f
- -- 'realIdUnfolding' to ignore the loop-breaker flag!
-
-{- Note [Do not specialise DFuns]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Ticket #18223 shows that specialising calls of DFuns is can cause a huge
-and entirely unnecessary blowup in program size. Consider a call to
- f @[[[[[[[[T]]]]]]]] d1 x
-where df :: C a => C [a]
- d1 :: C [[[[[[[[T]]]]]]]] = dfC[] @[[[[[[[T]]]]]]] d1
- d2 :: C [[[[[[[T]]]]]]] = dfC[] @[[[[[[T]]]]]] d3
- ...
-Now we'll specialise f's RHS, which may give rise to calls to 'g',
-also overloaded, which we will specialise, and so on. However, if
-we specialise the calls to dfC[], we'll generate specialised copies of
-all methods of C, at all types; and the same for C's superclasses.
-
-And many of these specialised functions will never be called. We are
-going to call the specialised 'f', and the specialised 'g', but DFuns
-group functions into a tuple, many of whose elements may never be used.
-
-With deeply-nested types this can lead to a simply overwhelming number
-of specialisations: see #18223 for a simple example (from the wild).
-I measured the number of specialisations for various numbers of calls
-of `flip evalStateT ()`, and got this
-
- Size after one simplification
- #calls #SPEC rules Terms Types
- 5 56 3100 10600
- 9 108 13660 77206
-
-The real tests case has 60+ calls, which blew GHC out of the water.
+wantCallsFor _env _f = True
+ -- We could be less eager about collecting calls for LocalIds: there's
+ -- no point for ones that are lambda-bound. But we can't use the
+ -- unfolding, because unfoldings for local functions are discarded by
+ -- cloneBindSM. We could keep a candidate set of let-binders to
+ -- reduce the size of the UsageDetails
-Solution: don't specialise DFuns. The downside is that if we end
-up with (h (dfun d)), /and/ we don't specialise 'h', then we won't
-pass to 'h' a tuple of specialised functions.
-However, the flag -fspecialise-aggressively (experimental, off by default)
-allows DFuns to specialise as well.
-
-Note [Type determines value]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+{- Note [Type determines value]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Only specialise on non-IP *class* params, because these are the ones
whose *type* determines their *value*. In particular, with implicit
params, the type args *don't* say what the value of the implicit param
=====================================
testsuite/tests/perf/compiler/T16473.stdout
=====================================
@@ -73,25 +73,15 @@ Rule fired: Class op $p1Monad (BUILTIN)
Rule fired: Class op pure (BUILTIN)
Rule fired: Class op $p1Monad (BUILTIN)
Rule fired: Class op $p1Applicative (BUILTIN)
-Rule fired: SPEC/Main $fMonadStateT_$c>>= @Identity _ (Main)
-Rule fired: SPEC/Main $fApplicativeStateT_$c<*> @Identity _ (Main)
-Rule fired: SPEC/Main $fApplicativeStateT_$cpure @Identity _ (Main)
-Rule fired: SPEC/Main $fFunctorStateT @Identity _ (Main)
-Rule fired: SPEC/Main $fFunctorStateT_$cfmap @Identity _ (Main)
-Rule fired: Class op fmap (BUILTIN)
-Rule fired: SPEC/Main $fFunctorStateT_$cfmap @Identity _ (Main)
-Rule fired: Class op fmap (BUILTIN)
-Rule fired: Class op fmap (BUILTIN)
-Rule fired: Class op fmap (BUILTIN)
-Rule fired: Class op fmap (BUILTIN)
-Rule fired: Class op fmap (BUILTIN)
-Rule fired: Class op return (BUILTIN)
-Rule fired: Class op return (BUILTIN)
-Rule fired: Class op >>= (BUILTIN)
-Rule fired: Class op >>= (BUILTIN)
-Rule fired: Class op >>= (BUILTIN)
Rule fired: Class op >>= (BUILTIN)
+Rule fired: SC:$wgo90 (Main)
Rule fired: Class op return (BUILTIN)
Rule fired: Class op >>= (BUILTIN)
Rule fired: Class op >>= (BUILTIN)
Rule fired: Class op return (BUILTIN)
+Rule fired: SC:$wgo90 (Main)
+Rule fired: Class op fmap (BUILTIN)
+Rule fired: Class op fmap (BUILTIN)
+Rule fired: SPEC $s$wgo9 (Main)
+Rule fired: SPEC $s$wgo9 (Main)
+Rule fired: SPEC $s$wgo9 (Main)
=====================================
testsuite/tests/printer/T18052a.stderr
=====================================
@@ -20,7 +20,7 @@ T18052a.$b:||: = \ (@a) (@b) (x :: a) (y :: b) -> (x, y)
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
(+++) :: forall {a}. [a] -> [a] -> [a]
[GblId]
-(+++) = (++)
+(+++) = ++
-- RHS size: {terms: 13, types: 20, coercions: 0, joins: 0/0}
T18052a.$m:||:
=====================================
testsuite/tests/simplCore/should_compile/T17966.stdout
=====================================
@@ -1,5 +1,2 @@
RULES: "SPEC $cm @()" [0]
RULES: "SPEC f @Bool @() @(Maybe Integer)" [0]
-"SPEC/T17966 $fShowMaybe_$cshow @Integer"
-"SPEC/T17966 $fShowMaybe_$cshowList @Integer"
-"SPEC/T17966 $fShowMaybe @Integer"
=====================================
testsuite/tests/stranal/should_compile/T18122.stderr
=====================================
@@ -13,9 +13,8 @@ Lib.$trModule4 = "main"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
Lib.$trModule3 :: GHC.Types.TrName
[GblId,
- Cpr=m1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
+ WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
Lib.$trModule3 = GHC.Types.TrNameS Lib.$trModule4
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
@@ -28,27 +27,25 @@ Lib.$trModule2 = "Lib"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
Lib.$trModule1 :: GHC.Types.TrName
[GblId,
- Cpr=m1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
+ WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
Lib.$trModule1 = GHC.Types.TrNameS Lib.$trModule2
-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
Lib.$trModule :: GHC.Types.Module
[GblId,
- Cpr=m1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
+ WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
Lib.$trModule = GHC.Types.Module Lib.$trModule3 Lib.$trModule1
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
Lib.$wfoo [InlPrag=NOINLINE]
:: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int#
[GblId, Arity=2, Str=<L,U><L,U>, Unf=OtherCon []]
-Lib.$wfoo = (GHC.Prim.+#)
+Lib.$wfoo = GHC.Prim.+#
-- RHS size: {terms: 18, types: 14, coercions: 0, joins: 0/0}
-foo [InlPrag=NOUSERINLINE[0]] :: (Int, Int) -> Int -> Int
+foo [InlPrag=NOUSERINLINE[final]] :: (Int, Int) -> Int -> Int
[GblId,
Arity=2,
Str=<S(SL),1*U(1*U(U),A)><S,1*U(U)>,
@@ -56,24 +53,25 @@ foo [InlPrag=NOUSERINLINE[0]] :: (Int, Int) -> Int -> Int
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
- Tmpl= \ (w_sHs [Occ=Once!] :: (Int, Int))
- (w1_sHt [Occ=Once!] :: Int) ->
- case w_sHs of { (ww1_sHw [Occ=Once!], _ [Occ=Dead]) ->
- case ww1_sHw of { GHC.Types.I# ww4_sHz [Occ=Once] ->
- case w1_sHt of { GHC.Types.I# ww6_sHF [Occ=Once] ->
- case Lib.$wfoo ww4_sHz ww6_sHF of ww7_sHJ [Occ=Once] { __DEFAULT ->
- GHC.Types.I# ww7_sHJ
+ Tmpl= \ (w_sEf [Occ=Once1!] :: (Int, Int))
+ (w1_sEg [Occ=Once1!] :: Int) ->
+ case w_sEf of { (ww1_sEj [Occ=Once1!], _ [Occ=Dead]) ->
+ case ww1_sEj of { GHC.Types.I# ww4_sEm [Occ=Once1] ->
+ case w1_sEg of { GHC.Types.I# ww6_sEs [Occ=Once1] ->
+ case Lib.$wfoo ww4_sEm ww6_sEs of ww7_sEw [Occ=Once1]
+ { __DEFAULT ->
+ GHC.Types.I# ww7_sEw
}
}
}
}}]
foo
- = \ (w_sHs :: (Int, Int)) (w1_sHt :: Int) ->
- case w_sHs of { (ww1_sHw, ww2_sHB) ->
- case ww1_sHw of { GHC.Types.I# ww4_sHz ->
- case w1_sHt of { GHC.Types.I# ww6_sHF ->
- case Lib.$wfoo ww4_sHz ww6_sHF of ww7_sHJ { __DEFAULT ->
- GHC.Types.I# ww7_sHJ
+ = \ (w_sEf :: (Int, Int)) (w1_sEg :: Int) ->
+ case w_sEf of { (ww1_sEj, ww2_sEo) ->
+ case ww1_sEj of { GHC.Types.I# ww4_sEm ->
+ case w1_sEg of { GHC.Types.I# ww6_sEs ->
+ case Lib.$wfoo ww4_sEm ww6_sEs of ww7_sEw { __DEFAULT ->
+ GHC.Types.I# ww7_sEw
}
}
}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e3c76de3eb2a09d78ebc14cc5c11b667b69c5807
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e3c76de3eb2a09d78ebc14cc5c11b667b69c5807
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200825/c36d03cb/attachment-0001.html>
More information about the ghc-commits
mailing list