packages feed

PrimitiveArray (empty) → 0.0.2.1

raw patch · 7 files changed

+273/−0 lines, 7 filesdep +basedep +primitivesetup-changed

Dependencies added: base, primitive

Files

+ Benchmarks/Index.hs view
@@ -0,0 +1,51 @@+{-# 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+      ]+    ]
+ Data/PrimitiveArray.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}++-- | 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.+--+-- TODO We kind-of lost all but the ST monad for monadic operations.++module Data.PrimitiveArray where++import Control.Monad.Primitive (PrimMonad)+import Control.Exception (assert)++-- * The PrimArray class.++class PrimArrayOps a b where+  data PrimArray  a b :: *                -- ^ PrimArray data type+  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 (PrimMonad s) => PrimArrayOpsM a b s where+  data PrimArrayM a b s :: *              -- ^ Monadic data type+  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++++-- * Helper functions.++-- | Asserting 'unsafeIndex'. Debug-code is checked for out-of-bounds+-- occurances while production code uses unsafeIndex directly.++(!) :: (PrimArrayOps a b) => PrimArray a b -> a -> b+(!) pa idx = assert (checkBounds pa idx) $ unsafeIndex pa idx++-- | 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+++-- NOTE Show instances are possible but you are probably better with your own.++{-+instance (PrimArrayOps a b, Show a, Show b) => Show (PrimArray a b) where+  show pa = "fromList " ++ show lb ++ " " ++ show ub ++ " " ++ (show $ toList pa) where+    (lb,ub) = bounds pa+-}
+ Data/PrimitiveArray/Internal.hs view
@@ -0,0 +1,26 @@++-- | 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+++
+ Data/PrimitiveArray/Ix.hs view
@@ -0,0 +1,68 @@++{-# 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 {-# UNPACK #-} !a {-# UNPACK #-} !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 {-# UNPACK #-} !a {-# UNPACK #-} !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 #-}+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Christian Hoener zu Siederdissen 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 Christian Hoener zu Siederdissen 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.
+ PrimitiveArray.cabal view
@@ -0,0 +1,31 @@+Name:           PrimitiveArray+Version:        0.0.2.1+License:        BSD3+License-file:   LICENSE+Author:         Christian Hoener zu Siederdissen+Maintainer:     choener@tbi.univie.ac.at+Stability:      Experimental+Category:       Data+Build-type:     Simple+Cabal-version:  >=1.2+Synopsis:+                Unboxed, multidimensional arrays based on the primitive+                package.+Description:+                Provides unboxed multidimensional tables with a small+                interface. Comes with an instance for Ix keys.++extra-source-files:+  Benchmarks/Index.hs++Library+  Exposed-modules:+    Data.PrimitiveArray+    Data.PrimitiveArray.Ix+    Data.PrimitiveArray.Internal+  Build-depends:+    base >= 4 && <5,+    primitive >= 0.3 && < 0.4+  ghc-options:+    -O2+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain