PrimitiveArray 0.9.1.1 → 0.10.0.0
raw patch · 6 files changed
+191/−140 lines, 6 filesdep +criteriondep +dump-coredep ~base
Dependencies added: criterion, dump-core
Dependency ranges changed: base
Files
- PrimitiveArray.cabal +50/−6
- bench/Lookup.hs +50/−0
- changelog.md +9/−0
- lib/Data/PrimitiveArray/Checked.hs +1/−1
- lib/Data/PrimitiveArray/Class.hs +7/−1
- lib/Data/PrimitiveArray/Dense.hs +74/−132
PrimitiveArray.cabal view
@@ -1,6 +1,6 @@ Cabal-version: 2.2 Name: PrimitiveArray-Version: 0.9.1.1+Version: 0.10.0.0 License: BSD-3-Clause License-file: LICENSE Maintainer: choener@bioinf.uni-leipzig.de@@ -11,7 +11,7 @@ Stability: Experimental Category: Data Build-type: Simple-tested-with: GHC == 8.4.4+tested-with: GHC == 8.6.4 Synopsis: Efficient multidimensional arrays Description: <http://www.bioinf.uni-leipzig.de/Software/gADP/ generalized Algebraic Dynamic Programming>@@ -52,8 +52,23 @@ default: False manual: True +flag llvm+ description: use llvm+ default: False+ manual: True +flag debugdump+ description: Enable dumping intermediate / core files+ default: False+ manual: True +flag dump-core+ description: Dump HTML for the core generated by GHC during compilation+ default: False+ manual: True+++ common deps build-depends: base >= 4.7 && < 5.0 , aeson >= 0.8@@ -70,10 +85,6 @@ , primitive >= 0.5.4 , QuickCheck >= 2.7 , smallcheck >= 1.1- , tasty >= 0.11- , tasty-quickcheck >= 0.8- , tasty-smallcheck >= 0.8- , tasty-th >= 0.1 , text >= 1.0 , vector >= 0.11 , vector-binary-instances >= 0.2@@ -146,6 +157,13 @@ test-suite properties import: deps+ build-depends: base+ , tasty >= 0.11+ , tasty-quickcheck >= 0.8+ , tasty-smallcheck >= 0.8+ , tasty-th >= 0.1+ --+ , PrimitiveArray type: exitcode-stdio-1.0 main-is:@@ -159,6 +177,32 @@ hs-source-dirs: tests build-depends: PrimitiveArray+++benchmark Lookup+ import:+ deps+ type:+ exitcode-stdio-1.0+ main-is:+ Lookup.hs+ hs-source-dirs:+ bench+ build-depends: PrimitiveArray+ , criterion ^>= 1.5+ if flag(llvm)+ ghc-options:+ -fllvm+ -optlo-O3+ if flag(debugdump)+ ghc-options:+ -ddump-to-file+ -ddump-simpl+ -dsuppress-all+ if flag(dump-core)+ build-depends: dump-core+ ghc-options: -fplugin=DumpCore -fplugin-opt DumpCore:core-html+
+ bench/Lookup.hs view
@@ -0,0 +1,50 @@++module Main where++import Criterion.Main++import Data.PrimitiveArray as PA++++go ∷ (Index i) ⇒ Int → Unboxed i Int → i → Int+{-# Inline go #-}+go !c !pa !i = f c i 0+ where f 0 !i !acc = acc+ f !k !i !acc = f (k-1) i (acc + pa ! i)++go1 ∷ Int → Unboxed (Z:.Int) Int → (Z:.Int) → Int+{-# NoInline go1 #-}+go1 = go++go2 ∷ Int → Unboxed (Z:.Int:.Int) Int → (Z:.Int:.Int) → Int+{-# NoInline go2 #-}+go2 = go++go3 ∷ Int → Unboxed (Z:.Int:.Int:.Int) Int → (Z:.Int:.Int:.Int) → Int+{-# NoInline go3 #-}+go3 = go++main ∷ IO ()+main = do+ let !(pa1 ∷ Unboxed (Z:.Int) Int) = PA.fromAssocs (ZZ:..LtInt 10) 0 []+ let !(pa2 ∷ Unboxed (Z:.Int:.Int) Int) = PA.fromAssocs (ZZ:..LtInt 10:..LtInt 10) 0 []+ let !(pa3 ∷ Unboxed (Z:.Int:.Int:.Int) Int) = PA.fromAssocs (ZZ:..LtInt 10:..LtInt 10:..LtInt 10) 0 []+ defaultMain+ [ bgroup "1"+ [ bench "10^0" $ whnf (go1 1 pa1) (Z:.5)+ , bench "10^3" $ whnf (go1 1000 pa1) (Z:.5)+ , bench "10^6" $ whnf (go1 1000000 pa1) (Z:.5)+ , bench "10^9" $ whnf (go1 1000000000 pa1) (Z:.5)+ ]+ , bgroup "2"+ [ bench " 1" $ whnf (go2 1 pa2) (Z:.5:.5)+ , bench " 1000" $ whnf (go2 1000 pa2) (Z:.5:.5)+ , bench "1000000" $ whnf (go2 1000000 pa2) (Z:.5:.5)+ ]+ , bgroup "3"+ [ bench " 1" $ whnf (go3 1 pa3) (Z:.5:.5:.5)+ , bench " 1000" $ whnf (go3 1000 pa3) (Z:.5:.5:.5)+ , bench "1000000" $ whnf (go3 1000000 pa3) (Z:.5:.5:.5)+ ]+ ]
changelog.md view
@@ -1,3 +1,12 @@+0.10.0.0+--------++- Rewrote Data.PrimitiveArray.Dense to accept all vector types using one+ interface. This is a breaking change, since @Unboxed@ becomes @Dense+ Data.Vector.Unboxed.Vector@, but now @Dense v@ accepts any @v@ as underlying+ storage vector. Breaking occurs only at user sites where the actual vector+ type needs to be specified. This tends to be very localized.+ 0.9.1.1 -------
lib/Data/PrimitiveArray/Checked.hs view
@@ -19,7 +19,7 @@ -- outside of the allocated area. --(!) :: PrimArrayOps arr sh elm => arr sh elm -> sh -> elm-(!) arr@(Unboxed h v) idx+(!) arr@(Dense h v) idx | not (inBounds (upperBound arr) idx) = error $ "(!) / inBounds: out of bounds! " ++ show (h,idx) | li < 0 || li >= len = error $ "(!) / linearIndex: out of bounds! " ++ show (h,li,len,idx) | otherwise = unsafeIndex arr idx
lib/Data/PrimitiveArray/Class.hs view
@@ -182,8 +182,14 @@ -- | Return all associations from an array. assocs :: forall arr sh elm . (IndexStream sh, PrimArrayOps arr sh elm) => arr sh elm -> [(sh,elm)]-assocs arr = P.map (\k -> (k,unsafeIndex arr k)) . unId . SM.toList $ streamUp zeroBound' (upperBound arr) where+assocs arr = unId . SM.toList $ assocsS arr {-# INLINE assocs #-}++-- | Return all associations from an array.++assocsS ∷ forall m arr sh elm . (Monad m, IndexStream sh, PrimArrayOps arr sh elm) ⇒ arr sh elm → SM.Stream m (sh,elm)+assocsS arr = SM.map (\k -> (k,unsafeIndex arr k)) $ streamUp zeroBound' (upperBound arr)+{-# INLINE assocsS #-} -- | Creates an immutable array from lower and upper bounds and a complete list -- of elements.
lib/Data/PrimitiveArray/Dense.hs view
@@ -13,6 +13,9 @@ -- -- TODO while @Unboxed@ is, in princile, @Hashable@, we'd need the -- corresponding @VU.Vector@ instances ...+--+-- TODO rename to Dense.Vector, since there are other possibilities to store,+-- without basing on vector. module Data.PrimitiveArray.Dense where @@ -22,175 +25,114 @@ import Control.Monad.Primitive (PrimState) import Data.Aeson (ToJSON,FromJSON) import Data.Binary (Binary)+import Data.Data import Data.Hashable (Hashable) import Data.Serialize (Serialize) import Data.Typeable (Typeable) import Data.Vector.Binary import Data.Vector.Generic.Mutable as GM hiding (length) import Data.Vector.Serialize-import Data.Vector.Unboxed.Mutable (Unbox) import Debug.Trace import GHC.Generics (Generic)-import qualified Data.Vector as V hiding (forM_, length, zipWithM_)-import qualified Data.Vector.Generic as G-import qualified Data.Vector.Unboxed as VU hiding (forM_, length, zipWithM_)-import Data.Data-+import qualified Data.Vector as V+import qualified Data.Vector.Fusion.Stream.Monadic as SM+import qualified Data.Vector.Generic as VG+import qualified Data.Vector.Storable as VS+import qualified Data.Vector.Unboxed as VU import Data.PrimitiveArray.Class import Data.PrimitiveArray.Index.Class --- * Unboxed, multidimensional arrays.+data Dense v sh e = Dense !(LimitType sh) !(v e) -data Unboxed sh e = Unboxed !(LimitType sh) !(VU.Vector e)+type Unboxed sh e = Dense VU.Vector sh e -deriving instance (Eq (LimitType sh), Eq e , Unbox e) ⇒ Eq (Unboxed sh e)-deriving instance (Generic (LimitType sh), Generic e, Unbox e) ⇒ Generic (Unboxed sh e)-deriving instance (Read (LimitType sh), Read e , Unbox e) ⇒ Read (Unboxed sh e)-deriving instance (Show (LimitType sh), Show e , Unbox e) ⇒ Show (Unboxed sh e)-deriving instance- ( Data sh, Data (LimitType sh)- , Data e, Unbox e- ) ⇒ Data (Unboxed sh e)+type Storable sh e = Dense VS.Vector sh e -instance (Binary (LimitType sh), Binary e, Unbox e, Generic (LimitType sh), Generic e) => Binary (Unboxed sh e)-instance (Serialize (LimitType sh), Serialize e, Unbox e, Generic (LimitType sh), Generic e) => Serialize (Unboxed sh e)-instance (ToJSON (LimitType sh), ToJSON e, Unbox e, Generic (LimitType sh), Generic e) => ToJSON (Unboxed sh e)-instance (FromJSON (LimitType sh), FromJSON e, Unbox e, Generic (LimitType sh), Generic e) => FromJSON (Unboxed sh e)-instance (Hashable (LimitType sh), Hashable e, Hashable (VU.Vector e), Unbox e, Generic (LimitType sh), Generic e) => Hashable (Unboxed sh e)+type Boxed sh e = Dense V.Vector sh e -instance (NFData (LimitType sh)) => NFData (Unboxed sh e) where- rnf (Unboxed h xs) = rnf h `seq` rnf xs- {-# Inline rnf #-} -data instance MutArr m (Unboxed sh e) = MUnboxed !(LimitType sh) !(VU.MVector (PrimState m) e)- deriving (Generic,Typeable) -instance (NFData (LimitType sh)) => NFData (MutArr m (Unboxed sh e)) where- rnf (MUnboxed h xs) = rnf h `seq` rnf xs- {-# Inline rnf #-}+deriving instance (Eq (LimitType sh), Eq (v e) ) ⇒ Eq (Dense v sh e)+deriving instance (Generic (LimitType sh), Generic (v e)) ⇒ Generic (Dense v sh e)+deriving instance (Read (LimitType sh), Read (v e) ) ⇒ Read (Dense v sh e)+deriving instance (Show (LimitType sh), Show (v e) ) ⇒ Show (Dense v sh e) -instance- ( Index sh- , Unbox elm-#if ADPFUSION_DEBUGOUTPUT- , Show sh, Show (LimitType sh), Show elm-#endif- ) ⇒ MPrimArrayOps Unboxed sh elm where- upperBoundM (MUnboxed h _) = h- fromListM h xs = do- ma <- newM h- let (MUnboxed _ mba) = ma- zipWithM_ (\k x -> assert (length xs == size h) $ unsafeWrite mba k x) [0.. size h -1] xs- return ma- newM h = MUnboxed h `liftM` new (size h)- newWithM h def = do- ma <- newM h- let (MUnboxed _ mba) = ma- forM_ [0 .. size h -1] $ \k -> unsafeWrite mba k def- return ma- readM (MUnboxed h mba) idx = assert (inBounds h idx) $ unsafeRead mba (linearIndex h idx)- writeM (MUnboxed h mba) idx elm =-#if ADPFUSION_DEBUGOUTPUT- (if inBounds h idx then id else traceShow ("writeM", h, idx, elm, size h, linearIndex h idx, inBounds h idx))-#endif- assert (inBounds h idx) $ unsafeWrite mba (linearIndex h idx) elm- {-# INLINE upperBoundM #-}- {-# INLINE fromListM #-}- {-# NoInline newM #-}- {-# INLINE newWithM #-}- {-# INLINE readM #-}- {-# INLINE writeM #-}+deriving instance Typeable (Dense v sh e) -instance (Index sh, Unbox elm) => PrimArrayOps Unboxed sh elm where- upperBound (Unboxed h _) = h- unsafeFreeze (MUnboxed h mba) = Unboxed h `liftM` G.unsafeFreeze mba- unsafeThaw (Unboxed h ba) = MUnboxed h `liftM` G.unsafeThaw ba- unsafeIndex (Unboxed h ba) idx = G.unsafeIndex ba (linearIndex h idx)- transformShape tr (Unboxed h ba) = Unboxed (tr h) ba- {-# INLINE upperBound #-}- {-# INLINE unsafeFreeze #-}- {-# INLINE unsafeThaw #-}- {-# INLINE unsafeIndex #-}- {-# INLINE transformShape #-}+deriving instance (Data (v e), Data (LimitType sh), Data e, Data sh, Typeable sh, Typeable e, Typeable v) ⇒ Data (Dense v sh e) -instance (Index sh, Unbox e, Unbox e') => PrimArrayMap Unboxed sh e e' where- map f (Unboxed h xs) = Unboxed h (VU.map f xs)- {-# INLINE map #-}+instance (Binary (LimitType sh), Binary (v e), Generic (LimitType sh), Generic (v e)) => Binary (Dense v sh e)+instance (Serialize (LimitType sh), Serialize (v e), Generic (LimitType sh), Generic (v e)) => Serialize (Dense v sh e)+instance (ToJSON (LimitType sh), ToJSON (v e), Generic (LimitType sh), Generic (v e)) => ToJSON (Dense v sh e)+instance (FromJSON (LimitType sh), FromJSON (v e), Generic (LimitType sh), Generic (v e)) => FromJSON (Dense v sh e)+instance (Hashable (LimitType sh), Hashable (v e), Generic (LimitType sh), Generic (v e)) => Hashable (Dense v sh e) +instance (NFData (LimitType sh), NFData (v e)) ⇒ NFData (Dense v sh e) where+ rnf (Dense h xs) = rnf h `seq` rnf xs+ {-# Inline rnf #-} --- * Boxed, multidimensional arrays. -data Boxed sh e = Boxed !(LimitType sh) !(V.Vector e)--deriving instance (Read (LimitType sh), Read e) ⇒ Read (Boxed sh e)-deriving instance (Show (LimitType sh), Show e) ⇒ Show (Boxed sh e)-deriving instance (Eq (LimitType sh), Eq e) ⇒ Eq (Boxed sh e)-deriving instance (Generic (LimitType sh), Generic e) ⇒ Generic (Boxed sh e)-deriving instance- ( Data sh, Data (LimitType sh)- , Data e- ) ⇒ Data (Boxed sh e)---instance (Binary (LimitType sh), Binary e, Unbox e, Generic (LimitType sh), Generic e) => Binary (Boxed sh e)-instance (Serialize (LimitType sh), Serialize e, Unbox e, Generic (LimitType sh), Generic e) => Serialize (Boxed sh e)-instance (ToJSON (LimitType sh), ToJSON e, Unbox e, Generic (LimitType sh), Generic e) => ToJSON (Boxed sh e)-instance (FromJSON (LimitType sh), FromJSON e, Unbox e, Generic (LimitType sh), Generic e) => FromJSON (Boxed sh e)-instance (Hashable (LimitType sh), Hashable e, Hashable (V.Vector e), Unbox e, Generic (LimitType sh), Generic e) => Hashable (Boxed sh e)--instance (NFData (LimitType sh), NFData e) => NFData (Boxed sh e) where- rnf (Boxed h xs) = rnf h `seq` rnf xs- {-# Inline rnf #-}--data instance MutArr m (Boxed sh e) = MBoxed !(LimitType sh) !(V.MVector (PrimState m) e)+data instance MutArr m (Dense v sh e) = MDense !(LimitType sh) !(VG.Mutable v (PrimState m) e) deriving (Generic,Typeable) -instance (NFData (LimitType sh)) => NFData (MutArr m (Boxed sh e)) where- rnf (MBoxed h xs) = rnf h -- no rnf for the data !+instance (Show (LimitType sh), Show (VG.Mutable v (PrimState m) e), VG.Mutable v (PrimState m) e ~ mv) ⇒ Show (MutArr m (Dense v sh e)) where+ show (MDense sh mv) = show (sh,mv)++instance (NFData (LimitType sh), NFData (VG.Mutable v (PrimState m) e), VG.Mutable v (PrimState m) e ~ mv) ⇒ NFData (MutArr m (Dense v sh e)) where+ rnf (MDense h xs) = rnf h `seq` rnf xs {-# Inline rnf #-} -instance (Index sh) => MPrimArrayOps Boxed sh elm where- upperBoundM (MBoxed h _) = h+instance+ ( Index sh, MutArr m (Dense v sh e) ~ mv+ , GM.MVector (VG.Mutable v) e+#if ADPFUSION_DEBUGOUTPUT+ , Show sh, Show (LimitType sh), Show e+#endif+ ) ⇒ MPrimArrayOps (Dense v) sh e where+ {-# Inline upperBoundM #-}+ upperBoundM (MDense h _) = h+ {-# Inline fromListM #-} fromListM h xs = do- ma <- newM h- let (MBoxed _ mba) = ma- zipWithM_ (\k x -> assert (length xs == size h) $ unsafeWrite mba k x) [0 .. size h - 1] xs+ ma ← newM h+ let (MDense _ mba) = ma+ SM.zipWithM_ (\k x → assert (length xs == size h) $ unsafeWrite mba k x) (SM.enumFromTo 0 (size h -1)) (SM.fromList xs) return ma- newM h =- MBoxed h `liftM` new (size h)+ {-# Inline newM #-} -- TODO was NoInline, check if anything breaks!+ newM h = MDense h `liftM` new (size h)+ {-# Inline newWithM #-} newWithM h def = do- ma <- newM h- let (MBoxed _ mba) = ma- forM_ [0 .. size h -1] $ \k -> unsafeWrite mba k def+ ma ← newM h+ let (MDense _ mba) = ma+ SM.mapM_ (\k → unsafeWrite mba k def) $ SM.enumFromTo 0 (size h -1) return ma- readM (MBoxed h mba) idx = assert (inBounds h idx) $ GM.unsafeRead mba (linearIndex h idx)- writeM (MBoxed h mba) idx elm = assert (inBounds h idx) $ GM.unsafeWrite mba (linearIndex h idx) elm- {-# INLINE upperBoundM #-}- {-# INLINE fromListM #-}- {-# NoInline newM #-}- {-# INLINE newWithM #-}- {-# INLINE readM #-}- {-# INLINE writeM #-}+ {-# Inline readM #-}+ readM (MDense h mba) idx = assert (inBounds h idx) $ unsafeRead mba (linearIndex h idx)+ {-# Inline writeM #-}+ writeM (MDense h mba) idx elm =+#if ADPFUSION_DEBUGOUTPUT+ (if inBounds h idx then id else traceShow ("writeM", h, idx, elm, size h, linearIndex h idx, inBounds h idx))+#endif+ assert (inBounds h idx) $ unsafeWrite mba (linearIndex h idx) elm -instance (Index sh) => PrimArrayOps Boxed sh elm where- upperBound (Boxed h _) = h- unsafeFreeze (MBoxed h mba) = Boxed h `liftM` G.unsafeFreeze mba- unsafeThaw (Boxed h ba) = MBoxed h `liftM` G.unsafeThaw ba- unsafeIndex (Boxed h ba) idx = assert (inBounds h idx) $ G.unsafeIndex ba (linearIndex h idx)- transformShape tr (Boxed h ba) = Boxed (tr h) ba- {-# INLINE upperBound #-}- {-# INLINE unsafeFreeze #-}- {-# INLINE unsafeThaw #-}- {-# INLINE unsafeIndex #-}- {-# INLINE transformShape #-}+instance (Index sh, VG.Vector v e) ⇒ PrimArrayOps (Dense v) sh e where+ {-# Inline upperBound #-}+ upperBound (Dense h _) = h+ {-# Inline unsafeFreeze #-}+ unsafeFreeze (MDense h mba) = Dense h `liftM` VG.unsafeFreeze mba+ {-# Inline unsafeThaw #-}+ unsafeThaw (Dense h ba) = MDense h `liftM` VG.unsafeThaw ba+ {-# Inline unsafeIndex #-}+ unsafeIndex (Dense h ba) idx = VG.unsafeIndex ba (linearIndex h idx)+ {-# Inline transformShape #-}+ transformShape tr (Dense h ba) = Dense (tr h) ba -instance (Index sh) => PrimArrayMap Boxed sh e e' where- map f (Boxed h xs) = Boxed h (V.map f xs)- {-# INLINE map #-}+instance (Index sh, VG.Vector v e, VG.Vector v e') ⇒ PrimArrayMap (Dense v) sh e e' where+ map f (Dense h xs) = Dense h (VG.map f xs)+ {-# Inline map #-}