Pattern synonym matcher is unnecessarily strict on unboxed continuations

As discovered while investigating #9732 (closed), if you have something like

{-# LANGUAGE PatternSynonyms, MagicHash #-}
import GHC.Base

pattern P = True

f :: Bool -> Int#
f P = 42#

f is compiled into

Main.f :: GHC.Types.Bool -> GHC.Prim.Int#
[LclIdX, Str=DmdType]
Main.f =
  letrec {
    f_apU :: GHC.Types.Bool -> GHC.Prim.Int#
    [LclId, Str=DmdType]
    f_apU =
      \ (ds_dq1 :: GHC.Types.Bool) ->
        break<2>()
        let {
          fail_dq2 :: GHC.Prim.Void# -> GHC.Prim.Int#
          [LclId, Str=DmdType]
          fail_dq2 =
            \ (ds_dq3 [OS=OneShot] :: GHC.Prim.Void#) ->
              Control.Exception.Base.patError
                @ GHC.Prim.Int# "unboxed.hs:7:1-9|function f"# } in
        case fail_dq2 GHC.Prim.void# of wild_00 { __DEFAULT ->
        (case break<1>() 42 of wild_00 { __DEFAULT ->
         Main.$mP @ GHC.Prim.Int# ds_dq1 wild_00
         })
          wild_00
        }; } in
  f_apU

Note how fail_dq2 is applied on void# before the pattern match, meaning the following expression:

I# (f True)

will fail with

*** Exception: unboxed.hs:7:1-9: Non-exhaustive patterns in function f

This is because the the type of P's matcher, instantiated for its use in f, is

$mP :: Bool -> Int# -> Int# -> Int#

so of course it is strict both on the success and the failure continuation.

Trac metadata

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