packages feed

primitive-unlifted (empty) → 0.1.0.0

raw patch · 7 files changed

+594/−0 lines, 7 filesdep +basedep +primitivedep +primitive-unliftedsetup-changed

Dependencies added: base, primitive, primitive-unlifted, stm

Files

+ CHANGELOG.md view
@@ -0,0 +1,9 @@+# Changelog+All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/)+and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/).++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2019, Andrew Martin++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Andrew Martin nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ primitive-unlifted.cabal view
@@ -0,0 +1,36 @@+cabal-version: 2.2+name: primitive-unlifted+version: 0.1.0.0+synopsis: Primitive GHC types with unlifted types inside+homepage: https://github.com/andrewthad/primitive-unlifted+bug-reports: https://github.com/andrewthad/primitive-unlifted/issues+license: BSD-3-Clause+license-file: LICENSE+author: Andrew Martin+maintainer: andrew.thaddeus@gmail.com+copyright: 2019 Andrew Martin+category: Data+extra-source-files: CHANGELOG.md++library+  exposed-modules:+    Data.Primitive.Unlifted.Class+    Data.Primitive.Unlifted.Array+  build-depends:+    , base >=4.11.1.0 && <5+    , primitive >= 0.7 && <0.8+  hs-source-dirs: src+  ghc-options: -Wall -O2+  default-language: Haskell2010++test-suite unit+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Unit.hs+  build-depends:+    , base+    , primitive-unlifted+    , primitive+    , stm+  ghc-options: -Wall -O2+  default-language: Haskell2010
+ src/Data/Primitive/Unlifted/Array.hs view
@@ -0,0 +1,418 @@+{-# language BangPatterns #-}+{-# language MagicHash #-}+{-# language RankNTypes #-}+{-# language ScopedTypeVariables #-}+{-# language TypeFamilies #-}+{-# language UnboxedTuples #-}++-- |+-- GHC contains three general classes of value types:+--+--   1. Unboxed types: values are machine values made up of fixed numbers of bytes+--   2. Unlifted types: values are pointers, but strictly evaluated+--   3. Lifted types: values are pointers, lazily evaluated+--+-- The first category can be stored in a 'ByteArray', and this allows types in+-- category 3 that are simple wrappers around category 1 types to be stored+-- more efficiently using a 'ByteArray'. This module provides the same facility+-- for category 2 types.+--+-- GHC has two primitive types, 'ArrayArray#' and 'MutableArrayArray#'. These+-- are arrays of pointers, but of category 2 values, so they are known to not+-- be bottom. This allows types that are wrappers around such types to be stored+-- in an array without an extra level of indirection.+--+-- The way that the 'ArrayArray#' API works is that one can read and write+-- 'ArrayArray#' values to the positions. This works because all category 2+-- types share a uniform representation, unlike unboxed values which are+-- represented by varying (by type) numbers of bytes. However, using the+-- this makes the internal API very unsafe to use, as one has to coerce values+-- to and from 'ArrayArray#'.+--+-- The API presented by this module is more type safe. 'UnliftedArray' and+-- 'MutableUnliftedArray' are parameterized by the type of arrays they contain, and+-- the coercions necessary are abstracted into a class, 'PrimUnlifted', of things+-- that are eligible to be stored.+module Data.Primitive.Unlifted.Array+  ( -- * Types+    UnliftedArray(..)+  , MutableUnliftedArray(..)+    -- * Operations+  , newUnliftedArray+  , unsafeNewUnliftedArray+  , sizeofUnliftedArray+  , sizeofMutableUnliftedArray+  , sameMutableUnliftedArray+  , writeUnliftedArray+  , readUnliftedArray+  , indexUnliftedArray+  , unsafeFreezeUnliftedArray+  , freezeUnliftedArray+  , thawUnliftedArray+  , setUnliftedArray+  , copyUnliftedArray+  , copyMutableUnliftedArray+  , cloneUnliftedArray+  , cloneMutableUnliftedArray+  , emptyUnliftedArray+  , runUnliftedArray+    -- * List Conversion+  , unliftedArrayToList+  , unliftedArrayFromList+  , unliftedArrayFromListN+    -- * Folding+  , foldrUnliftedArray+  , foldrUnliftedArray'+  , foldlUnliftedArray+  , foldlUnliftedArray'+    -- * Mapping+  , mapUnliftedArray+  ) where++import Control.Monad.Primitive (PrimMonad,PrimState,primitive,primitive_)+import Control.Monad.ST (ST)+import Data.Primitive.Unlifted.Class (PrimUnlifted)+import GHC.Exts (Int(I#),MutableArrayArray#,ArrayArray#,State#)++import qualified Data.List as L+import qualified Data.Primitive.Unlifted.Class as C+import qualified GHC.Exts as Exts+import qualified GHC.ST as ST++data MutableUnliftedArray s a+  = MutableUnliftedArray (MutableArrayArray# s)++data UnliftedArray a+  = UnliftedArray ArrayArray#++-- | Creates a new 'MutableUnliftedArray'. This function is unsafe because it+-- initializes all elements of the array as pointers to the array itself. Attempting+-- to read one of these elements before writing to it is in effect an unsafe+-- coercion from the @'MutableUnliftedArray' s a@ to the element type.+unsafeNewUnliftedArray+  :: (PrimMonad m)+  => Int -- ^ size+  -> m (MutableUnliftedArray (PrimState m) a)+{-# inline unsafeNewUnliftedArray #-}+unsafeNewUnliftedArray (I# i#) = primitive $ \s -> case Exts.newArrayArray# i# s of+  (# s', maa# #) -> (# s', MutableUnliftedArray maa# #)++-- | Creates a new 'MutableUnliftedArray' with the specified value as initial+-- contents. This is slower than 'unsafeNewUnliftedArray', but safer.+newUnliftedArray+  :: (PrimMonad m, PrimUnlifted a)+  => Int -- ^ size+  -> a -- ^ initial value+  -> m (MutableUnliftedArray (PrimState m) a)+newUnliftedArray len v = do+  mua <- unsafeNewUnliftedArray len+  setUnliftedArray mua v 0 len+  pure mua+{-# inline newUnliftedArray #-}++setUnliftedArray+  :: (PrimMonad m, PrimUnlifted a)+  => MutableUnliftedArray (PrimState m) a -- ^ destination+  -> a -- ^ value to fill with+  -> Int -- ^ offset+  -> Int -- ^ length+  -> m ()+{-# inline setUnliftedArray #-}+setUnliftedArray mua v off len = loop (len + off - 1)+ where+ loop i+   | i < off = pure ()+   | otherwise = writeUnliftedArray mua i v *> loop (i-1)++-- | Yields the length of an 'UnliftedArray'.+sizeofUnliftedArray :: UnliftedArray e -> Int+{-# inline sizeofUnliftedArray #-}+sizeofUnliftedArray (UnliftedArray aa#) = I# (Exts.sizeofArrayArray# aa#)++-- | Yields the length of a 'MutableUnliftedArray'.+sizeofMutableUnliftedArray :: MutableUnliftedArray s e -> Int+{-# inline sizeofMutableUnliftedArray #-}+sizeofMutableUnliftedArray (MutableUnliftedArray maa#)+  = I# (Exts.sizeofMutableArrayArray# maa#)++writeUnliftedArray :: (PrimMonad m, PrimUnlifted a)+  => MutableUnliftedArray (PrimState m) a+  -> Int+  -> a+  -> m ()+{-# inline writeUnliftedArray #-}+writeUnliftedArray (MutableUnliftedArray arr) (I# ix) a =+  primitive_ (C.writeUnliftedArray# arr ix a)++readUnliftedArray :: (PrimMonad m, PrimUnlifted a)+  => MutableUnliftedArray (PrimState m) a+  -> Int+  -> m a+{-# inline readUnliftedArray #-}+readUnliftedArray (MutableUnliftedArray arr) (I# ix) =+  primitive (C.readUnliftedArray# arr ix)++indexUnliftedArray :: PrimUnlifted a+  => UnliftedArray a+  -> Int+  -> a+{-# inline indexUnliftedArray #-}+indexUnliftedArray (UnliftedArray arr) (I# ix) =+  C.indexUnliftedArray# arr ix++-- | Freezes a 'MutableUnliftedArray', yielding an 'UnliftedArray'. This simply+-- marks the array as frozen in place, so it should only be used when no further+-- modifications to the mutable array will be performed.+unsafeFreezeUnliftedArray+  :: (PrimMonad m)+  => MutableUnliftedArray (PrimState m) a+  -> m (UnliftedArray a)+unsafeFreezeUnliftedArray (MutableUnliftedArray maa#)+  = primitive $ \s -> case Exts.unsafeFreezeArrayArray# maa# s of+      (# s', aa# #) -> (# s', UnliftedArray aa# #)+{-# inline unsafeFreezeUnliftedArray #-}++-- | Determines whether two 'MutableUnliftedArray' values are the same. This is+-- object/pointer identity, not based on the contents.+sameMutableUnliftedArray+  :: MutableUnliftedArray s a+  -> MutableUnliftedArray s a+  -> Bool+sameMutableUnliftedArray (MutableUnliftedArray maa1#) (MutableUnliftedArray maa2#)+  = Exts.isTrue# (Exts.sameMutableArrayArray# maa1# maa2#)+{-# inline sameMutableUnliftedArray #-}++-- | Copies the contents of an immutable array into a mutable array.+copyUnliftedArray+  :: (PrimMonad m)+  => MutableUnliftedArray (PrimState m) a -- ^ destination+  -> Int -- ^ offset into destination+  -> UnliftedArray a -- ^ source+  -> Int -- ^ offset into source+  -> Int -- ^ number of elements to copy+  -> m ()+{-# inline copyUnliftedArray #-}+copyUnliftedArray+  (MutableUnliftedArray dst) (I# doff)+  (UnliftedArray src) (I# soff) (I# ln) =+    primitive_ $ Exts.copyArrayArray# src soff dst doff ln+++-- | Copies the contents of one mutable array into another.+copyMutableUnliftedArray+  :: (PrimMonad m)+  => MutableUnliftedArray (PrimState m) a -- ^ destination+  -> Int -- ^ offset into destination+  -> MutableUnliftedArray (PrimState m) a -- ^ source+  -> Int -- ^ offset into source+  -> Int -- ^ number of elements to copy+  -> m ()+{-# inline copyMutableUnliftedArray #-}+copyMutableUnliftedArray+  (MutableUnliftedArray dst) (I# doff)+  (MutableUnliftedArray src) (I# soff) (I# ln) =+    primitive_ $ Exts.copyMutableArrayArray# src soff dst doff ln+++-- | Freezes a portion of a 'MutableUnliftedArray', yielding an 'UnliftedArray'.+-- This operation is safe, in that it copies the frozen portion, and the+-- existing mutable array may still be used afterward.+freezeUnliftedArray+  :: (PrimMonad m)+  => MutableUnliftedArray (PrimState m) a -- ^ source+  -> Int -- ^ offset+  -> Int -- ^ length+  -> m (UnliftedArray a)+freezeUnliftedArray src off len = do+  dst <- unsafeNewUnliftedArray len+  copyMutableUnliftedArray dst 0 src off len+  unsafeFreezeUnliftedArray dst+{-# inline freezeUnliftedArray #-}+++-- | Thaws a portion of an 'UnliftedArray', yielding a 'MutableUnliftedArray'.+-- This copies the thawed portion, so mutations will not affect the original+-- array.+thawUnliftedArray+  :: (PrimMonad m)+  => UnliftedArray a -- ^ source+  -> Int -- ^ offset+  -> Int -- ^ length+  -> m (MutableUnliftedArray (PrimState m) a)+{-# inline thawUnliftedArray #-}+thawUnliftedArray src off len = do+  dst <- unsafeNewUnliftedArray len+  copyUnliftedArray dst 0 src off len+  return dst++unsafeCreateUnliftedArray+  :: Int+  -> (forall s. MutableUnliftedArray s a -> ST s ())+  -> UnliftedArray a+unsafeCreateUnliftedArray !n f = runUnliftedArray $ do+  mary <- unsafeNewUnliftedArray n+  f mary+  pure mary++-- | Execute a stateful computation and freeze the resulting array.+runUnliftedArray+  :: (forall s. ST s (MutableUnliftedArray s a))+  -> UnliftedArray a+{-# INLINE runUnliftedArray #-}+runUnliftedArray m = UnliftedArray (runUnliftedArray# m)++runUnliftedArray#+  :: (forall s. ST s (MutableUnliftedArray s a))+  -> ArrayArray#+runUnliftedArray# m = case Exts.runRW# $ \s ->+  case unST m s of { (# s', MutableUnliftedArray mary# #) ->+  Exts.unsafeFreezeArrayArray# mary# s'} of (# _, ary# #) -> ary#++unST :: ST s a -> State# s -> (# State# s, a #)+unST (ST.ST f) = f++-- | Creates a copy of a portion of an 'UnliftedArray'+cloneUnliftedArray+  :: UnliftedArray a -- ^ source+  -> Int -- ^ offset+  -> Int -- ^ length+  -> UnliftedArray a+{-# inline cloneUnliftedArray #-}+cloneUnliftedArray src off len =+  runUnliftedArray (thawUnliftedArray src off len)++-- | Creates a new 'MutableUnliftedArray' containing a copy of a portion of+-- another mutable array.+cloneMutableUnliftedArray+  :: (PrimMonad m)+  => MutableUnliftedArray (PrimState m) a -- ^ source+  -> Int -- ^ offset+  -> Int -- ^ length+  -> m (MutableUnliftedArray (PrimState m) a)+{-# inline cloneMutableUnliftedArray #-}+cloneMutableUnliftedArray src off len = do+  dst <- unsafeNewUnliftedArray len+  copyMutableUnliftedArray dst 0 src off len+  return dst++emptyUnliftedArray :: UnliftedArray a+emptyUnliftedArray = runUnliftedArray (unsafeNewUnliftedArray 0)+{-# NOINLINE emptyUnliftedArray #-}+++concatUnliftedArray :: UnliftedArray a -> UnliftedArray a -> UnliftedArray a+{-# INLINE concatUnliftedArray #-}+concatUnliftedArray x y = unsafeCreateUnliftedArray (sizeofUnliftedArray x + sizeofUnliftedArray y) $ \m -> do+  copyUnliftedArray m 0 x 0 (sizeofUnliftedArray x)+  copyUnliftedArray m (sizeofUnliftedArray x) y 0 (sizeofUnliftedArray y)++foldrUnliftedArray :: forall a b. PrimUnlifted a => (a -> b -> b) -> b -> UnliftedArray a -> b+{-# INLINE foldrUnliftedArray #-}+foldrUnliftedArray f z arr = go 0+  where+    !sz = sizeofUnliftedArray arr+    go !i+      | sz > i = f (indexUnliftedArray arr i) (go (i+1))+      | otherwise = z++-- | Strict right-associated fold over the elements of an 'UnliftedArray.+{-# INLINE foldrUnliftedArray' #-}+foldrUnliftedArray' :: forall a b. PrimUnlifted a => (a -> b -> b) -> b -> UnliftedArray a -> b+foldrUnliftedArray' f z0 arr = go (sizeofUnliftedArray arr - 1) z0+  where+    go !i !acc+      | i < 0 = acc+      | otherwise = go (i - 1) (f (indexUnliftedArray arr i) acc)++-- | Lazy left-associated fold over the elements of an 'UnliftedArray'.+{-# INLINE foldlUnliftedArray #-}+foldlUnliftedArray :: forall a b. PrimUnlifted a => (b -> a -> b) -> b -> UnliftedArray a -> b+foldlUnliftedArray f z arr = go (sizeofUnliftedArray arr - 1)+  where+    go !i+      | i < 0 = z+      | otherwise = f (go (i - 1)) (indexUnliftedArray arr i)++-- | Strict left-associated fold over the elements of an 'UnliftedArray'.+{-# INLINE foldlUnliftedArray' #-}+foldlUnliftedArray' :: forall a b. PrimUnlifted a => (b -> a -> b) -> b -> UnliftedArray a -> b+foldlUnliftedArray' f z0 arr = go 0 z0+  where+    !sz = sizeofUnliftedArray arr+    go !i !acc+      | i < sz = go (i + 1) (f acc (indexUnliftedArray arr i))+      | otherwise = acc++-- | Map over the elements of an 'UnliftedArray'.+{-# INLINE mapUnliftedArray #-}+mapUnliftedArray :: (PrimUnlifted a, PrimUnlifted b)+  => (a -> b)+  -> UnliftedArray a+  -> UnliftedArray b+mapUnliftedArray f arr = unsafeCreateUnliftedArray sz $ \marr -> do+  let go !ix = if ix < sz+        then do+          let b = f (indexUnliftedArray arr ix)+          writeUnliftedArray marr ix b+          go (ix + 1)+        else return ()+  go 0+  where+  !sz = sizeofUnliftedArray arr++-- | Convert the unlifted array to a list.+{-# INLINE unliftedArrayToList #-}+unliftedArrayToList :: PrimUnlifted a => UnliftedArray a -> [a]+unliftedArrayToList xs = Exts.build (\c n -> foldrUnliftedArray c n xs)++unliftedArrayFromList :: PrimUnlifted a => [a] -> UnliftedArray a+unliftedArrayFromList xs = unliftedArrayFromListN (L.length xs) xs++unliftedArrayFromListN :: forall a. PrimUnlifted a => Int -> [a] -> UnliftedArray a+unliftedArrayFromListN len vs = unsafeCreateUnliftedArray len run where+  run :: forall s. MutableUnliftedArray s a -> ST s ()+  run arr = do+    let go :: [a] -> Int -> ST s ()+        go [] !ix = if ix == len+          -- The size check is mandatory since failure to initialize all elements+          -- introduces the possibility of a segfault happening when someone attempts+          -- to read the unitialized element. See the docs for unsafeNewUnliftedArray.+          then return ()+          else die "unliftedArrayFromListN" "list length less than specified size"+        go (a : as) !ix = if ix < len+          then do+            writeUnliftedArray arr ix a+            go as (ix + 1)+          else die "unliftedArrayFromListN" "list length greater than specified size"+    go vs 0++instance PrimUnlifted a => Exts.IsList (UnliftedArray a) where+  type Item (UnliftedArray a) = a+  fromList = unliftedArrayFromList+  fromListN = unliftedArrayFromListN+  toList = unliftedArrayToList++instance PrimUnlifted a => Semigroup (UnliftedArray a) where+  (<>) = concatUnliftedArray++instance PrimUnlifted a => Monoid (UnliftedArray a) where+  mempty = emptyUnliftedArray++instance (Show a, PrimUnlifted a) => Show (UnliftedArray a) where+  showsPrec p a = showParen (p > 10) $+    showString "fromListN " . shows (sizeofUnliftedArray a) . showString " "+      . shows (unliftedArrayToList a)++instance Eq (MutableUnliftedArray s a) where+  (==) = sameMutableUnliftedArray++instance (Eq a, PrimUnlifted a) => Eq (UnliftedArray a) where+  aa1 == aa2 = sizeofUnliftedArray aa1 == sizeofUnliftedArray aa2+            && loop (sizeofUnliftedArray aa1 - 1)+   where+   loop i+     | i < 0 = True+     | otherwise = indexUnliftedArray aa1 i == indexUnliftedArray aa2 i && loop (i-1)++die :: String -> String -> a+die fun problem = error $ "Data.Primitive.UnliftedArray." ++ fun ++ ": " ++ problem
+ src/Data/Primitive/Unlifted/Class.hs view
@@ -0,0 +1,67 @@+{-# language MagicHash #-}+{-# language UnboxedTuples #-}+{-# language TypeFamilies #-}++module Data.Primitive.Unlifted.Class+  ( PrimUnlifted(..)+  ) where++import Data.Primitive.ByteArray (ByteArray(..),MutableByteArray(..))+import GHC.Exts (State#,MutableByteArray#,ByteArray#,Int#)+import GHC.Exts (ArrayArray#,MutableArrayArray#,RuntimeRep(UnliftedRep))+import GHC.Exts (TYPE,unsafeCoerce#)++import qualified GHC.Exts as Exts++class PrimUnlifted a where+  type Unlifted a :: TYPE 'UnliftedRep+  toUnlifted# :: a -> Unlifted a+  fromUnlifted# :: Unlifted a -> a+  writeUnliftedArray# ::+       MutableArrayArray# s+    -> Int#+    -> a+    -> State# s+    -> State# s+  readUnliftedArray# ::+       MutableArrayArray# s+    -> Int#+    -> State# s+    -> (# State# s, a #)+  indexUnliftedArray# ::+       ArrayArray#+    -> Int#+    -> a++instance PrimUnlifted ByteArray where+  {-# inline writeUnliftedArray# #-}+  {-# inline readUnliftedArray# #-}+  {-# inline indexUnliftedArray# #-}+  type Unlifted ByteArray = ByteArray#+  toUnlifted# (ByteArray x) = x+  fromUnlifted# x = ByteArray x+  writeUnliftedArray# a i (ByteArray x) = Exts.writeByteArrayArray# a i x+  readUnliftedArray# a i s0 = case Exts.readByteArrayArray# a i s0 of+    (# s1, x #) -> (# s1, ByteArray x #)+  indexUnliftedArray# a i = ByteArray (Exts.indexByteArrayArray# a i)++instance PrimUnlifted (MutableByteArray s) where+  {-# inline writeUnliftedArray# #-}+  {-# inline readUnliftedArray# #-}+  {-# inline indexUnliftedArray# #-}+  type Unlifted (MutableByteArray s) = MutableByteArray# s+  toUnlifted# (MutableByteArray x) = x+  fromUnlifted# x = MutableByteArray x+  writeUnliftedArray# a i (MutableByteArray x) =+    Exts.writeMutableByteArrayArray# a i (retoken x)+  readUnliftedArray# a i s0 = case Exts.readMutableByteArrayArray# a i s0 of+    (# s1, x #) -> (# s1, MutableByteArray (retoken x) #)+  indexUnliftedArray# a i = MutableByteArray (baToMba (Exts.indexByteArrayArray# a i))++baToMba :: ByteArray# -> MutableByteArray# s+{-# inline baToMba #-}+baToMba = unsafeCoerce#++retoken :: MutableByteArray# s -> MutableByteArray# r+{-# inline retoken #-}+retoken = unsafeCoerce#
+ test/Unit.hs view
@@ -0,0 +1,32 @@+{-# language BangPatterns #-}++import Data.Primitive.Unlifted.TVar+import Data.Primitive+import Control.Monad.STM++main :: IO ()+main = do+  putStrLn "Start"+  putStrLn "A"+  testA+  putStrLn "B"+  testB+  putStrLn "Finished"++testA :: IO ()+testA = do+  tv <- newUnliftedTVarIO =<< newByteArray 16+  marr <- newByteArray 8+  !r <- atomically $ do+    writeUnliftedTVar tv marr+    !s <- readUnliftedTVar tv+    pure s+  if sameMutableByteArray marr r+    then pure ()+    else fail ""++testB :: IO ()+testB = do+  tv <- newUnliftedTVarIO =<< newByteArray 16+  !_ <- readUnliftedTVarIO tv+  pure ()