[GHC] #15532: Relaxing Levity-Polymorphic Binder Check for Lifted vs Unlifted pointers

[GHC]

#15532: Relaxing Levity-Polymorphic Binder Check for Lifted vs Unlifted pointers
-------------------------------------+-------------------------------------
        Reporter:  andrewthad        |                Owner:  (none)
            Type:  feature request   |               Status:  new
        Priority:  normal            |            Milestone:  8.6.1
       Component:  Compiler          |              Version:  8.4.3
      Resolution:                    |             Keywords:
                                     |  LevityPolymorphism
Operating System:  Unknown/Multiple  |         Architecture:
                                     |  Unknown/Multiple
 Type of failure:  None/Unknown      |            Test Case:
      Blocked By:                    |             Blocking:
 Related Tickets:  14917             |  Differential Rev(s):
       Wiki Page:                    |
-------------------------------------+-------------------------------------

Comment (by andrewthad):

 This example also works:

 {{{
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE MagicHash #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE UnboxedTuples #-}
 {-# LANGUAGE TypeInType #-}

 import Data.Primitive
 import Data.Primitive.UnliftedArray
 import GHC.Types
 import GHC.Exts

 main :: IO ()
 main = do
   a@(Array myArr) <- newArray 1 ("foo" :: String) >>= unsafeFreezeArray
   UnliftedArray myArrArr <- newUnliftedArray 1 a >>=
 unsafeFreezeUnliftedArray
   putStrLn (example even show (show . (+1)) (5 :: Integer))
   let r = exampleUnlifted
         (\x -> isTrue# (sizeofArrayArray# x ># 1#))
         (\x -> array# (indexUnliftedArray (UnliftedArray x) 1 :: Array
 String))
         (\x -> array# (indexUnliftedArray (UnliftedArray x) 0 :: Array
 String))
         myArrArr
       !(# e #) = indexArray# r 0#
   putStrLn e

 {-# NOINLINE example #-}
 example :: (a -> Bool) -> (a -> b) -> (a -> b) -> a -> b
 example p f g a = if p a then f a else g a

 exampleUnlifted :: forall (a :: TYPE 'UnliftedRep) (b :: TYPE
 'UnliftedRep).
   (a -> Bool) -> (a -> b) -> (a -> b) -> a -> b
 exampleUnlifted = unsafeCoerce# example
 }}}

-- 
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/15532#comment:3>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler