Why is an irrefutable pattern desugared to a 'cast', while an incomplete pattern is not?

Christiaan Baaij christiaan.baaij at gmail.com
Fri May 9 14:29:09 UTC 2014


Dear list,

When I ask for the desugaring of:
> module PatError where
> 
> paterror :: Maybe Int -> Int
> paterror (Just i) = i

I get the following:
> PatError.paterror =
>   \ (ds_dIS :: Data.Maybe.Maybe GHC.Types.Int) ->
>     break<1>()
>     case ds_dIS of _ [Occ=Dead] {
>       __DEFAULT ->
>         (\ _ [Occ=Dead, OS=OneShot] ->
>            Control.Exception.Base.patError
>              @ GHC.Types.Int "PatError.hs:4:1-21|function paterror"#)
>           GHC.Prim.void#;
>       Data.Maybe.Just i_aqG -> break<0>(i_aqG) i_aqG
>     }

Where 'Control.Exception.Base.patError' is applied to 'Int'.

However, when I compile the almost identical code with an irrefutable pattern:
> module PatError2 where
> 
> patError :: Maybe Int -> Int
> patError ~(Just i) = i

I get the following core:
> PatError2.paterror =
>   \ (ds_dIT :: Data.Maybe.Maybe GHC.Types.Int) ->
>     break<1>()
>     let {
>       i_aqG :: GHC.Types.Int
>       [LclId, Str=DmdType]
>       i_aqG =
>         case ds_dIT of _ [Occ=Dead] {
>           __DEFAULT ->
>             (\ _ [Occ=Dead, OS=OneShot] ->
>                (Control.Exception.Base.irrefutPatError
>                   @ () "PatError2.hs:4:1-22|(Data.Maybe.Just i)"#)
>                `cast` (UnivCo representational () GHC.Types.Int
>                        :: () ~# GHC.Types.Int))
>               GHC.Prim.void#;
>           Data.Maybe.Just i_aqG -> i_aqG
>         } } in
>     break<0>(i_aqG) i_aqG

Where 'Control.Exception.Base.patError' is first applied to '()' after which it is casted to 'GHC.Types.Int'.
Out of the [note] for the 'UnivCo' coercion:
> The UnivCo ("universal coercion") serves two rather separate functions:
>  - the implementation for unsafeCoerce#
>  - placeholder for phantom parameters in a TyConAppCo

It seems to be used in the 'unsafeCoerce#' role here.
My question is: why can't the irrefutable pattern be translated to 'Control.Exception.Base.irrefutPatError' applied to 'Int'?
Instead of using this 'cast'?
I find the cast-less version much more readable.

Greetings,

Christiaan



More information about the ghc-devs mailing list