GitLab

Consider this

x = reverse "hello"

y = x `seq` Just True

f p = y `seq` (p, y)

You'd expect that we'd end up iwth

f = \p -> case y of DEFAULT -> (p, y)

or just possibly

f = \p -> case x of DEFAULT -> (p, y)

But we don't. We get

Foo3.f
  = \ (@ a_a13D) (p_a13b [Occ=Once] :: a_a13D) ->
      case Foo3.x of { __DEFAULT ->
      (p_a13b, Just @ Bool True)
      }

Yikes. Look at that completely-wasted Just True allocation, which will happen in every call to f.

There's nothing special about the top level here; this could happen for nested bindings too.

The culprit is this code in Simplify:

rebuildCase env scrut case_bndr alts cont
  | Just (wfloats, con, ty_args, other_args) <- exprIsConApp_maybe (getUnfoldingInRuleMatch env) scrut
  = do  { case findAlt (DataAlt con) alts of
            Nothing  -> missingAlt env case_bndr alts cont
            Just (DEFAULT, bs, rhs) -> let con_app = Var (dataConWorkId con)
                                                 `mkTyApps` ty_args
                                                 `mkApps`   other_args
                                       in simple_rhs wfloats con_app bs rhs
            Just (_, bs, rhs)       -> knownCon env scrut wfloats con ty_args other_args
                                                case_bndr bs rhs cont
        }

If we try to simplify

  case y of y' { DEFAULT -> (p, y') }

then exprIsConApp_maybe succeeds (with a floated case on x), effectively inlining y bodily, and we transform to

  case x of DEFAULT -> let y' = Just True in blah

Sigh. If making exprIsConApp_maybe to fire requires duplicating an allocation (here by inlining y), then perhaps we only want this rebuildCase transformation to fire if the case-binder y' is dead.

What happens in the knownCon case?

f = \p -> case y of y'
            Just t  -> (y',p)
            Nothing -> (p,p)

Here we correctly inline y, cancel the Just and end up with

f = \p -> case x of DEFAUT ->
          let y' = y in Just p

Where did that y' = y binding come from? Ah... the clever bind_case_bndr in knownCon. We should do something like this in the default case too.

Trac metadata

Trac field	Value
Version	8.6.3
Type	Bug
TypeOfFailure	OtherFailure
Priority	normal
Resolution	Unresolved
Component	Compiler
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture