diff --git a/Data/Array/Repa/Index/Outside.hs b/Data/Array/Repa/Index/Outside.hs --- a/Data/Array/Repa/Index/Outside.hs +++ b/Data/Array/Repa/Index/Outside.hs @@ -27,7 +27,7 @@ import Test.QuickCheck.All import Data.Array.Repa.ExtShape -import Data.Array.Repa.Index.Subword hiding (upperTri, subwordIndex, subwordFromIndex) +import Data.Array.Repa.Index.Subword hiding (upperTri, subwordIndex, subwordFromIndex,stage) import qualified Data.Array.Repa.Index.Subword as SW diff --git a/Data/Array/Repa/Index/Points.hs b/Data/Array/Repa/Index/Points.hs --- a/Data/Array/Repa/Index/Points.hs +++ b/Data/Array/Repa/Index/Points.hs @@ -47,6 +47,7 @@ -- | A point in right-linear grammars. newtype PointR = PointR (Int:.Int) + deriving (Eq,Read,Show) pointR :: Int -> Int -> PointR pointR i j = PointR (i:.j) @@ -54,18 +55,13 @@ --- * Instances +-- * Instances: PointL derivingUnbox "PointL" [t| PointL -> (Int,Int) |] [| \ (PointL (i:.j)) -> (i,j) |] [| \ (i,j) -> PointL (i:.j) |] -derivingUnbox "PointR" - [t| PointR -> (Int,Int) |] - [| \ (PointR (i:.j)) -> (i,j) |] - [| \ (i,j) -> PointR (i:.j) |] - instance Shape sh => Shape (sh :. PointL) where {-# INLINE [1] rank #-} rank (sh :. _) @@ -148,6 +144,96 @@ | otherwise = [] instance Arbitrary z => Arbitrary (z:.PointL) where + arbitrary = (:.) <$> arbitrary <*> arbitrary + shrink (z:.s) = (:.) <$> shrink z <*> shrink s + + + +-- * Instances: PointR + +derivingUnbox "PointR" + [t| PointR -> (Int,Int) |] + [| \ (PointR (i:.j)) -> (i,j) |] + [| \ (i,j) -> PointR (i:.j) |] + +instance Shape sh => Shape (sh :. PointR) where + {-# INLINE [1] rank #-} + rank (sh :. _) + = rank sh + 1 + + {-# INLINE [1] zeroDim #-} + zeroDim = zeroDim :. PointR (0:.0) + + {-# INLINE [1] unitDim #-} + unitDim = unitDim :. PointR (0:.1) + + {-# INLINE [1] intersectDim #-} + intersectDim (sh1 :. PointR (i:.j)) (sh2 :. PointR (k:.l)) + = (intersectDim sh1 sh2 :. PointR (max i k :. min j l)) + + {-# INLINE [1] addDim #-} + addDim (sh1 :. PointR (i:.j)) (sh2 :. PointR (k:.l)) + = addDim sh1 sh2 :. PointR (i+k:.j+l) + + -- NOTE size is calculated NOT as upper-triangular, but linear! + {-# INLINE [1] size #-} + size (sh1 :. PointR (i:.j)) = size sh1 * (j-i) + + {-# INLINE [1] sizeIsValid #-} + sizeIsValid (sh1 :. PointR (i:.j)) + | size sh1 > 0 + = i>=0 && i<=j && j <= maxBound `div` size sh1 + | otherwise + = False + + -- NOTE only the @i@ coordinate is used for indexing NTs, @j@ is just for + -- convenience. @l@ however restricts the NT to some value @>0@ if desired. + {-# INLINE [1] toIndex #-} + toIndex (sh1 :. PointR(l:.r)) (sh1' :. PointR(i:.j)) + = toIndex sh1 sh1' * (r-l) + i + + {-# INLINE [1] fromIndex #-} + fromIndex (ds :. d) n = undefined -- fromIndex ds (n `quotInt` d) :. r + where + r = undefined + + -- | TODO fix for lower bounds check! + {-# INLINE [1] inShapeRange #-} + inShapeRange (zs :. PointR (_:._)) (sh1 :. PointR (l:.n)) (sh2 :. PointR (i:.j)) + = i<=j && l<=i && j error $ stage ++ ".toList: empty list when converting to (_ :. Int)" + [x] -> error $ stage ++ ".toList: only single element remaining!" + i:j:xs -> shapeOfList xs :. PointR (i:.j) + + {-# INLINE deepSeq #-} + deepSeq (sh :. n) x = deepSeq sh (n `seq` x) + +instance ExtShape sh => ExtShape (sh:.PointR) where + {-# INLINE [1] subDim #-} + subDim (sh1:.PointR (i:.j)) (sh2:.PointR (k:.l)) = subDim sh1 sh2 :. PointR (i-k:.j-l) + {-# INLINE [1] rangeList #-} + rangeList _ _ = error "PointR:rangeList not implemented" + +instance NFData PointR where + rnf (PointR (i:.j)) = i `seq` rnf j + {-# INLINE rnf #-} + +instance Arbitrary PointR where + arbitrary = do + b <- choose (0,100) + return $ pointR b 100 + shrink (PointR (i:.j)) + | i Arbitrary (z:.PointR) where arbitrary = (:.) <$> arbitrary <*> arbitrary shrink (z:.s) = (:.) <$> shrink z <*> shrink s diff --git a/Data/PrimitiveArray/Zero.hs b/Data/PrimitiveArray/Zero.hs --- a/Data/PrimitiveArray/Zero.hs +++ b/Data/PrimitiveArray/Zero.hs @@ -33,7 +33,7 @@ data Unboxed sh e = Unboxed !sh !(VU.Vector e) deriving (Read,Show,Eq) -data instance MutArr m (Unboxed sh e) = MUnboxed !sh (VU.MVector (PrimState m) e) +data instance MutArr m (Unboxed sh e) = MUnboxed !sh !(VU.MVector (PrimState m) e) instance (Shape sh, ExtShape sh, VUM.Unbox elm) => MPrimArrayOps Unboxed sh elm where boundsM (MUnboxed exUb _) = (zeroDim,exUb `subDim` unitDim) @@ -80,7 +80,7 @@ data Boxed sh e = Boxed !sh !(V.Vector e) deriving (Read,Show,Eq) -data instance MutArr m (Boxed sh e) = MBoxed !sh (V.MVector (PrimState m) e) +data instance MutArr m (Boxed sh e) = MBoxed !sh !(V.MVector (PrimState m) e) instance (Shape sh, ExtShape sh, VUM.Unbox elm) => MPrimArrayOps Boxed sh elm where boundsM (MBoxed exUb _) = (zeroDim,exUb `subDim` unitDim) diff --git a/PrimitiveArray.cabal b/PrimitiveArray.cabal --- a/PrimitiveArray.cabal +++ b/PrimitiveArray.cabal @@ -1,10 +1,10 @@ Name: PrimitiveArray -Version: 0.5.3.0 +Version: 0.5.4.0 License: BSD3 License-file: LICENSE Author: Christian Hoener zu Siederdissen Maintainer: choener@tbi.univie.ac.at -Copyright: Christian Hoener zu Siederdissen, 2010-2013 +Copyright: Christian Hoener zu Siederdissen, 2010-2014 Homepage: http://www.tbi.univie.ac.at/~choener/ Stability: Experimental Category: Data @@ -19,6 +19,9 @@ bounds-checking or other sanity-checking is performed. Operations are aimed toward efficiency as much as possible. +extra-source-files: + changelog + Library Exposed-modules: Data.Array.Repa.ExtShape @@ -41,7 +44,6 @@ ghc-options: -O2 -funbox-strict-fields - source-repository head type: git diff --git a/changelog b/changelog new file mode 100644 --- /dev/null +++ b/changelog @@ -0,0 +1,9 @@ +0.5.4.0 + +- actually implemented PointR + +- added the rather important strictness annotation for mutable arrays in .Zero + +0.5.3.0 + +- fixed vector-th-unbox problem