PrimitiveArray 0.0.4.0 → 0.1.1.2

raw patch · 6 files changed

+146/−233 lines, 6 filesdep +repadep +vectordep ~primitivePVP ok

version bump matches the API change (PVP)

Dependencies added: repa, vector

Dependency ranges changed: primitive

API changes (from Hackage documentation)

Files

• Benchmarks/Index.hs +0/−51
• Data/PrimitiveArray.hs +28/−76
• Data/PrimitiveArray/Internal.hs +0/−23
• Data/PrimitiveArray/Ix.hs +0/−68
• Data/PrimitiveArray/Unboxed.hs +97/−0
• PrimitiveArray.cabal +21/−15

@@ -1,51 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE ScopedTypeVariables #-}---- | Benchmark the folding functions. As these functions need several tables to--- read data from, we have to initialize some stuff. The benchmarks test access--- and calculation patterns that are common in bioinformatics.------ For best results, compile with "-Odph -fllvm" (6.13) or "-Odph" (6.12). This--- is for the unboxed vectors. Both benchmarks should clock at about 10us.--module Main where--import Criterion.Main-import Control.DeepSeq-import System.Random-import qualified Data.Vector.Unboxed as VU--import Data.PrimitiveArray-import Data.PrimitiveArray.Ix-import Data.Primitive.Types----hi = 999--main = do-  rng <- getStdGen-  let (table :: PrimArray (Int,Int) Int) = fromAssocs (0,0) (hi,hi) 0 $ zip-              [ (i,j)-              | i<-[0..hi]-              , j<-[0..hi]-              ] $ randomRs (0,hi) rng-  print $ table ! (0,0)-  print $ table ! (hi,hi)-  defaultMain-    [ bgroup "compare"-      [ bench "unsafeIndex" $-          whnf (\k -> {-# CORE "sum/unsafeIndex" #-}-                  VU.foldl' min 999999 $-                  VU.map (\ij -> table ! ij) $-                  VU.generate k (\z -> (z,z))-                ) hi-      , bench "twiceIndex" $-          whnf (\k -> {-# CORE "sum/twiceIndex" #-}-                  VU.foldl' min 999999 $-                  VU.map (\(i,j) -> (table ! (i,0)) + (table ! (0,j))) $-                  VU.generate k (\z -> (z,z))-                ) hi-      ]-    ]

