[Git][ghc/ghc][master] Mark DataCon wrappers CONLIKE
Marge Bot
gitlab at gitlab.haskell.org
Thu Apr 23 03:11:24 UTC 2020
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
6c9fae23 by Alexis King at 2020-04-22T23:11:12-04:00
Mark DataCon wrappers CONLIKE
Now that DataCon wrappers don’t inline until phase 0 (see commit
b78cc64e923716ac0512c299f42d4d0012306c05), it’s important that
case-of-known-constructor and RULE matching be able to see saturated
applications of DataCon wrappers in unfoldings. Making them conlike is a
natural way to do it, since they are, in fact, precisely the sort of
thing the CONLIKE pragma exists to solve.
Fixes #18012.
This also bumps the version of the parsec submodule to incorporate a
patch that avoids a metric increase on the haddock perf tests. The
increase was not really a flaw in this patch, as parsec was implicitly
relying on inlining heuristics. The patch to parsec just adds some
INLINABLE pragmas, and we get a nice performance bump out of it (well
beyond the performance we lost from this patch).
Metric Decrease:
T12234
WWRec
haddock.Cabal
haddock.base
haddock.compiler
- - - - -
12 changed files:
- compiler/GHC/Core/SimpleOpt.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/Types/Id.hs
- compiler/GHC/Types/Id/Make.hs
- libraries/parsec
- testsuite/tests/deSugar/should_compile/T2431.stderr
- testsuite/tests/simplCore/should_compile/T18013.stderr
- testsuite/tests/simplCore/should_compile/T7360.stderr
- + testsuite/tests/simplCore/should_run/T18012.hs
- + testsuite/tests/simplCore/should_run/T18012.stdout
- testsuite/tests/simplCore/should_run/all.T
- testsuite/tests/stranal/should_compile/T16029.stdout
Changes:
=====================================
compiler/GHC/Core/SimpleOpt.hs
=====================================
@@ -889,6 +889,10 @@ And now we have a known-constructor MkT that we can return.
Notice that both (2) and (3) require exprIsConApp_maybe to gather and return
a bunch of floats, both let and case bindings.
+Note that this strategy introduces some subtle scenarios where a data-con
+wrapper can be replaced by a data-con worker earlier than we’d like, see
+Note [exprIsConApp_maybe for data-con wrappers: tricky corner].
+
Note [beta-reduction in exprIsConApp_maybe]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The unfolding a definition (_e.g._ a let-bound variable or a datacon wrapper) is
@@ -949,6 +953,60 @@ exprIsConApp_maybe does not return Just) then nothing happens, and nothing
will happen the next time either.
See test T16254, which checks the behavior of newtypes.
+
+Note [exprIsConApp_maybe for data-con wrappers: tricky corner]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Generally speaking
+
+ * exprIsConApp_maybe honours the inline phase; that is, it does not look
+ inside the unfolding for an Id unless its unfolding is active in this phase.
+ That phase-sensitivity is expressed in the InScopeEnv (specifically, the
+ IdUnfoldingFun component of the InScopeEnv) passed to exprIsConApp_maybe.
+
+ * Data-constructor wrappers are active only in phase 0 (the last phase);
+ see Note [Activation for data constructor wrappers] in GHC.Types.Id.Make.
+
+On the face of it that means that exprIsConApp_maybe won't look inside data
+constructor wrappers until phase 0. But that seems pretty Bad. So we cheat.
+For data con wrappers we unconditionally look inside its unfolding, regardless
+of phase, so that we get case-of-known-constructor to fire in every phase.
+
+Perhaps unsurprisingly, this cheating can backfire. An example:
+
+ data T = C !A B
+ foo p q = let x = C e1 e2 in seq x $ f x
+ {-# RULE "wurble" f (C a b) = b #-}
+
+In Core, the RHS of foo is
+
+ let x = $WC e1 e2 in case x of y { C _ _ -> f x }
+
+and after doing a binder swap and inlining x, we have:
+
+ case $WC e1 e2 of y { C _ _ -> f y }
+
+Case-of-known-constructor fires, but now we have to reconstruct a binding for
+`y` (which was dead before the binder swap) on the RHS of the case alternative.
+Naturally, we’ll use the worker:
+
+ case e1 of a { DEFAULT -> let y = C a e2 in f y }
+
+and after inlining `y`, we have:
+
+ case e1 of a { DEFAULT -> f (C a e2) }
+
+Now we might hope the "wurble" rule would fire, but alas, it will not: we have
+replaced $WC with C, but the (desugared) rule matches on $WC! We weren’t
+supposed to inline $WC yet for precisely that reason (see Note [Activation for
+data constructor wrappers]), but our cheating in exprIsConApp_maybe came back to
+bite us.
+
+This is rather unfortunate, especially since this can happen inside stable
+unfoldings as well as ordinary code (which really happened, see !3041). But
+there is no obvious solution except to delay case-of-known-constructor on
+data-con wrappers, and that cure would be worse than the disease.
+
+This Note exists solely to document the problem.
-}
data ConCont = CC [CoreExpr] Coercion
@@ -1033,7 +1091,8 @@ exprIsConApp_maybe (in_scope, id_unf) expr
-- Look through data constructor wrappers: they inline late (See Note
-- [Activation for data constructor wrappers]) but we want to do
- -- case-of-known-constructor optimisation eagerly.
+ -- case-of-known-constructor optimisation eagerly (see Note
+ -- [exprIsConApp_maybe on data constructors with wrappers]).
| isDataConWrapId fun
, let rhs = uf_tmpl (realIdUnfolding fun)
= go (Left in_scope) floats rhs cont
=====================================
compiler/GHC/Core/Utils.hs
=====================================
@@ -91,7 +91,7 @@ import GHC.Builtin.Types.Prim
import FastString
import Maybes
import ListSetOps ( minusList )
-import GHC.Types.Basic ( Arity, isConLike )
+import GHC.Types.Basic ( Arity )
import Util
import Pair
import Data.ByteString ( ByteString )
@@ -1387,15 +1387,14 @@ isExpandableApp fn n_val_args
| isWorkFreeApp fn n_val_args = True
| otherwise
= case idDetails fn of
- DataConWorkId {} -> True -- Actually handled by isWorkFreeApp
- RecSelId {} -> n_val_args == 1 -- See Note [Record selection]
- ClassOpId {} -> n_val_args == 1
- PrimOpId {} -> False
- _ | isBottomingId fn -> False
+ RecSelId {} -> n_val_args == 1 -- See Note [Record selection]
+ ClassOpId {} -> n_val_args == 1
+ PrimOpId {} -> False
+ _ | isBottomingId fn -> False
-- See Note [isExpandableApp: bottoming functions]
- | isConLike (idRuleMatchInfo fn) -> True
- | all_args_are_preds -> True
- | otherwise -> False
+ | isConLikeId fn -> True
+ | all_args_are_preds -> True
+ | otherwise -> False
where
-- See if all the arguments are PredTys (implicit params or classes)
=====================================
compiler/GHC/Types/Id.hs
=====================================
@@ -768,7 +768,7 @@ idRuleMatchInfo :: Id -> RuleMatchInfo
idRuleMatchInfo id = inlinePragmaRuleMatchInfo (idInlinePragma id)
isConLikeId :: Id -> Bool
-isConLikeId id = isDataConWorkId id || isConLike (idRuleMatchInfo id)
+isConLikeId id = isConLike (idRuleMatchInfo id)
{-
---------------------------------
=====================================
compiler/GHC/Types/Id/Make.hs
=====================================
@@ -510,19 +510,21 @@ mkDataConWorkId wkr_name data_con
alg_wkr_info = noCafIdInfo
`setArityInfo` wkr_arity
`setCprInfo` mkCprSig wkr_arity (dataConCPR data_con)
+ `setInlinePragInfo` wkr_inline_prag
`setUnfoldingInfo` evaldUnfolding -- Record that it's evaluated,
-- even if arity = 0
`setLevityInfoWithType` wkr_ty
-- NB: unboxed tuples have workers, so we can't use
-- setNeverLevPoly
+ wkr_inline_prag = defaultInlinePragma { inl_rule = ConLike }
wkr_arity = dataConRepArity data_con
----------- Workers for newtypes --------------
univ_tvs = dataConUnivTyVars data_con
arg_tys = dataConRepArgTys data_con -- Should be same as dataConOrigArgTys
nt_work_info = noCafIdInfo -- The NoCaf-ness is set by noCafIdInfo
`setArityInfo` 1 -- Arity 1
- `setInlinePragInfo` alwaysInlinePragma
+ `setInlinePragInfo` dataConWrapperInlinePragma
`setUnfoldingInfo` newtype_unf
`setLevityInfoWithType` wkr_ty
id_arg1 = mkTemplateLocal 1 (head arg_tys)
@@ -652,8 +654,8 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con
mk_dmd str | isBanged str = evalDmd
| otherwise = topDmd
- wrap_prag = alwaysInlinePragma `setInlinePragmaActivation`
- activeDuringFinal
+ wrap_prag = dataConWrapperInlinePragma
+ `setInlinePragmaActivation` activeDuringFinal
-- See Note [Activation for data constructor wrappers]
-- The wrapper will usually be inlined (see wrap_unf), so its
@@ -763,6 +765,12 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con
; expr <- mk_rep_app prs (mkVarApps con_app rep_ids)
; return (unbox_fn expr) }
+
+dataConWrapperInlinePragma :: InlinePragma
+-- See Note [DataCon wrappers are conlike]
+dataConWrapperInlinePragma = alwaysInlinePragma { inl_rule = ConLike
+ , inl_inline = Inline }
+
{- Note [Activation for data constructor wrappers]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The Activation on a data constructor wrapper allows it to inline only in Phase
@@ -784,6 +792,37 @@ the order of type argument could make previously working RULEs fail.
See also https://gitlab.haskell.org/ghc/ghc/issues/15840 .
+Note [DataCon wrappers are conlike]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+DataCon workers are clearly ConLike --- they are the “Con” in
+“ConLike”, after all --- but what about DataCon wrappers? Should they
+be marked ConLike, too?
+
+Yes, absolutely! As described in Note [CONLIKE pragma] in
+GHC.Types.Basic, isConLike influences GHC.Core.Utils.exprIsExpandable,
+which is used by both RULE matching and the case-of-known-constructor
+optimization. It’s crucial that both of those things can see
+applications of DataCon wrappers:
+
+ * User-defined RULEs match on wrappers, not workers, so we might
+ need to look through an unfolding built from a DataCon wrapper to
+ determine if a RULE matches.
+
+ * Likewise, if we have something like
+ let x = $WC a b in ... case x of { C y z -> e } ...
+ we still want to apply case-of-known-constructor.
+
+Therefore, it’s important that we consider DataCon wrappers conlike.
+This is especially true now that we don’t inline DataCon wrappers
+until the final simplifier phase; see Note [Activation for data
+constructor wrappers].
+
+For further reading, see:
+ * Note [Conlike is interesting] in GHC.Core.Op.Simplify.Utils
+ * Note [Lone variables] in GHC.Core.Unfold
+ * Note [exprIsConApp_maybe on data constructors with wrappers]
+ in GHC.Core.SimpleOpt
+ * #18012
Note [Bangs on imported data constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
libraries/parsec
=====================================
@@ -1 +1 @@
-Subproject commit ee741870f028e036ab15ae6e2183f09b31e51ae2
+Subproject commit ce416997e15438ca616667995660e123ef7e219d
=====================================
testsuite/tests/deSugar/should_compile/T2431.stderr
=====================================
@@ -4,7 +4,7 @@ Result size of Tidy Core
= {terms: 63, types: 43, coercions: 1, joins: 0/0}
-- RHS size: {terms: 2, types: 4, coercions: 1, joins: 0/0}
-T2431.$WRefl [InlPrag=INLINE[0]] :: forall a. a :~: a
+T2431.$WRefl [InlPrag=INLINE[0] CONLIKE] :: forall a. a :~: a
[GblId[DataConWrapper],
Caf=NoCafRefs,
Cpr=m1,
@@ -110,3 +110,6 @@ T2431.$tc'Refl
$tc'Refl2
1#
$krep3
+
+
+
=====================================
testsuite/tests/simplCore/should_compile/T18013.stderr
=====================================
@@ -120,11 +120,11 @@ Rule fired: mkRule @(_, ()) (T18013a)
Rule fired: Class op fmap (BUILTIN)
Rule fired: mkRule @((), _) (T18013a)
Rule fired: Class op fmap (BUILTIN)
-Rule fired: mkRule @(_, ()) (T18013a)
+Rule fired: mkRule @((), _) (T18013a)
Rule fired: Class op fmap (BUILTIN)
Rule fired: mkRule @(_, ()) (T18013a)
Rule fired: Class op fmap (BUILTIN)
-Rule fired: mkRule @((), _) (T18013a)
+Rule fired: mkRule @(_, ()) (T18013a)
Rule fired: Class op fmap (BUILTIN)
==================== Tidy Core ====================
=====================================
testsuite/tests/simplCore/should_compile/T7360.stderr
=====================================
@@ -4,7 +4,7 @@ Result size of Tidy Core
= {terms: 106, types: 47, coercions: 0, joins: 0/0}
-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0}
-T7360.$WFoo3 [InlPrag=INLINE[0]] :: Int -> Foo
+T7360.$WFoo3 [InlPrag=INLINE[0] CONLIKE] :: Int -> Foo
[GblId[DataConWrapper],
Arity=1,
Caf=NoCafRefs,
=====================================
testsuite/tests/simplCore/should_run/T18012.hs
=====================================
@@ -0,0 +1,41 @@
+module Main (main) where
+
+{- This program is designed to check that case-of-known-constructor
+fires even if an application of a DataCon wrapper is floated out:
+
+ * The early FloatOut pass will float `D False` out of `g`, since
+ it’s a constant, non-trivial expression.
+
+ * But since `D` is strict, the floated-out expression will actually
+ be `$WD False`.
+
+ * In simplifier phase 2, `f` will be inlined into `g`, leading to a
+ case expression that scrutinizes the floated-out binding.
+
+ * If case-of-known-constructor fires, we’ll end up with `notRule
+ False`, the RULE will fire, and we get True.
+
+ * If it doesn’t fire at phase 2, it will fire later at phase 0 when
+ we inline the DataCon wrapper. But now the RULE is inactive, so
+ we’ll end up with False instead.
+
+We want case-of-known-constructor to fire early, so we want the output
+to be True. See #18012 for more details. -}
+
+main :: IO ()
+main = print (g ())
+
+data T = D !Bool
+
+notRule :: Bool -> Bool
+notRule x = x
+{-# INLINE [0] notRule #-}
+{-# RULES "notRule/False" [~0] notRule False = True #-}
+
+f :: T -> () -> Bool
+f (D a) () = notRule a
+{-# INLINE [100] f #-} -- so it isn’t inlined before FloatOut
+
+g :: () -> Bool
+g x = f (D False) x
+{-# NOINLINE g #-}
=====================================
testsuite/tests/simplCore/should_run/T18012.stdout
=====================================
@@ -0,0 +1 @@
+True
=====================================
testsuite/tests/simplCore/should_run/all.T
=====================================
@@ -93,3 +93,4 @@ test('T15840a', normal, compile_and_run, [''])
test('T16066', exit_code(1), compile_and_run, ['-O1'])
test('T17206', exit_code(1), compile_and_run, [''])
test('T17151', [], multimod_compile_and_run, ['T17151', ''])
+test('T18012', normal, compile_and_run, [''])
=====================================
testsuite/tests/stranal/should_compile/T16029.stdout
=====================================
@@ -1,4 +1,4 @@
-T16029.$WMkT [InlPrag=INLINE[0]] :: Int -> Int -> T
+T16029.$WMkT [InlPrag=INLINE[0] CONLIKE] :: Int -> Int -> T
Tmpl= \ (dt [Occ=Once!] :: Int) (dt [Occ=Once!] :: Int) ->
= \ (dt [Occ=Once!] :: Int) (dt [Occ=Once!] :: Int) ->
:: GHC.Prim.Int# -> GHC.Prim.Int#
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6c9fae2342f19ab3e6ac688825a3817b23bf1fcc
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6c9fae2342f19ab3e6ac688825a3817b23bf1fcc
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/20200422/298969f4/attachment-0001.html>
More information about the ghc-commits
mailing list