prim-array 0.2 → 0.2.1

raw patch · 2 files changed

+119/−2 lines, 2 files

Files

• prim-array.cabal +1/−1
• src/Data/Primitive/PrimArray.hs +118/−1

@@ -1,5 +1,5 @@ name: prim-array-version: 0.2+version: 0.2.1 synopsis: Primitive byte array with type variable homepage: https://github.com/andrewthad/prim-array#readme license: BSD3

@@ -3,6 +3,7 @@ {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}  {-# OPTIONS_GHC -Wall #-} @@ -12,6 +13,8 @@   , MutablePrimArray(..)     -- * Allocation   , newPrimArray+  , emptyPrimArray+  , singletonPrimArray     -- * Element Access   , readPrimArray   , writePrimArray@@ -22,17 +25,24 @@     -- * Block Operations   , copyPrimArray   , copyMutablePrimArray+  , copyPrimArrayToPtr+  , copyPtrToMutablePrimArray+  , copyPtrToPrimArray   , setPrimArray     -- * Information   , sameMutablePrimArray   , getSizeofMutablePrimArray+  , sizeofPrimArray   ) where  import GHC.Prim-import GHC.Exts (isTrue#)+import GHC.Exts (isTrue#,IsList(..)) import GHC.Int+import GHC.Ptr import Data.Primitive import Control.Monad.Primitive+import Control.Monad.ST+import qualified Data.List as L import qualified Data.Primitive.Types as PT  -- | Primitive arrays@@ -41,6 +51,70 @@ -- | Mutable primitive arrays associated with a primitive state token data MutablePrimArray s a = MutablePrimArray (MutableByteArray# s) +instance (Eq a, Prim a) => Eq (PrimArray a) where+  a1 == a2 = sizeofPrimArray a1 == sizeofPrimArray a2 && loop (sizeofPrimArray a1 - 1)+    where +    loop !i | i < 0 = True+            | otherwise = indexPrimArray a1 i == indexPrimArray a2 i && loop (i-1)++instance Prim a => IsList (PrimArray a) where+  type Item (PrimArray a) = a+  fromList xs = primArrayFromList (L.length xs) xs+  fromListN = primArrayFromList+  toList = primArrayToList++instance (Prim a, Show a) => Show (PrimArray a) where+  showsPrec p = showsPrec p . primArrayToList++primArrayFromList :: forall a. Prim a => Int -> [a] -> PrimArray a+primArrayFromList len vs = runST run where+  run :: forall s. ST s (PrimArray a)+  run = do+    arr <- newPrimArray len+    let go :: [a] -> Int -> ST s ()+        go !xs !ix = case xs of+          [] -> return ()+          a : as -> do+            writePrimArray arr ix a+            go as (ix + 1)+    go vs 0+    unsafeFreezePrimArray arr++primArrayToList :: forall a. Prim a => PrimArray a -> [a]+primArrayToList arr = go 0 where+  !len = sizeofPrimArray arr+  go :: Int -> [a]+  go !ix = if ix < len+    then indexPrimArray arr ix : go (ix + 1)+    else []+++-- It is actually possible to write this without the Prim constraint+-- on the type variable a. You just copy the byte arrays using+-- more primitive operations.+instance Prim a => Monoid (PrimArray a) where+  mempty = emptyPrimArray+  mappend a b = runST $ do+    let szA = sizeofPrimArray a+    let szB = sizeofPrimArray b+    c <- newPrimArray (szA + szB)+    copyPrimArray c 0 a 0 szA+    copyPrimArray c szA b 0 szB+    unsafeFreezePrimArray c++emptyPrimArray :: PrimArray a+{-# NOINLINE emptyPrimArray #-}+emptyPrimArray = runST $ primitive $ \s0# -> case newByteArray# 0# s0# of+  (# s1#, arr# #) -> case unsafeFreezeByteArray# arr# s1# of+    (# s2#, arr'# #) -> (# s2#, PrimArray arr'# #)++singletonPrimArray :: Prim a => a -> PrimArray a+singletonPrimArray a = runST $ do+  arr <- newPrimArray 1+  writePrimArray arr 0 a+  unsafeFreezePrimArray arr++ newPrimArray :: forall m a. (PrimMonad m, Prim a) => Int -> m (MutablePrimArray (PrimState m) a) {-# INLINE newPrimArray #-} newPrimArray (I# n#)@@ -104,6 +178,44 @@       (n# *# (sizeOf# (undefined :: a)))     ) +-- | Copy a slice of an immutable primitive array to an address.+-- The offset and length are given in elements of type @a@.+copyPrimArrayToPtr :: forall m a. (PrimMonad m, Prim a)+  => Ptr a                            -- ^ destination pointer+  -> PrimArray a                      -- ^ source array+  -> Int                              -- ^ offset into source array+  -> Int                              -- ^ number of prims to copy+  -> m ()+{-# INLINE copyPrimArrayToPtr #-}+copyPrimArrayToPtr (Ptr addr#) (PrimArray ba#) (I# soff#) (I# n#) =+    primitive (\ s# ->+        let s'# = copyByteArrayToAddr# ba# (soff# *# siz#) addr# (n# *# siz#) s#+        in (# s'#, () #))+  where siz# = sizeOf# (undefined :: a)++copyPtrToMutablePrimArray :: forall m a. (PrimMonad m, Prim a)+  => MutablePrimArray (PrimState m) a+  -> Int+  -> Ptr a+  -> Int+  -> m ()+{-# INLINE copyPtrToMutablePrimArray #-}+copyPtrToMutablePrimArray (MutablePrimArray ba#) (I# doff#) (Ptr addr#) (I# n#) = +  primitive (\ s# ->+      let s'# = copyAddrToByteArray# addr# ba# (doff# *# siz#) (n# *# siz#) s#+      in (# s'#, () #))+  where siz# = sizeOf# (undefined :: a)++copyPtrToPrimArray :: forall a. Prim a+  => Ptr a+  -> Int+  -> PrimArray a+{-# INLINE copyPtrToPrimArray #-}+copyPtrToPrimArray ptr len = runST $ do+  arr <- newPrimArray len+  copyPtrToMutablePrimArray arr 0 ptr len+  unsafeFreezePrimArray arr+ -- | Fill a slice of a mutable byte array with a value. setPrimArray   :: (Prim a, PrimMonad m)@@ -154,3 +266,8 @@ indexPrimArray :: forall a. Prim a => PrimArray a -> Int -> a {-# INLINE indexPrimArray #-} indexPrimArray (PrimArray arr#) (I# i#) = indexByteArray# arr# i#++sizeofPrimArray :: forall a. Prim a => PrimArray a -> Int+{-# INLINE sizeofPrimArray #-}+sizeofPrimArray (PrimArray arr#) = I# (quotInt# (sizeofByteArray# arr#) (sizeOf# (undefined :: a)))+