@@ -1,94 +1,46 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE RankNTypes #-} --- | Unboxed, primitive, multidimensional tables. In instance for 'Ix'-type--- keys comes with the package. This package trades safety for speed. The index--- operator (!) is basically the only function that does bounds-checking and--- only with an assertion. This, however, is by design. The only way to get an--- immutable table from a mutable one is by the 'unsafeFreezeM' operation.--- Again, it is by design that both data structures share the same memory--- pointer internally.+-- | Primitive arrays with a small set of operations. Modelled after repa+-- arrays and indexing. ----- TODO We kind-of lost all but the ST monad for monadic operations.+-- Array indexing is between [i..j] per dimension.+--+-- All operations are UNSAFE. In interpreted code, "assert" provides a safety+-- net.  module Data.PrimitiveArray where  import Control.Monad.Primitive (PrimMonad)+import Data.Array.Repa.Shape (Shape) import Control.Exception (assert)-import Text.Read.Lex as L-import Text.Read-import Text.ParserCombinators.ReadP --- * The PrimArray class. -class PrimArrayOps a b where-  -- | PrimArray data type-  data PrimArray  a b :: *-  unsafeIndex :: PrimArray a b -> a -> b  -- ^ Index an array without bounds-checking-  assocs :: PrimArray a b -> [(a,b)]      -- ^ All associations of (key,value)-  fromAssocs :: a -> a -> b -> [(a,b)] -> PrimArray a b -- ^ Pure build function-  bounds :: PrimArray a b -> (a,a)        -- ^ Min- and maxbound of all dimensions-  checkBounds :: PrimArray a b -> a -> Bool -- ^ Check if index is within bounds-  fromList :: a -> a -> [b] -> PrimArray a b  -- ^ Build the /complete/ table from a list-  toList :: PrimArray a b -> [b]          -- ^ Read the complete table as a list +class Shape sh => PrimArrayOps sh elm where+  data PrimArray sh elm :: *+  unsafeIndex :: PrimArray sh elm -> sh -> elm+  bounds :: PrimArray sh elm -> (sh,sh)+  inBounds :: PrimArray sh elm -> sh -> Bool+  fromAssocs :: sh -> sh -> elm -> [(sh,elm)] -> PrimArray sh elm+  assocs :: PrimArray sh elm -> [(sh,elm)] -class (PrimMonad s) => PrimArrayOpsM a b s where-  -- | Monadic data type-  data PrimArrayM a b s :: *-  readM :: PrimArrayM a b s -> a -> s b   -- ^ Monadic read-  writeM :: PrimArrayM a b s -> a -> b -> s ()  -- ^ Monadic write-  boundsM :: PrimArrayM a b s -> s (a,a)  -- ^ Monadic bounds-  fromAssocsM :: a -> a -> b -> [(a,b)] -> s (PrimArrayM a b s) -- ^ Build monadic array from assocs-  unsafeFreezeM :: PrimArrayM a b s -> s (PrimArray a b)  -- ^ UNSAFE freezing of array.-  fromListM :: a -> a -> [b] -> s (PrimArrayM a b s)      -- ^ Build the /complete/ monadic table from a list-  toListM :: PrimArrayM a b s -> s [b]    -- ^ Read the complete monadic table as a list+class (PrimMonad m, Shape sh) => PrimArrayOpsM sh elm m where+  data PrimArrayM sh elm m :: *+  readM :: PrimArrayM sh elm m -> sh -> m elm+  writeM :: PrimArrayM sh elm m -> sh -> elm -> m ()+  -- | Create a monadic array from a list of associations+  fromAssocsM :: sh -> sh -> elm -> [(sh,elm)] -> m (PrimArrayM sh elm m)+  unsafeFreezeM :: PrimArrayM sh elm m -> m (PrimArray sh elm)+  boundsM :: PrimArrayM sh elm m -> (sh,sh)+  inBoundsM :: PrimArrayM sh elm m -> sh -> Bool   --- * Helper functions.---- | Asserting 'unsafeIndex'. Debug-code is checked for out-of-bounds--- occurances while production code uses unsafeIndex directly.+-- * Helper functions -(!) :: (PrimArrayOps a b) => PrimArray a b -> a -> b-(!) pa idx = assert (checkBounds pa idx) $ unsafeIndex pa idx+(!) :: PrimArrayOps sh elm => PrimArray sh elm -> sh -> elm+(!) pa idx = assert (inBounds pa idx) $ unsafeIndex pa idx {-# INLINE (!) #-} --- | Create a new array from an old one, mapping a function over all values.--amap :: (PrimArrayOps a b, PrimArrayOps a c) => (b -> c) -> PrimArray a b -> PrimArray a c-amap f pa = fromList lb ub $ map f $ toList pa where-  (lb,ub) = bounds pa------ * Read and show instances---- | The Show instance looks a bit like Show for Data.Vector.Unboxed--instance (Bounded a, Show a, Show b, PrimArrayOps a b) => Show (PrimArray a b) where-  show pa = "fromList " ++ show l ++ " " ++ show u ++ " " ++ (show $ toList pa) ++ " :: Data.PrimitiveArray.PrimitiveArray" where-    (l,u) = bounds pa---- | The Read instance follows Read for Data.Vector.Unboxed--instance (Bounded a, Read a, Read b, PrimArrayOps a b) => Read (PrimArray a b) where-  readPrec =-    parens $ do-      lift $ skipSpaces-      L.Ident "fromList" <- lexP-      lift $ skipSpaces-      (l :: a) <- readPrec-      lift $ skipSpaces-      (u :: a) <- readPrec-      (vals :: [b])  <- readPrec-      lift $ skipSpaces-      lift $ string "::"-      lift $ skipSpaces-      lift $ string "Data.PrimitiveArray.PrimitiveArray"-      lift $ skipSpaces-      return $ fromList l u vals-  readListPrec = readListPrecDefault-  readList     = readListDefault

@@ -1,23 +0,0 @@---- | Helper functions for creating new arrays.--module Data.PrimitiveArray.Internal where--import Data.Primitive-import Control.Monad.ST-import Control.Monad (forM_)---- | Create a new m-array with a default value.--newWith :: (Prim a) => Int -> a -> ST s (MutableByteArray s)-newWith l z = do-  marr <- new l z-  forM_ [0..l-1] $ \k -> (writeByteArray marr k z)-  return marr---- | In 'new', 'z' is not used.--new :: (Prim a) => Int -> a -> ST s (MutableByteArray s)-new l z = do-  marr <- newByteArray (l * sizeOf z)-  return marr

