Touching unlifted values

20 Sep 2018

      The touch# primitive accepts a levity-polymorphic argument. I am wondering
if there is ever any difference between using it on a lifted value and an
unlifted value. Consider the following:

    module Lifted where

    import Control.Monad.ST (runST)
    import Control.Monad.Primitive (touch)
    import Data.Int (Int64)
    import Data.Primitive
(newPinnedByteArray,mutableByteArrayContents,readOffAddr,writeOffAddr)

    computation :: Int64
    computation = runST $ do
      arr <- newPinnedByteArray 8
      let addr = mutableByteArrayContents arr
      writeOffAddr addr 0 (42 :: Int64)
      i <- readOffAddr addr 0
      touch arr
      return i

Calling touch on the mutable byte array is necessary to make sure that the
memory that the Addr points doesn't get GCed while we are writing and
reading to and from it. Here is the relevant GHC core (compiled with -O2):

    -- RHS size: {terms: 32, types: 67, coercions: 19, joins: 0/1}
    computation1
    computation1
      = \ s1_a24R ->
          case newPinnedByteArray# 8# (s1_a24R `cast` Co:4) of
          { (# ipv_a246, ipv1_a247 #) ->
          let {
            addr_s273
            addr_s273 = byteArrayContents# (ipv1_a247 `cast` Co:9) } in
          case writeInt64OffAddr# addr_s273 0# 42# ipv_a246 of s'#_a24p
          { __DEFAULT ->
          case readInt64OffAddr# addr_s273 0# s'#_a24p of
          { (# ipv2_a267, ipv3_a268 #) ->
          case touch#
                 ((MutableByteArray ipv1_a247) `cast` Co:3)
                 (ipv2_a267 `cast` Co:3)
          of s'_a24K
          { __DEFAULT ->
          (# s'_a24K, I64# ipv3_a268 #)
          }
          }
          }
          }

    -- RHS size: {terms: 5, types: 30, coercions: 0, joins: 0/0}
    computation
    computation
      = case runRW# computation1 of { (# ipv_a239, ipv1_a23a #) ->
        ipv1_a23a
        }

Instead, what if we touched the underlying unlifted MutableByteArray#? Here
is the code for doing this:

    {-# language MagicHash #-}
    {-# language UnboxedTuples #-}

    module Unlifted
      ( computation
      ) where

    import System.IO.Unsafe (unsafeDupablePerformIO)
    import Control.Monad.Primitive
(unsafePrimToPrim,primitive,PrimState,PrimMonad)
    import Data.Int (Int64)
    import Data.Primitive
(MutableByteArray(..),newPinnedByteArray,mutableByteArrayContents,readOffAddr,writeOffAddr)
    import GHC.Exts (touch#,MutableByteArray#)

    computation :: Int64
    computation = unsafeDupablePerformIO $ do
      arr@(MutableByteArray arr#) <- newPinnedByteArray 8
      let addr = mutableByteArrayContents arr
      writeOffAddr addr 0 (42 :: Int64)
      i <- readOffAddr addr 0
      touchUnlifted arr#
      return i

    touchUnlifted :: PrimMonad m => MutableByteArray# (PrimState m) -> m ()
    touchUnlifted x = unsafePrimToPrim
      $ (primitive (\s -> case touch# x s of { s' -> (# s', () #) }) :: IO
())

GHC generates the following core for this module (again, omitting
irrelevant parts):

    computation1
    computation1
      = \ s_a49h ->
          case newPinnedByteArray# 8# (s_a49h `cast` Co:3) of
          { (# ipv_a48a, ipv1_a48b #) ->
          let {
            addr_s4aY
            addr_s4aY = byteArrayContents# (ipv1_a48b `cast` Co:8) } in
          case writeInt64OffAddr# addr_s4aY 0# 42# ipv_a48a of s'#_a48A
          { __DEFAULT ->
          case readInt64OffAddr# addr_s4aY 0# s'#_a48A of
          { (# ipv2_a4aq, ipv3_a4ar #) ->
          case touch# ipv1_a48b (ipv2_a4aq `cast` Co:2) of s'_a2xn
          { __DEFAULT ->
          (# s'_a2xn, I64# ipv3_a4ar #)
          }
          }
          }
          }

    -- RHS size: {terms: 5, types: 30, coercions: 0, joins: 0/0}
    computation
    computation
      = case runRW# computation1 of { (# ipv_a47X, ipv1_a47Y #) ->
        ipv1_a47Y
        }

I feel confident that both of these are semantically equivalent. Both uses
of touch# should keep the MutableByteArray# alive until we are done using
the pointer we extracted from it. What I'm less sure about is whether or
not the first one actually does an alloctation for the MutableByteArray
data constructor when it calls touch. Is this eliminated in some other
stage of compilation?

-- 
-Andrew Thaddeus Martin

Touching unlifted values

Andrew Martin