Commit 621468f6 authored by Alexis King's avatar Alexis King Committed by Marge Bot

Treat coercions as arguments for floating and inlining

This reverts commit 8924224e
and fixes #17787.
parent 1b1067d1
Pipeline #16252 failed with stages
in 493 minutes and 9 seconds
...@@ -198,6 +198,26 @@ import Control.Monad (ap) ...@@ -198,6 +198,26 @@ import Control.Monad (ap)
-- do we set CCCS from it; so we just slam in -- do we set CCCS from it; so we just slam in
-- dontCareCostCentre. -- dontCareCostCentre.
-- Note [Coercion tokens]
-- ~~~~~~~~~~~~~~~~~~~~~~
-- In coreToStgArgs, we drop type arguments completely, but we replace
-- coercions with a special coercionToken# placeholder. Why? Consider:
--
-- f :: forall a. Int ~# Bool -> a
-- f = /\a. \(co :: Int ~# Bool) -> error "impossible"
--
-- If we erased the coercion argument completely, we’d end up with just
-- f = error "impossible", but then f `seq` () would be ⊥!
--
-- This is an artificial example, but back in the day we *did* treat
-- coercion lambdas like type lambdas, and we had bug reports as a
-- result. So now we treat coercion lambdas like value lambdas, but we
-- treat coercions themselves as zero-width arguments — coercionToken#
-- has representation VoidRep — which gets the best of both worlds.
--
-- (For the gory details, see also the (unpublished) paper, “Practical
-- aspects of evidence-based compilation in System FC.”)
-- -------------------------------------------------------------- -- --------------------------------------------------------------
-- Setting variable info: top-level, binds, RHSs -- Setting variable info: top-level, binds, RHSs
-- -------------------------------------------------------------- -- --------------------------------------------------------------
...@@ -357,8 +377,10 @@ coreToStgExpr (App (Lit LitRubbish) _some_unlifted_type) ...@@ -357,8 +377,10 @@ coreToStgExpr (App (Lit LitRubbish) _some_unlifted_type)
-- We lower 'LitRubbish' to @()@ here, which is much easier than doing it in -- We lower 'LitRubbish' to @()@ here, which is much easier than doing it in
-- a STG to Cmm pass. -- a STG to Cmm pass.
= coreToStgExpr (Var unitDataConId) = coreToStgExpr (Var unitDataConId)
coreToStgExpr (Var v) = coreToStgApp v [] [] coreToStgExpr (Var v) = coreToStgApp v [] []
coreToStgExpr (Coercion _) = coreToStgApp coercionTokenId [] [] coreToStgExpr (Coercion _)
-- See Note [Coercion tokens]
= coreToStgApp coercionTokenId [] []
coreToStgExpr expr@(App _ _) coreToStgExpr expr@(App _ _)
= coreToStgApp f args ticks = coreToStgApp f args ticks
...@@ -554,7 +576,7 @@ coreToStgArgs (Type _ : args) = do -- Type argument ...@@ -554,7 +576,7 @@ coreToStgArgs (Type _ : args) = do -- Type argument
(args', ts) <- coreToStgArgs args (args', ts) <- coreToStgArgs args
return (args', ts) return (args', ts)
coreToStgArgs (Coercion _ : args) -- Coercion argument; replace with place holder coreToStgArgs (Coercion _ : args) -- Coercion argument; See Note [Coercion tokens]
= do { (args', ts) <- coreToStgArgs args = do { (args', ts) <- coreToStgArgs args
; return (StgVarArg coercionTokenId : args', ts) } ; return (StgVarArg coercionTokenId : args', ts) }
......
...@@ -1693,7 +1693,7 @@ voidArgId :: Id -- Local lambda-bound :: Void# ...@@ -1693,7 +1693,7 @@ voidArgId :: Id -- Local lambda-bound :: Void#
voidArgId = mkSysLocal (fsLit "void") voidArgIdKey voidPrimTy voidArgId = mkSysLocal (fsLit "void") voidArgIdKey voidPrimTy
coercionTokenId :: Id -- :: () ~ () coercionTokenId :: Id -- :: () ~ ()
coercionTokenId -- Used to replace Coercion terms when we go to STG coercionTokenId -- See Note [Coercion tokens] in CoreToStg.hs
= pcMiscPrelId coercionTokenName = pcMiscPrelId coercionTokenName
(mkTyConApp eqPrimTyCon [liftedTypeKind, liftedTypeKind, unitTy, unitTy]) (mkTyConApp eqPrimTyCon [liftedTypeKind, liftedTypeKind, unitTy, unitTy])
noCafIdInfo noCafIdInfo
......
...@@ -444,8 +444,9 @@ inlineBoringOk e ...@@ -444,8 +444,9 @@ inlineBoringOk e
go :: Int -> CoreExpr -> Bool go :: Int -> CoreExpr -> Bool
go credit (Lam x e) | isId x = go (credit+1) e go credit (Lam x e) | isId x = go (credit+1) e
| otherwise = go credit e | otherwise = go credit e
go credit (App f a) | isTyCoArg a = go credit f -- See Note [Count coercion arguments in boring contexts]
| credit > 0 go credit (App f (Type {})) = go credit f
go credit (App f a) | credit > 0
, exprIsTrivial a = go (credit-1) f , exprIsTrivial a = go (credit-1) f
go credit (Tick _ e) = go credit e -- dubious go credit (Tick _ e) = go credit e -- dubious
go credit (Cast e _) = go credit e go credit (Cast e _) = go credit e
...@@ -591,6 +592,29 @@ Things to note: ...@@ -591,6 +592,29 @@ Things to note:
NB: you might think that PostInlineUnconditionally would do this NB: you might think that PostInlineUnconditionally would do this
but it doesn't fire for top-level things; see SimplUtils but it doesn't fire for top-level things; see SimplUtils
Note [Top level and postInlineUnconditionally] Note [Top level and postInlineUnconditionally]
Note [Count coercion arguments in boring contexts]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In inlineBoringOK, we ignore type arguments when deciding whether an
expression is okay to inline into boring contexts. This is good, since
if we have a definition like
let y = x @Int in f y y
there’s no reason not to inline y at both use sites — no work is
actually duplicated. It may seem like the same reasoning applies to
coercion arguments, and indeed, in #17182 we changed inlineBoringOK to
treat coercions the same way.
However, this isn’t a good idea: unlike type arguments, which have
no runtime representation, coercion arguments *do* have a runtime
representation (albeit the zero-width VoidRep, see Note [Coercion tokens]
in CoreToStg.hs). This caused trouble in #17787 for DataCon wrappers for
nullary GADT constructors: the wrappers would be inlined and each use of
the constructor would lead to a separate allocation instead of just
sharing the wrapper closure.
The solution: don’t ignore coercion arguments after all.
-} -}
uncondInline :: CoreExpr -> Arity -> Int -> Bool uncondInline :: CoreExpr -> Arity -> Int -> Bool
......
...@@ -1007,18 +1007,17 @@ notWorthFloating e abs_vars ...@@ -1007,18 +1007,17 @@ notWorthFloating e abs_vars
go (Tick t e) n = not (tickishIsCode t) && go e n go (Tick t e) n = not (tickishIsCode t) && go e n
go (Cast e _) n = go e n go (Cast e _) n = go e n
go (App e arg) n go (App e arg) n
| Type {} <- arg = go e n -- See Note [Floating applications to coercions]
| Coercion {} <- arg = go e n | Type {} <- arg = go e n
| n==0 = False | n==0 = False
| is_triv arg = go e (n-1) | is_triv arg = go e (n-1)
| otherwise = False | otherwise = False
go _ _ = False go _ _ = False
is_triv (Lit {}) = True -- Treat all literals as trivial is_triv (Lit {}) = True -- Treat all literals as trivial
is_triv (Var {}) = True -- (ie not worth floating) is_triv (Var {}) = True -- (ie not worth floating)
is_triv (Cast e _) = is_triv e is_triv (Cast e _) = is_triv e
is_triv (App e (Type {})) = is_triv e is_triv (App e (Type {})) = is_triv e -- See Note [Floating applications to coercions]
is_triv (App e (Coercion {})) = is_triv e
is_triv (Tick t e) = not (tickishIsCode t) && is_triv e is_triv (Tick t e) = not (tickishIsCode t) && is_triv e
is_triv _ = False is_triv _ = False
...@@ -1032,6 +1031,14 @@ Hence the litIsTrivial. ...@@ -1032,6 +1031,14 @@ Hence the litIsTrivial.
Ditto literal strings (LitString), which we'd like to float to top Ditto literal strings (LitString), which we'd like to float to top
level, which is now possible. level, which is now possible.
Note [Floating applications to coercions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We don’t float out variables applied only to type arguments, since the
extra binding would be pointless: type arguments are completely erased.
But *coercion* arguments aren’t (see Note [Coercion tokens] in
CoreToStg.hs and Note [Count coercion arguments in boring contexts] in
CoreUnfold.hs), so we still want to float out variables applied only to
coercion arguments.
Note [Escaping a value lambda] Note [Escaping a value lambda]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......
...@@ -10,7 +10,7 @@ T2431.$WRefl [InlPrag=INLINE[0]] :: forall a. a :~: a ...@@ -10,7 +10,7 @@ T2431.$WRefl [InlPrag=INLINE[0]] :: forall a. a :~: a
Cpr=m1, Cpr=m1,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True) Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=False)
Tmpl= \ (@a) -> T2431.Refl @a @a @~(<a>_N :: a GHC.Prim.~# a)}] Tmpl= \ (@a) -> T2431.Refl @a @a @~(<a>_N :: a GHC.Prim.~# a)}]
T2431.$WRefl T2431.$WRefl
= \ (@a) -> T2431.Refl @a @a @~(<a>_N :: a GHC.Prim.~# a) = \ (@a) -> T2431.Refl @a @a @~(<a>_N :: a GHC.Prim.~# a)
...@@ -110,6 +110,3 @@ T2431.$tc'Refl ...@@ -110,6 +110,3 @@ T2431.$tc'Refl
$tc'Refl2 $tc'Refl2
1# 1#
$krep3 $krep3
{-# LANGUAGE GADTs #-}
module T17787 where
data T a where
C :: T ()
foo :: (T () -> T () -> ()) -> ()
foo f = f C C
foo :: (T () -> T () -> ()) -> ()
foo = \ (f :: T () -> T () -> ()) -> f T17787.$WC T17787.$WC
...@@ -314,3 +314,4 @@ test('T17409', ...@@ -314,3 +314,4 @@ test('T17409',
test('T17429', normal, compile, ['-dcore-lint -O2']) test('T17429', normal, compile, ['-dcore-lint -O2'])
test('T17722', normal, multimod_compile, ['T17722B', '-dcore-lint -O2 -v0']) test('T17722', normal, multimod_compile, ['T17722B', '-dcore-lint -O2 -v0'])
test('T17724', normal, compile, ['-dcore-lint -O2']) test('T17724', normal, compile, ['-dcore-lint -O2'])
test('T17787', [ grep_errmsg(r'foo') ], compile, ['-ddump-simpl -dsuppress-uniques'])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment