Levity polymorphic expressions mustn't be floated out

I have been trying to add the following code into GHC:

{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
pattern AppOp1  :: PrimOp -> Arg CoreBndr -> CoreExpr
pattern OpVal   :: PrimOp -> Arg CoreBndr

pattern AppOp1  op x   =  App (OpVal op) x
pattern OpVal   op     <- Var (isPrimOpId_maybe -> Just op) where
   OpVal op = Var (mkPrimOpId op)

It triggers the following CoreLint error:

<no location info>: warning:
    [RHS of lvl_spfb :: r]
    RuntimeRep-polymorphic binder: lvl_spfb :: (r :: TYPE rep)

Indeed:

$mAppOp1
  :: forall (r :: TYPE rep).
     CoreExpr -> (PrimOp -> Arg CoreBndr -> r) -> (Void# -> r) -> r
[LclIdX, Arity=3]
$mAppOp1 =
  \ (@ (rep_agRe :: RuntimeRep))
    (@ (r_agRf :: TYPE rep))
    (scrut_agRh :: CoreExpr)
    (cont_agRi :: PrimOp -> Arg CoreBndr -> r)
    (fail_agRj :: Void# -> r) ->
    let {
      fail_spbW :: Void# -> r
      [LclId, Arity=1]
      fail_spbW = \ _ [Occ=Dead, OS=OneShot] -> fail_agRj void# } in
    let {
      lvl_spfb :: r
      [LclId]
      lvl_spfb = fail_spbW void# } in
    case scrut_agRh of {
      __DEFAULT -> fail_spbW void#;
      App ds_dj2u x_afoV ->
        $mOpVal
          @ rep
          @ r
          ds_dj2u
          (\ (op_afoU :: PrimOp) -> cont_agRi op_afoU x_afoV)
          (\ _ [Occ=Dead] -> lvl_spfb)

According to the levity polymorphism paper lvl_spfb shouldn't have been floated out in a let-binding.

Trac metadata

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