packages feed

smallarray (empty) → 0.1.0

raw patch · 7 files changed

+635/−0 lines, 7 filesdep +basedep +deepseqsetup-changed

Dependencies added: base, deepseq

Files

+ Data/ByteArray.hs view
@@ -0,0 +1,241 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash, UnboxedTuples #-}++#ifndef TESTING_FFI+#if defined(__GLASGOW_HASKELL__)+#define USING_GHC+#endif+#endif++{-|++This is not a safe data structure - you can do very bad things, and array bounds are+not checked in any of these functions.++You can also create non-referentialy transparent structures quite easily.+So don't.++In summary: This is a portable, low-level type for building higher-level, safe types.++When compiling with GHC, the ByteArray type is a wrapper around GHC.Prim.ByteArray#.+Otherwise it's a thin wrapper arounf the FFI ForeignPtr.++You get the benifit of using the fastest unboxed primitive on your platform without+worrying about the details.++-}++module Data.ByteArray+    ( ByteArray+    , MutableByteArray+    , new+    , newPinned+    , length+    , lengthM+    , Elt(..)+    , unsafeFreeze+    , asPtr+    ) where+++#if defined(USING_GHC)+-- for GHC we use GHC.Prim byte arrays+import GHC.Exts+#if __GLASGOW_HASKELL__ > 610+import GHC.IO (IO(..))+#else+import GHC.IOBase (IO(..))+#endif+import GHC.ST (ST(..))++import GHC.Int (Int8(..), Int16(..), Int32(..), Int64(..))+import GHC.Word (Word8(..), Word16(..), Word32(..), Word64(..))++#include "MachDeps.h"++#else+import Foreign hiding (new)+#endif++import Prelude hiding (length)+import Control.Monad.ST+import Control.DeepSeq++#if defined(USING_GHC)+-- in GHC prior to 7, the built-in length primitive on ByteArrays would+-- round up to the nearest 4-byte word. After it returns the amount request+-- during allocation, which is what we want.+-- Prior to GHC 7 we carry around a length.+#if __GLASGOW_HASKELL__ > 612+#ifndef TESTING_LENGTH+#define HAS_LENGTH+#endif+#endif++#ifdef HAS_LENGTH+data ByteArray = ByteArray {unArray :: !ByteArray# }+data MutableByteArray s = MutableByteArray {unMArray :: !(MutableByteArray# s)}+#else+data ByteArray = ByteArray {unArray :: !ByteArray#, length :: {-# UNPACK #-}!Int }+data MutableByteArray s = MutableByteArray {unMArray :: !(MutableByteArray# s), lengthM :: {-# UNPACK #-}!Int}+#endif++#else+-- fallback to FFI foreign pointers+data ByteArray = ByteArray {-# UNPACK #-} !(ForeignPtr Word8) {-# UNPACK #-} !Int+data MutableByteArray s = MutableByteArray {-# UNPACK #-} !(ForeignPtr Word8) {-# UNPACK #-} !Int+#endif++instance NFData ByteArray where+instance NFData (MutableByteArray s) where++-- | Allocate a new array. The size is specified in bytes.+new :: Int -> ST s (MutableByteArray s)+{-# INLINE new #-}++-- | Allocate a new array in a memory region which will not+-- be moved. The size is specified in bytes.+newPinned :: Int -> ST s (MutableByteArray s)+{-# INLINE newPinned #-}++-- | Convert a MutableByteArray to a ByteArray. You should+-- not modify the source array after calling this.+unsafeFreeze :: MutableByteArray s -> ST s ByteArray+{-# INLINE unsafeFreeze #-}++length :: ByteArray -> Int+lengthM :: MutableByteArray s -> Int+{-# INLINE length #-}+{-# INLINE lengthM #-}++class Elt a where+    -- | Read a primitve element from a mutable byte array.+    -- The index is positon, not bytes.+    read     :: MutableByteArray s -> Int -> ST s a++    -- | Write to a location in a mutable byte array.+    -- The index is position, not bytes.+    write    :: MutableByteArray s -> Int -> a -> ST s ()++    -- | Read from a location in a byte array.+    -- The index is position, not bytes.+    index    :: ByteArray -> Int -> a++    -- | The size of an element in bytes.+    elemSize :: a -> Int++-- | Only for use with pinned arrays.+asPtr :: ByteArray -> (Ptr a -> IO b) -> IO b++#if defined(USING_GHC)++#ifdef HAS_LENGTH+new (I# n#)+    = ST $ \s -> case newByteArray# n# s of+                   (# s', ary #) -> (# s', MutableByteArray ary #)+newPinned (I# n#)+    = ST $ \s -> case newPinnedByteArray# n# s of+                   (# s', ary #) -> (# s', MutableByteArray ary #)++unsafeFreeze (MutableByteArray mary)+    = ST $ \s -> case unsafeFreezeByteArray# mary s of+                   (# s', ary #) -> (# s', ByteArray ary #)++length (ByteArray ary) = I# (sizeofByteArray# ary)+lengthM (MutableByteArray mary) = I# (sizeofMutableByteArray# mary)++#else+new n@(I# n#)+    = ST $ \s -> case newByteArray# n# s of+                   (# s', ary #) -> (# s', MutableByteArray ary n #)+newPinned n@(I# n#)+    = ST $ \s -> case newPinnedByteArray# n# s of+                   (# s', ary #) -> (# s', MutableByteArray ary n #)++unsafeFreeze (MutableByteArray mary n)+    = ST $ \s -> case unsafeFreezeByteArray# mary s of+                   (# s', ary #) -> (# s', ByteArray ary n #)+#endif++asPtr a k+    = case byteArrayContents# (unArray a) of+        addr# -> do+          x <- k $ Ptr addr#+          touch a+          return x++touch :: a -> IO ()+touch x = IO $ \s-> case touch# x s of s' -> (# s', () #)++#define deriveElt(Typ, Ct, rd, wrt, ix, sz) \+instance Elt Typ where { \+    read ary (I# n) = ST (\s -> case rd (unMArray ary) n s of \+                                   {(# s', b #) -> (# s', Ct b #)}) \+;   {-# INLINE read #-} \+;   write ary (I# n) (Ct b) = ST (\s -> (# wrt (unMArray ary) n b s, () #)) \+;   {-# INLINE write #-} \+;   index ary (I# n) = Ct (ix (unArray ary) n) \+;   {-# INLINE index #-} \+;   elemSize _ = sz \+;   {-# INLINE elemSize #-} \+}+++deriveElt(Word, W#, readWordArray#, writeWordArray#, indexWordArray#, SIZEOF_HSWORD)+deriveElt(Word8, W8#, readWord8Array#, writeWord8Array#, indexWord8Array#, SIZEOF_WORD8)+deriveElt(Word16, W16#, readWord16Array#, writeWord16Array#, indexWord16Array#, SIZEOF_WORD16)+deriveElt(Word32, W32#, readWord32Array#, writeWord32Array#, indexWord32Array#, SIZEOF_WORD32)+deriveElt(Word64, W64#, readWord64Array#, writeWord64Array#, indexWord64Array#, SIZEOF_WORD64)+deriveElt(Int, I#, readIntArray#, writeIntArray#, indexIntArray#, SIZEOF_HSINT)+deriveElt(Int8, I8#, readInt8Array#, writeInt8Array#, indexInt8Array#, SIZEOF_INT8)+deriveElt(Int16, I16#, readInt16Array#, writeInt16Array#, indexInt16Array#, SIZEOF_INT16)+deriveElt(Int32, I32#, readInt32Array#, writeInt32Array#, indexInt32Array#, SIZEOF_INT32)+deriveElt(Int64, I64#, readInt64Array#, writeInt64Array#, indexInt64Array#, SIZEOF_INT64)+deriveElt(Float, F#, readFloatArray#, writeFloatArray#, indexFloatArray#, SIZEOF_HSFLOAT)+deriveElt(Double, D#, readDoubleArray#, writeDoubleArray#, indexDoubleArray#, SIZEOF_HSDOUBLE)+deriveElt(Char, C#, readWideCharArray#, writeWideCharArray#, indexWideCharArray#, SIZEOF_HSCHAR)++#else++withMArrayPtr :: MutableByteArray s -> (Ptr a -> IO b) -> IO b+withArrayPtr  :: ByteArray -> (Ptr a -> IO b) -> IO b++withMArrayPtr (MutableByteArray fptr _) k = withForeignPtr (castForeignPtr fptr) k+withArrayPtr (ByteArray fptr _) k = withForeignPtr (castForeignPtr fptr) k++new n = unsafeIOToST $ flip MutableByteArray n `fmap` mallocForeignPtrBytes n+newPinned = new -- FFI arrays already pinned++unsafeFreeze (MutableByteArray fptr n)+    = return . flip ByteArray n $ fptr++asPtr = withArrayPtr++length (ByteArray _ n) = n+lengthM (MutableByteArray _ n) = n++#define deriveElt(Typ) \+instance Elt Typ where { \+    read ary ndx \+        = unsafeIOToST $ withMArrayPtr ary $ \ptr -> peekElemOff ptr ndx \+;   write ary ndx word \+        = unsafeIOToST $ withMArrayPtr ary $ \ptr -> pokeElemOff ptr ndx word \+;   index ary ndx = unsafePerformIO $ withArrayPtr ary $ \ptr -> peekElemOff ptr ndx \+;   elemSize = sizeOf \+}++deriveElt(Word)+deriveElt(Word8)+deriveElt(Word16)+deriveElt(Word32)+deriveElt(Word64)+deriveElt(Int)+deriveElt(Int8)+deriveElt(Int16)+deriveElt(Int32)+deriveElt(Int64)+deriveElt(Float)+deriveElt(Double)+deriveElt(Char)++#endif
+ Data/SmallArray.hs view
@@ -0,0 +1,43 @@+-- |+-- Module      : Data.SmallArray+-- Copyright   : (c) Bryan O'Sullivan 2009+--               (c) Antoine Latter 2010+--+-- License     : BSD-style+-- Maintainer  : aslatter@gmail.com+-- Stability   : experimental+-- Portability : portable+--+-- Packed, unboxed, heap-resident arrays.  Suitable for performance+-- critical use, both in terms of large data quantities and high+-- speed.+--+-- This module is intended to be imported @qualified@, to avoid name+-- clashes with "Prelude" functions, e.g.+--+-- > import qualified Data.SmallArray as A+--+-- The names in this module resemble those in the 'Data.Array' family+-- of modules, but are shorter due to the assumption of qualifid+-- naming.+module Data.SmallArray+    (+    -- * Array types+      Array+    , MArray+    , IArray(..)+    , Elt(read, write, index)++    -- * Creation+    , empty+    , new+    , run+    , run'+    , fromList+    , copy++    -- * Unpacking+    , toList+    ) where++import Data.SmallArray.Internal
+ Data/SmallArray/Internal.hs view
@@ -0,0 +1,260 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE Rank2Types, BangPatterns #-}++-- |+-- Module      : Data.SmallArray+-- Copyright   : (c) Bryan O'Sullivan 2009+--               (c) Antoine Latter 2010+--+-- License     : BSD-style+-- Maintainer  : aslatter@gmail.com+-- Stability   : experimental+-- Portability : portable+--+-- Packed, unboxed, heap-resident arrays.  Suitable for performance+-- critical use, both in terms of large data quantities and high+-- speed.+--+-- This module is intended to be imported @qualified@, to avoid name+-- clashes with "Prelude" functions, e.g.+--+-- > import qualified Data.SmallArray as A+--+-- The names in this module resemble those in the 'Data.Array' family+-- of modules, but are shorter due to the assumption of qualifid+-- naming.+module Data.SmallArray.Internal where++import Prelude hiding (length)+import qualified Prelude++import Control.Exception (assert)+import Control.Monad.ST++import qualified Data.ByteArray as B+import Data.ByteArray (ByteArray, MutableByteArray)++import Data.Int+import Data.Word++import Control.DeepSeq++-- | A simple array. Indexing starts from zero.+newtype Array a+    = A ByteArray++-- | A simple mutable array. Indexing starts from zero.+newtype MArray s a+    = M (MutableByteArray s)++instance NFData (Array a) where+    rnf (A ary) = rnf ary++instance NFData (MArray s a) where+    rnf (M ary) = rnf ary++instance (Show e, Elt e) => Show (Array e) where+    show = show . toList++instance (Eq a, Elt a) => Eq (Array a) where+    {-# SPECIALIZE instance Eq (Array Word8) #-}+    (==) = eqArray++eqArray :: (Eq a, Elt a) => Array a -> Array a -> Bool+eqArray a b+        = let an = length a+              bn = length b+          in+            an == bn && and [unsafeIndex a n == unsafeIndex b n | n <- [0..bn-1] ]+{-# INLINE eqArray #-}++instance (Ord a, Elt a) => Ord (Array a) where+    {-# SPECIALIZE instance Ord (Array Word8) #-}+    a `compare` b+        = f 0++     where an = length a+           bn = length b+           maxLen = an `min` bn++           f n | n < maxLen+                   = case unsafeIndex a n `compare` unsafeIndex b n of+                       EQ -> f (n+1)+                       x  -> x+               | an > bn+                   = GT+               | bn > an+                   = LT+               | otherwise+                   = EQ+    {-# INLINE compare #-}++class IArray a where+    -- | Return the length of an array.+    length :: a -> Int+    {-# INLINE length #-}++instance Elt a => IArray (Array a) where+    length = arrayLen++arrayLen :: Elt a => Array a -> Int+arrayLen a@(A arr)+    = len undefined a arr+ where+   len :: Elt e => e -> Array e -> ByteArray -> Int+   len elem _ bytes = B.length bytes `div` elemSize elem+{-# INLINE arrayLen #-}++instance Elt a => IArray (MArray s a) where+    length = marrayLen++marrayLen :: Elt a => MArray s a -> Int+marrayLen a@(M arr)+    = len undefined a arr+ where+   len :: Elt e => e -> MArray s e -> MutableByteArray s -> Int+   len elem _ bytes = B.lengthM bytes `div` elemSize elem+{-# INLINE marrayLen #-}++-- | Create a new array. The contents are not initialized in any way, and+-- may be invalid.+unsafeNew :: Elt e => Int -> ST s (MArray s e)+unsafeNew n = f undefined+   where f :: Elt e => e -> ST s (MArray s e)+         f e = M `fmap` B.new (bytesInArray n e)+{-# INLINE unsafeNew #-}++-- | Create a new array with the specified default value.+new :: Elt e => Int -> e -> ST s (MArray s e)+new n e = do+  arr <- unsafeNew n+  mapM_ (flip (unsafeWrite arr) e) [0 .. (n-1)]+  return arr++unsafeFreeze :: MArray s e -> ST s (Array e)+unsafeFreeze (M marr) = A `fmap` B.unsafeFreeze marr +{-# INLINE unsafeFreeze #-}++-- | Execute an action creating a mutable array, and return the resulting+-- equivalent pure array. No copy is performed.+run :: (forall s . ST s (MArray s e)) -> Array e+run act = runST $ act >>= unsafeFreeze+{-# INLINE run #-}++run' :: (forall s . ST s (MArray s e, a)) -> (Array e, a)+run' act = runST $ do+             (marr, a) <- act+             arr <- unsafeFreeze marr+             return (arr, a)++-- | The empty array+empty :: Elt e => Array e+empty = run $ unsafeNew 0++-- | Output the array to a list.+toList :: Elt e => Array e -> [e]+toList arr = [arr `unsafeIndex` n | n <- [0 .. length arr - 1]]+{-# INLINE toList #-}++-- | Create an array from a list.+fromList :: Elt e => [e] -> Array e+fromList xs+    = run $ do+        arr <- unsafeNew len+        mapM_ (uncurry $ unsafeWrite arr) $ zip [0..(len-1)] xs+        return arr+ where len = Prelude.length xs+{-# INLINE fromList #-}++-- | Copy an array in its entirety. The destination array must be at+-- least as big as the source.+copy :: Elt e => MArray s e     -- ^ source array+     -> MArray s e              -- ^ destination array+     -> ST s ()+copy src dest+    | length dest >= length src = copy_loop 0+    | otherwise                 = fail "Data.SmallArray.copy: array too small"+    where+      len = length src+      copy_loop i+          | i >= len  = return ()+          | otherwise = do unsafeRead src i >>= unsafeWrite dest i+                           copy_loop (i+1)+{-# INLINE copy #-}++-- | Unsafely copy the elements of an array. Array bounds are not checked.+unsafeCopy :: Elt e =>+              MArray s e -> Int -> MArray s e -> Int -> Int -> ST s ()+unsafeCopy src sidx dest didx count =+    assert (sidx + count <= length src) .+    assert (didx + count <= length dest) $+    copy_loop sidx didx 0+    where+      copy_loop !i !j !c+          | c >= count  = return ()+          | otherwise = do unsafeRead src i >>= unsafeWrite dest j+                           copy_loop (i+1) (j+1) (c+1)+{-# INLINE unsafeCopy #-}+++class Elt e where+    -- |Retrieve an element in an array at the specified+    -- location. Array indices start at zero.+    index :: Array e -> Int -> e+    index a n = check "index" a n unsafeIndex+    {-# INLINE index #-}++    -- |Retrieve an element from a mutable array at the+    -- specified location. Array indices start at zero.+    read :: MArray s e -> Int -> ST s e+    read a n = check "read" a n unsafeRead+    {-# INLINE read #-}++    -- |Write an element to a mutable array at+    -- the specified location. Array indices start+    -- at zero.+    write :: MArray s e -> Int -> e -> ST s ()+    write a n = check "write" a n unsafeWrite+    {-# INLINE write #-}++    -- | Size of the element in bytes+    elemSize :: e -> Int++    unsafeIndex :: Array e -> Int -> e+    unsafeRead :: MArray s e -> Int -> ST s e+    unsafeWrite :: MArray s e -> Int -> e -> ST s ()++bytesInArray :: Elt e => Int -> e -> Int+bytesInArray sz el = elemSize el * sz++check :: IArray a => String -> a -> Int -> (a -> Int -> b) -> b+check func ary i f+    | i >= 0 && i < length ary = f ary i+    | otherwise = error ("Data.SmallArray." ++ func ++ ": index out of bounds")+{-# INLINE check #-}++#define deriveElt(Typ) \+instance Elt Typ where { \+   elemSize = B.elemSize                     \+;  {-# INLINE elemSize #-} \+;  unsafeIndex (A arr) n   = B.index arr n    \+;  {-# INLINE unsafeIndex #-} \+;  unsafeRead  (M arr) n   = B.read  arr n    \+;  {-# INLINE unsafeRead #-} \+;  unsafeWrite (M arr) n x = B.write arr n x  \+;  {-# INLINE unsafeWrite #-} \+} \++deriveElt(Char)+deriveElt(Double)+deriveElt(Float)+deriveElt(Int)+deriveElt(Int8)+deriveElt(Int16)+deriveElt(Int32)+deriveElt(Int64)+deriveElt(Word)+deriveElt(Word8)+deriveElt(Word16)+deriveElt(Word32)+deriveElt(Word64)
+ Data/SmallArray/Unsafe.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE Rank2Types #-}++module Data.SmallArray.Unsafe+    (+      Elt(unsafeRead, unsafeWrite, unsafeIndex)+    , unsafeNew+    , unsafeFreeze+    , unsafeCopy+    ) where++import Data.SmallArray.Internal
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Antoine Latter 2010++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 Antoine Latter 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
+ smallarray.cabal view
@@ -0,0 +1,47 @@+Name:                smallarray++-- See the Haskell package versioning policy+-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for+-- standards guiding when and how versions should be incremented.+Version:             0.1.0++Synopsis:            low-level unboxed arrays, with minimal features.++Description:         This package includes low-level, portable uboxed array types.+                     The SmallArray has been tuned for size in memory, and hence+                     does not support many of the nice operations supplied by+                     other array libraries++Homepage:            http://community.haskell.org/~aslatter/code/bytearray++License:             BSD3++License-file:        LICENSE++Author:              Antoine Latter+Maintainer:          aslatter@gmail.com+Copyright:           Antoine Latter, 2010++-- Stability of the pakcage (experimental, provisional, stable...)+Stability:           Experimental++Category:            Data++Build-type:          Simple++-- Extra files to be distributed with the package, such as examples or+-- a README.+-- Extra-source-files:  ++Cabal-version:       >=1.2++Library++  Exposed-modules:     Data.SmallArray+                       Data.SmallArray.Unsafe++  Other-modules:       Data.ByteArray+                       Data.SmallArray.Internal+  +  Build-depends:       base < 4.4, deepseq >= 1.1 && < 1.2+  ghc-options: -Wall -funbox-strict-fields -O2