Commit 63fa3997 authored by Sebastian Graf's avatar Sebastian Graf Committed by Marge Bot

Arity: Rework `ArityType` to fix monotonicity (#18870)

As we found out in #18870, `andArityType` is not monotone, with
potentially severe consequences for termination of fixed-point
iteration. That showed in an abundance of "Exciting arity" DEBUG
messages that are emitted whenever we do more than one step in
fixed-point iteration.

The solution necessitates also recording `OneShotInfo` info for
`ABot` arity type. Thus we get the following definition for `ArityType`:

```
data ArityType = AT [OneShotInfo] Divergence
```

The majority of changes in this patch are the result of refactoring use
sites of `ArityType` to match the new definition.

The regression test `T18870` asserts that we indeed don't emit any DEBUG
output anymore for a function where we previously would have.
Similarly, there's a regression test `T18937` for #18937, which we
expect to be broken for now.

Fixes #18870.
parent 5353fd50
This diff is collapsed.
......@@ -42,14 +42,14 @@ import GHC.Core
import GHC.Builtin.Types.Prim( realWorldStatePrimTy )
import GHC.Builtin.Names( runRWKey )
import GHC.Types.Demand ( StrictSig(..), Demand, dmdTypeDepth, isStrictDmd
, mkClosedStrictSig, topDmd, seqDmd, botDiv )
, mkClosedStrictSig, topDmd, seqDmd, isDeadEndDiv )
import GHC.Types.Cpr ( mkCprSig, botCpr )
import GHC.Core.Ppr ( pprCoreExpr )
import GHC.Types.Unique ( hasKey )
import GHC.Core.Unfold
import GHC.Core.Unfold.Make
import GHC.Core.Utils
import GHC.Core.Opt.Arity ( ArityType(..), arityTypeArity, isBotArityType
import GHC.Core.Opt.Arity ( ArityType(..)
, pushCoTyArg, pushCoValArg
, idArityType, etaExpandAT )
import GHC.Core.SimpleOpt ( exprIsConApp_maybe, joinPointBinding_maybe, joinPointBindings_maybe )
......@@ -796,8 +796,8 @@ addLetBndrInfo :: OutId -> ArityType -> Unfolding -> OutId
addLetBndrInfo new_bndr new_arity_type new_unf
= new_bndr `setIdInfo` info5
where
new_arity = arityTypeArity new_arity_type
is_bot = isBotArityType new_arity_type
AT oss div = new_arity_type
new_arity = length oss
info1 = idInfo new_bndr `setArityInfo` new_arity
......@@ -816,11 +816,11 @@ addLetBndrInfo new_bndr new_arity_type new_unf
= info2
-- Bottoming bindings: see Note [Bottoming bindings]
info4 | is_bot = info3 `setStrictnessInfo` bot_sig
`setCprInfo` bot_cpr
| otherwise = info3
info4 | isDeadEndDiv div = info3 `setStrictnessInfo` bot_sig
`setCprInfo` bot_cpr
| otherwise = info3
bot_sig = mkClosedStrictSig (replicate new_arity topDmd) botDiv
bot_sig = mkClosedStrictSig (replicate new_arity topDmd) div
bot_cpr = mkCprSig new_arity botCpr
-- Zap call arity info. We have used it by now (via
......
......@@ -1662,8 +1662,8 @@ tryEtaExpandRhs mode bndr rhs
| Just join_arity <- isJoinId_maybe bndr
= do { let (join_bndrs, join_body) = collectNBinders join_arity rhs
oss = [idOneShotInfo id | id <- join_bndrs, isId id]
arity_type | exprIsDeadEnd join_body = ABot (length oss)
| otherwise = ATop oss
arity_type | exprIsDeadEnd join_body = mkBotArityType oss
| otherwise = mkTopArityType oss
; return (arity_type, rhs) }
-- Note [Do not eta-expand join points]
-- But do return the correct arity and bottom-ness, because
......
{-# OPTIONS_GHC -O2 -fforce-recomp #-}
module T18870 where
import GHC.Exts
-- This function should not lead to an "Exciting arity" DEBUG message.
-- It should only do one round of fixed-point iteration to conclude that it has
-- arity 2.
f :: [a] -> a -> a
f [] = id
f (x:xs) = oneShot (\_ -> f xs x)
{-# OPTIONS_GHC -O2 -fforce-recomp #-}
module T18937 where
f :: [Int] -> Int -> Int
f [] = id
f (x:xs) = let y = sum [0..x]
in \z -> f xs (y + z)
......@@ -19,3 +19,5 @@ test('Arity16', [ only_ways(['optasm']), grep_errmsg('Arity=') ], compile, ['-dn
# Regression tests
test('T18793', [ only_ways(['optasm']), grep_errmsg('Arity=') ], compile, ['-dno-typeable-binds -ddump-simpl -dppr-cols=99999 -dsuppress-uniques'])
test('T18870', [ only_ways(['optasm']) ], compile, ['-ddebug-output'])
test('T18937', [ only_ways(['optasm']), when(compiler_debugged(), expect_broken(18937)) ], compile, ['-ddebug-output'])
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