diff --git a/Data/PrimitiveArray/Dense.hs b/Data/PrimitiveArray/Dense.hs --- a/Data/PrimitiveArray/Dense.hs +++ b/Data/PrimitiveArray/Dense.hs @@ -45,13 +45,15 @@ instance (ToJSON sh, ToJSON e, Unbox e) => ToJSON (Unboxed sh e) instance (FromJSON sh, FromJSON e, Unbox e) => FromJSON (Unboxed sh e) -instance NFData (Unboxed sh e) where - rnf !_ = () +instance (NFData sh) => NFData (Unboxed sh e) where + rnf (Unboxed l h xs) = rnf l `seq` rnf h `seq` rnf xs + {-# Inline rnf #-} data instance MutArr m (Unboxed sh e) = MUnboxed !sh !sh !(VU.MVector (PrimState m) e) -instance NFData (MutArr m (Unboxed sh e)) where - rnf !_ = () +instance (NFData sh) => NFData (MutArr m (Unboxed sh e)) where + rnf (MUnboxed l h xs) = rnf l `seq` rnf h `seq` rnf xs + {-# Inline rnf #-} instance (Index sh, Unbox elm) => MPrimArrayOps Unboxed sh elm where boundsM (MUnboxed l h _) = (l,h) @@ -103,13 +105,15 @@ instance (ToJSON sh, ToJSON e) => ToJSON (Boxed sh e) instance (FromJSON sh, FromJSON e) => FromJSON (Boxed sh e) -instance NFData (Boxed sh e) where - rnf !_ = () +instance (NFData sh, NFData e) => NFData (Boxed sh e) where + rnf (Boxed l h xs) = rnf l `seq` rnf h `seq` rnf xs + {-# Inline rnf #-} data instance MutArr m (Boxed sh e) = MBoxed !sh !sh !(V.MVector (PrimState m) e) -instance NFData (MutArr m (Boxed sh e)) where - rnf !_ = () +instance (NFData sh) => NFData (MutArr m (Boxed sh e)) where + rnf (MBoxed l h _) = rnf l `seq` rnf h -- no rnf for the data ! + {-# Inline rnf #-} instance (Index sh) => MPrimArrayOps Boxed sh elm where boundsM (MBoxed l h _) = (l,h) diff --git a/Data/PrimitiveArray/Index.hs b/Data/PrimitiveArray/Index.hs --- a/Data/PrimitiveArray/Index.hs +++ b/Data/PrimitiveArray/Index.hs @@ -4,6 +4,7 @@ , module Data.PrimitiveArray.Index.Complement , module Data.PrimitiveArray.Index.Int , module Data.PrimitiveArray.Index.Outside + , module Data.PrimitiveArray.Index.PhantomInt , module Data.PrimitiveArray.Index.Point , module Data.PrimitiveArray.Index.Set , module Data.PrimitiveArray.Index.Subword @@ -13,6 +14,7 @@ import Data.PrimitiveArray.Index.Complement import Data.PrimitiveArray.Index.Int import Data.PrimitiveArray.Index.Outside +import Data.PrimitiveArray.Index.PhantomInt import Data.PrimitiveArray.Index.Point import Data.PrimitiveArray.Index.Set import Data.PrimitiveArray.Index.Subword diff --git a/Data/PrimitiveArray/Index/PhantomInt.hs b/Data/PrimitiveArray/Index/PhantomInt.hs new file mode 100644 --- /dev/null +++ b/Data/PrimitiveArray/Index/PhantomInt.hs @@ -0,0 +1,76 @@ + +-- | A linear 0-based int-index with a phantom type. + +module Data.PrimitiveArray.Index.PhantomInt where + +import Control.DeepSeq (NFData(..)) +import Data.Aeson (FromJSON,ToJSON) +import Data.Binary (Binary) +import Data.Data +import Data.Ix(Ix) +import Data.Serialize (Serialize) +import Data.Typeable +import Data.Vector.Fusion.Stream.Monadic (flatten,map,Step(..)) +import Data.Vector.Fusion.Stream.Size +import Data.Vector.Unboxed.Deriving +import GHC.Generics (Generic) +import Prelude hiding (map) + +import Data.PrimitiveArray.Index.Class + + + +-- | A 'PInt' behaves exactly like an @Int@, but has an attached phantom +-- type @p@. In particular, the @Index@ and @IndexStream@ instances are the +-- same as for raw @Int@s. + +newtype PInt p = PInt { getPInt :: Int } + deriving (Read,Show,Eq,Ord,Enum,Num,Integral,Real,Generic,Data,Typeable,Ix) + + +derivingUnbox "PInt" + [t| forall p . PInt p -> Int |] [| getPInt |] [| PInt |] + +instance Binary (PInt p) +instance Serialize (PInt p) +instance FromJSON (PInt p) +instance ToJSON (PInt p) + +instance NFData (PInt p) + +instance Index (PInt p) where + linearIndex _ _ (PInt k) = k + {-# Inline linearIndex #-} + smallestLinearIndex _ = error "still needed?" + {-# Inline smallestLinearIndex #-} + largestLinearIndex (PInt h) = h + {-# Inline largestLinearIndex #-} + size _ (PInt h) = h+1 + {-# Inline size #-} + inBounds l h k = l <= k && k <= h + {-# Inline inBounds #-} + +instance IndexStream z => IndexStream (z:.(PInt p)) where + streamUp (ls:.l) (hs:.h) = flatten mk step Unknown $ streamUp ls hs + where mk z = return (z,l) + step (z,k) + | k > h = return $ Done + | otherwise = return $ Yield (z:.k) (z,k+1) + {-# Inline [0] mk #-} + {-# Inline [0] step #-} + {-# Inline streamUp #-} + streamDown (ls:.l) (hs:.h) = flatten mk step Unknown $ streamDown ls hs + where mk z = return (z,h) + step (z,k) + | k < l = return $ Done + | otherwise = return $ Yield (z:.k) (z,k-1) + {-# Inline [0] mk #-} + {-# Inline [0] step #-} + {-# Inline streamDown #-} + +instance IndexStream (PInt p) where + streamUp l h = map (\(Z:.k) -> k) $ streamUp (Z:.l) (Z:.h) + {-# Inline streamUp #-} + streamDown l h = map (\(Z:.k) -> k) $ streamDown (Z:.l) (Z:.h) + {-# Inline streamDown #-} + diff --git a/Data/PrimitiveArray/Index/Subword.hs b/Data/PrimitiveArray/Index/Subword.hs --- a/Data/PrimitiveArray/Index/Subword.hs +++ b/Data/PrimitiveArray/Index/Subword.hs @@ -86,7 +86,7 @@ {-# Inline linearIndex #-} smallestLinearIndex _ = error "still needed?" {-# Inline smallestLinearIndex #-} - largestLinearIndex = upperTri + largestLinearIndex h = upperTri h -1 {-# Inline largestLinearIndex #-} size _ h = upperTri h {-# Inline size #-} diff --git a/PrimitiveArray.cabal b/PrimitiveArray.cabal --- a/PrimitiveArray.cabal +++ b/PrimitiveArray.cabal @@ -1,11 +1,13 @@ Name: PrimitiveArray -Version: 0.6.0.0 +Version: 0.6.1.0 License: BSD3 License-file: LICENSE Maintainer: choener@bioinf.uni-leipzig.de author: Christian Hoener zu Siederdissen, 2011-2015 copyright: Christian Hoener zu Siederdissen, 2011-2015 homepage: http://www.bioinf.uni-leipzig.de/Software/gADP/ +homepage: https://github.com/choener/PrimitiveArray +bug-reports: https://github.com/choener/PrimitiveArray/issues Stability: Experimental Category: Data Build-type: Simple @@ -46,24 +48,26 @@ Data.PrimitiveArray.Index.Complement Data.PrimitiveArray.Index.Int Data.PrimitiveArray.Index.Outside + Data.PrimitiveArray.Index.PhantomInt Data.PrimitiveArray.Index.Point Data.PrimitiveArray.Index.Set Data.PrimitiveArray.Index.Subword Data.PrimitiveArray.QuickCheck.Index.Set build-depends: base >= 4.7 && < 4.9 - , aeson == 0.8.* - , binary == 0.7.* - , bits == 0.4.* - , cereal == 0.4.* + , aeson >= 0.8 && < 0.10 + , binary >= 0.7 && < 0.8 + , bits >= 0.4 && < 0.5 + , cereal >= 0.4 && < 0.5 , deepseq >= 1.3 && < 1.5 - , OrderedBits == 0.0.0.* + , OrderedBits >= 0.0.0.1 && < 0.0.1.0 , primitive >= 0.5.4 && < 0.7 , QuickCheck >= 2.7 && < 2.9 - , vector == 0.10.* - , vector-binary-instances == 0.2.* - , vector-th-unbox == 0.2.* + , vector >= 0.10 && < 0.11 + , vector-binary-instances >= 0.2 && < 0.3 + , vector-th-unbox >= 0.2 && < 0.3 default-extensions: BangPatterns , DefaultSignatures + , DeriveDataTypeable , DeriveGeneric , FlexibleContexts , FlexibleInstances diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,8 @@ +[![Build Status](https://travis-ci.org/choener/PrimitiveArray.svg?branch=master)](https://travis-ci.org/choener/PrimitiveArray) + # PrimitiveArray -[![Build Status](https://travis-ci.org/choener/PrimitiveArray.svg?branch=master)](https://travis-ci.org/choener/PrimitiveArray) +[*generalized ADPfusion Homepage*](http://www.bioinf.uni-leipzig.de/Software/gADP/) PrimitiveArray provides operations on multi-dimensional arrays. Internally, the representation is based on the vector library, while the multi-dimensional @@ -12,7 +14,8 @@ #### Contact -Christian Hoener zu Siederdissen -choener@bioinf.uni-leipzig.de -http://www.bioinf.uni-leipzig.de/~choener/ +Christian Hoener zu Siederdissen +Leipzig University, Leipzig, Germany +choener@bioinf.uni-leipzig.de +http://www.bioinf.uni-leipzig.de/~choener/ diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,8 +1,14 @@ +0.6.1.0 +------- + +- OrderedBits < 0.0.1 +- travis.yml update + 0.6.0.0 ------- - moved primitive array classes to Data.PrimitiveArray.Class -- added _from / _to lenses +- added from / to lenses - Field1 .. Field6 lenses for indices (Z:.a:.b...) (with Z being Field0) - lens stuff currently commented out; aiming to have an extra package [lens is fairly heavy] diff --git a/tests/properties.hs b/tests/properties.hs --- a/tests/properties.hs +++ b/tests/properties.hs @@ -4,11 +4,13 @@ import Test.Framework.Providers.QuickCheck2 import Test.Framework.TH --- import qualified Data.Bits.Ordered.QuickCheck as QC +import qualified Data.PrimitiveArray.QuickCheck.Index.Set as QCS --- prop_PopCountSet = QC.prop_PopCountSet +-- prop_Fixed_BitSet_setSucc = QCS.prop_Fixed_BitSet_setSucc + + main :: IO () main = $(defaultMainGenerator)