Levity monomorphic instantiation of unsafeCoerce# is rejected as being levity polymorphic in 9.0+
While experimenting with unsafeCoerce#
recently, I tried the following:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE TypeApplications #-}
module Bug where
import GHC.Exts
import Unsafe.Coerce
f :: Int -> Int
f x = unsafeCoerce# @LiftedRep @LiftedRep @Int @Int x
Surprisingly, GHC 9.0 and later reject this:
$ /opt/ghc/9.0.1/bin/ghc Bug.hs
[1 of 1] Compiling Bug ( Bug.hs, Bug.o )
Bug.hs:10:7: error:
Cannot use function with levity-polymorphic arguments:
unsafeCoerce# :: forall (q :: RuntimeRep) (r :: RuntimeRep)
(a :: TYPE q) (b :: TYPE r).
a -> b
(Note that levity-polymorphic primops such as 'coerce' and unboxed tuples
are eta-expanded internally because they must occur fully saturated.
Use -fprint-typechecker-elaboration to display the full expression.)
Levity-polymorphic arguments: a :: TYPE q
|
10 | f x = unsafeCoerce# @LiftedRep @LiftedRep @Int @Int x
| ^^^^^^^^^^^^^
The error message confuses me, since nothing about this is levity polymorphic.
Note that this only occurs if visible type applications are used. If I remove them:
f :: Int -> Int
f x = unsafeCoerce# x
Then GHC accepts it.