@@ -1,68 +0,0 @@--{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE MultiParamTypeClasses #-}---- | PrimitiveArray with 'Ix' keys.--module Data.PrimitiveArray.Ix where--import Data.Primitive-import Control.Monad.ST-import Control.Monad (liftM, forM_, zipWithM_, forM)-import Data.Primitive.Types-import qualified GHC.Arr as A--import Data.PrimitiveArray-import Data.PrimitiveArray.Internal----instance (Bounded a, A.Ix a, Prim b) => PrimArrayOps a b where-  data PrimArray a b = PaIxP !a !a {-# UNPACK #-} !ByteArray-  unsafeIndex (PaIxP lb ub arr) i = indexByteArray arr (A.unsafeIndex (lb,ub) i)-  assocs (pa@(PaIxP lb ub _)) = [(i, unsafeIndex pa i) | i<-A.range(lb,ub) ]-  fromAssocs l u z xs = runST $ do-    pam <- fromAssocsM l u z xs-    unsafeFreezeM pam-  bounds (PaIxP lb ub _) = (lb,ub)-  checkBounds (PaIxP lb ub _) i = A.inRange (lb,ub) i-  fromList l u xs = runST $ do-    pam <- fromListM l u xs-    unsafeFreezeM pam-  toList pa@(PaIxP lb ub _) = [unsafeIndex pa i | i <- A.range(lb,ub)]-  {-# INLINE unsafeIndex #-}-  {-# INLINE assocs #-}-  {-# INLINE fromAssocs #-}-  {-# INLINE bounds #-}-  {-# INLINE checkBounds #-}-  {-# INLINE fromList #-}-  {-# INLINE toList #-}--instance (Bounded a, A.Ix a, Prim b) => PrimArrayOpsM a b (ST s) where-  data PrimArrayM a b (ST s) = PaIxPM !a !a {-# UNPACK #-} !(MutableByteArray s)-  readM (PaIxPM lb ub marr) i = readByteArray marr (A.unsafeIndex (lb,ub) i)-  writeM (PaIxPM lb ub marr) i val = writeByteArray marr (A.unsafeIndex (lb,ub) i) val-  boundsM (PaIxPM lb ub _) = return (lb,ub)-  fromAssocsM lb ub z xs = do-    let l = A.rangeSize (lb,ub)-    pam <- PaIxPM lb ub `liftM` newWith l z-    forM_ xs $ uncurry (writeM pam)-    return pam-  unsafeFreezeM (PaIxPM lb ub marr) = do-    arr <- unsafeFreezeByteArray marr-    return $ PaIxP lb ub arr-  fromListM lb ub xs = do-    let l = A.rangeSize (lb,ub)-    pam <- PaIxPM lb ub `liftM` new l (undefined `asTypeOf` head xs)-    zipWithM_ (writeM pam) (A.range (lb,ub)) xs-    return pam-  toListM pam@(PaIxPM lb ub _) = forM (A.range (lb,ub)) (readM pam)-  {-# INLINE readM #-}-  {-# INLINE writeM #-}-  {-# INLINE boundsM #-}-  {-# INLINE fromAssocsM #-}-  {-# INLINE unsafeFreezeM #-}-  {-# INLINE fromListM #-}-  {-# INLINE toListM #-}-

@@ -0,0 +1,97 @@+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}++module Data.PrimitiveArray.Unboxed where++import qualified Data.Vector.Unboxed.Mutable as VUM+import qualified Data.Vector.Unboxed as VU+import Control.Monad.ST+import Control.Monad+import Data.Array.Repa.Shape+import Control.Exception (assert)++import Data.PrimitiveArray++import Data.Array.Repa.Index++++instance (VU.Unbox elm, Shape sh, Show elm, Show sh) => PrimArrayOps sh elm where+  -- | An immutable PrimArray has a lower bound (lsh), and upper bound (ush)+  -- and an upper bound minus unitDim (ush'), returned by bounds+  data PrimArray sh elm = PrimArray sh sh sh (VU.Vector elm)+  unsafeIndex (PrimArray lsh ush ush' v) idx = assert (inShapeRange lsh ush idx)+                                             $ v `VU.unsafeIndex` (toIndex ush idx - toIndex ush lsh)+  bounds (PrimArray lsh ush ush' _) = (lsh,ush')+  inBounds (PrimArray lsh ush ush' _) idx = inShapeRange lsh ush idx+  fromAssocs lsh ush' def xs =+    let ush = ush' `addDim` unitDim+    in  PrimArray lsh ush ush'+        $ VU.replicate (size ush - size lsh) def+        VU.// map (\(k,v) -> if (inShapeRange lsh ush k)+                             then (toIndex ush k - toIndex ush lsh,v)+                             else error $ show (lsh,ush,k,v)+                  ) xs+  assocs (PrimArray lsh ush ush' v) = map (\(k,v) -> (fromIndex ush $ k + toIndex ush lsh, v))+                                    . VU.toList+                                    . VU.indexed+                                    $ v+  {-# INLINE unsafeIndex #-}+  {-# INLINE bounds #-}+  {-# INLINE inBounds #-}+  {-# INLINE fromAssocs #-}++deriving instance (Show elm, Show sh, VU.Unbox elm) => Show (PrimArray sh elm)++deriving instance (Read elm, Read sh, VU.Unbox elm) => Read (PrimArray sh elm)++++instance (VUM.Unbox elm, Shape sh) => PrimArrayOpsM sh elm (ST s) where+  data PrimArrayM sh elm (ST s) = PrimArrayST sh sh sh (VUM.STVector s elm)+  readM (PrimArrayST lsh ush ush' v) sh = VUM.unsafeRead v (toIndex ush sh - toIndex ush lsh)+  writeM (PrimArrayST lsh ush suh' v) sh e = VUM.unsafeWrite v (toIndex ush sh - toIndex ush lsh) e+  fromAssocsM lsh ush' def xs = do+    let ush = ush' `addDim` unitDim+    v <- VUM.new (size ush - size lsh)+    VUM.set v def+    forM_ xs $ \(k,e) -> assert (inShapeRange lsh ush k)+                      $ VUM.unsafeWrite v (toIndex ush k - toIndex ush lsh) e+    return $ PrimArrayST lsh ush ush' v+  unsafeFreezeM (PrimArrayST lsh ush ush' v) = do+    v' <- VU.unsafeFreeze v+    return $ PrimArray lsh ush ush' v'+  boundsM (PrimArrayST lsh ush ush' _) = (lsh,ush')+  inBoundsM (PrimArrayST lsh ush ush' _) idx = inShapeRange lsh ush idx+  {-# INLINE readM #-}+  {-# INLINE writeM #-}+  {-# INLINE fromAssocsM #-}+  {-# INLINE unsafeFreezeM #-}+  {-# INLINE boundsM #-}+  {-# INLINE inBoundsM #-}++instance (VUM.Unbox elm, Shape sh) => PrimArrayOpsM sh elm IO where+  data PrimArrayM sh elm IO = PrimArrayIO sh sh sh (VUM.IOVector elm)+  readM (PrimArrayIO lsh ush ush' v) sh = VUM.unsafeRead v (toIndex ush sh - toIndex ush lsh)+  writeM (PrimArrayIO lsh ush suh' v) sh e = VUM.unsafeWrite v (toIndex ush sh - toIndex ush lsh) e+  fromAssocsM lsh ush' def xs = do+    let ush = ush' `addDim` unitDim+    v <- VUM.new (size ush - size lsh)+    VUM.set v def+    forM_ xs $ \(k,e) -> assert (inShapeRange lsh ush k)+                      $ VUM.unsafeWrite v (toIndex ush k - toIndex ush lsh) e+    return $ PrimArrayIO lsh ush ush' v+  unsafeFreezeM (PrimArrayIO lsh ush ush' v) = do+    v' <- VU.unsafeFreeze v+    return $ PrimArray lsh ush ush' v'+  boundsM (PrimArrayIO lsh ush ush' _) = (lsh,ush')+  inBoundsM (PrimArrayIO lsh ush ush' _) idx = inShapeRange lsh ush idx+  {-# INLINE readM #-}+  {-# INLINE writeM #-}+  {-# INLINE fromAssocsM #-}+  {-# INLINE unsafeFreezeM #-}+  {-# INLINE boundsM #-}+  {-# INLINE inBoundsM #-}+

@@ -1,34 +1,40 @@ Name:           PrimitiveArray-Version:        0.0.4.0+Version:        0.1.1.2 License:        BSD3 License-file:   LICENSE Author:         Christian Hoener zu Siederdissen Maintainer:     choener@tbi.univie.ac.at-Copyright:      Christian Hoener zu Siederdissen, 2010-2011+Copyright:      Christian Hoener zu Siederdissen, 2010-2012 Homepage:       http://www.tbi.univie.ac.at/~choener/ Stability:      Experimental Category:       Data Build-type:     Simple-Cabal-version:  >=1.2+Cabal-version:  >=1.6 Synopsis:-                Unboxed, multidimensional arrays based on the primitive-                package.+                Efficient multidimensional arrays Description:-                Provides unboxed multidimensional tables with a small-                interface. Comes with an instance for Ix keys. Read and Show-                instances are provided for serialization.--extra-source-files:-  Benchmarks/Index.hs+                This library provides efficient multidimensional arrays. All+                arrays are 0-based and indexed using repa-shapes.+                .+                Please note that this version only has the name (and author) in+                common with the previous 0.0.4.0 version. The basic idea of the+                library remains the same: provide efficient access to immutable+                arrays.  Library   Exposed-modules:     Data.PrimitiveArray-    Data.PrimitiveArray.Ix-    Data.PrimitiveArray.Internal+    Data.PrimitiveArray.Unboxed   Build-depends:     base >= 4 && <5,-    primitive >= 0.4.0.1 && < 0.5+    primitive >= 0.4,+    vector >= 0.9,+    repa >= 2.0   ghc-options:-    -O2+    -Odph+    -funbox-strict-fields++source-repository head+  type: git+  location: git://github.com/choener/PrimitiveArray