<div dir="ltr"><div dir="ltr">Hey Andrew, <div>theres definitely optimizations in ghc that (roughly? i'm not the best expert) unwrap / optimize away single constructor data types in certain cases (haha, cases), </div><div><br></div><div>I forget the name of the specific optimization, but its a pretty well documented one in ghc </div><div><br></div><div>I think its the CPR analysis? I could be wrong <a href="https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/Demand">https://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/Demand</a> (i could be wrong though)</div><div><br></div><div>either way, i seem to recall you'll be at ICFP next week, so thats def a venue i or someone else can help you sleuth it at</div></div></div><br><div class="gmail_quote"><div dir="ltr">On Thu, Sep 20, 2018 at 8:50 AM Andrew Martin <<a href="mailto:andrew.thaddeus@gmail.com">andrew.thaddeus@gmail.com</a>> wrote:<br></div><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex"><div dir="ltr"><div dir="ltr"><div dir="ltr"><div dir="ltr"><div dir="ltr">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:<div><br></div><div><div> module Lifted where</div><div><br></div><div> import <a href="http://Control.Monad.ST" target="_blank">Control.Monad.ST</a> (runST)</div><div> import Control.Monad.Primitive (touch)</div><div> import Data.Int (Int64)</div><div> import Data.Primitive (newPinnedByteArray,mutableByteArrayContents,readOffAddr,writeOffAddr)</div><div><br></div><div> computation :: Int64</div><div> computation = runST $ do</div><div> arr <- newPinnedByteArray 8</div><div> let addr = mutableByteArrayContents arr</div><div> writeOffAddr addr 0 (42 :: Int64)</div><div> i <- readOffAddr addr 0</div><div> touch arr</div><div> return i</div><div><br></div><div>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):</div><div><br></div><div><div> -- RHS size: {terms: 32, types: 67, coercions: 19, joins: 0/1}</div><div> computation1</div><div> computation1</div><div> = \ s1_a24R -></div><div> case newPinnedByteArray# 8# (s1_a24R `cast` <Co:4>) of</div><div> { (# ipv_a246, ipv1_a247 #) -></div><div> let {</div><div> addr_s273</div><div> addr_s273 = byteArrayContents# (ipv1_a247 `cast` <Co:9>) } in</div><div> case writeInt64OffAddr# addr_s273 0# 42# ipv_a246 of s'#_a24p</div><div> { __DEFAULT -></div><div> case readInt64OffAddr# addr_s273 0# s'#_a24p of</div><div> { (# ipv2_a267, ipv3_a268 #) -></div><div> case touch#</div><div> ((MutableByteArray ipv1_a247) `cast` <Co:3>)</div><div> (ipv2_a267 `cast` <Co:3>)</div><div> of s'_a24K</div><div> { __DEFAULT -></div><div> (# s'_a24K, I64# ipv3_a268 #)</div><div> }</div><div> }</div><div> }</div><div> }</div><div><br></div><div> -- RHS size: {terms: 5, types: 30, coercions: 0, joins: 0/0}</div><div> computation</div><div> computation</div><div> = case runRW# computation1 of { (# ipv_a239, ipv1_a23a #) -></div><div> ipv1_a23a</div><div> }</div></div><div><br></div><div>Instead, what if we touched the underlying unlifted MutableByteArray#? Here is the code for doing this:</div><div><br></div><div><div> {-# language MagicHash #-}</div><div> {-# language UnboxedTuples #-}</div><div><br></div><div> module Unlifted</div><div> ( computation</div><div> ) where</div><div><br></div><div> import System.IO.Unsafe (unsafeDupablePerformIO)</div><div> import Control.Monad.Primitive (unsafePrimToPrim,primitive,PrimState,PrimMonad)</div><div> import Data.Int (Int64)</div><div> import Data.Primitive (MutableByteArray(..),newPinnedByteArray,mutableByteArrayContents,readOffAddr,writeOffAddr)</div><div> import GHC.Exts (touch#,MutableByteArray#)</div><div><br></div><div> computation :: Int64</div><div> computation = unsafeDupablePerformIO $ do</div><div> arr@(MutableByteArray arr#) <- newPinnedByteArray 8</div><div> let addr = mutableByteArrayContents arr</div><div> writeOffAddr addr 0 (42 :: Int64)</div><div> i <- readOffAddr addr 0</div><div> touchUnlifted arr#</div><div> return i</div><div><br></div><div> touchUnlifted :: PrimMonad m => MutableByteArray# (PrimState m) -> m ()</div><div> touchUnlifted x = unsafePrimToPrim</div><div> $ (primitive (\s -> case touch# x s of { s' -> (# s', () #) }) :: IO ())</div></div><div><br></div><div>GHC generates the following core for this module (again, omitting irrelevant parts):</div><div><br></div><div><div> computation1</div><div> computation1</div><div> = \ s_a49h -></div><div> case newPinnedByteArray# 8# (s_a49h `cast` <Co:3>) of</div><div> { (# ipv_a48a, ipv1_a48b #) -></div><div> let {</div><div> addr_s4aY</div><div> addr_s4aY = byteArrayContents# (ipv1_a48b `cast` <Co:8>) } in</div><div> case writeInt64OffAddr# addr_s4aY 0# 42# ipv_a48a of s'#_a48A</div><div> { __DEFAULT -></div><div> case readInt64OffAddr# addr_s4aY 0# s'#_a48A of</div><div> { (# ipv2_a4aq, ipv3_a4ar #) -></div><div> case touch# ipv1_a48b (ipv2_a4aq `cast` <Co:2>) of s'_a2xn</div><div> { __DEFAULT -></div><div> (# s'_a2xn, I64# ipv3_a4ar #)</div><div> }</div><div> }</div><div> }</div><div> }</div><div><br></div><div> -- RHS size: {terms: 5, types: 30, coercions: 0, joins: 0/0}</div><div> computation</div><div> computation</div><div> = case runRW# computation1 of { (# ipv_a47X, ipv1_a47Y #) -></div><div> ipv1_a47Y</div><div> }</div></div><div><br></div><div>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?</div><div><br></div>-- <br><div dir="ltr" class="m_-31848361455229494gmail_signature">-Andrew Thaddeus Martin</div></div></div></div></div></div></div>
_______________________________________________<br>
Libraries mailing list<br>
<a href="mailto:Libraries@haskell.org" target="_blank">Libraries@haskell.org</a><br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-bin/mailman/listinfo/libraries</a><br>
</blockquote></div>