uvector 0.1.0.3 → 0.1.0.4
raw patch · 22 files changed
+1307/−217 lines, 22 files
Files
- Data/Array/Vector.hs +26/−15
- Data/Array/Vector/Prim/BUArr.hs +64/−17
- Data/Array/Vector/Prim/Hyperstrict.hs +24/−0
- Data/Array/Vector/Stream.hs +4/−3
- Data/Array/Vector/Strict/Basics.hs +118/−50
- Data/Array/Vector/Strict/Enum.hs +22/−2
- Data/Array/Vector/Strict/Permute.hs +6/−1
- Data/Array/Vector/Strict/Stream.hs +5/−4
- Data/Array/Vector/Strict/Sums.hs +22/−14
- Data/Array/Vector/UArr.hs +171/−27
- LICENSE +1/−1
- TODO +20/−0
- cbits/memcpy_extra.c +13/−0
- cbits/memcpy_extra.h +7/−0
- tests/Examples/Test.hs +8/−1
- tests/Fusion/Test.hs +8/−1
- tests/Makefile +12/−4
- tests/Properties/Monomorphic/UVector.hs +17/−16
- tests/Properties/Specific.hs +265/−0
- tests/Properties/Test.hs +346/−40
- tests/Properties/Utils.hs +133/−12
- uvector.cabal +15/−9
Data/Array/Vector.hs view
@@ -1,27 +1,31 @@------------------------------------------------------------------------------+------------------------------------------------------------------------------ -- | -- Module : Data.Array.Vector -- Copyright : (c) [2001..2002] Manuel M T Chakravarty & Gabriele Keller -- (c) 2006 Manuel M T Chakravarty & Roman Leshchinskiy -- (c) 2008 Don Stewart-+-- -- License : see LICENSE -- -- Maintainer : Don Stewart -- Portability : See .cabal file ----- Description --------------------------------------------------------------- -- -- The top level interface to operations on strict, non-nested, fusible arrays. --+-- Note that the time complexities provided for functions in this package depend+-- on fusion. Thus the times given assume that fusion did not occur and that+-- the full operation is performed. In some cases fusion can take multiple /O(n)/+-- operations on UArrs and optimize them out of the generated code completely. --+------------------------------------------------------------------------------ module Data.Array.Vector ( -- * Array classes UA, - -- * The pure and mutable array types+ -- (*) The pure and mutable array types UArr, MUArr, -- * Streaming pure arrays@@ -51,7 +55,7 @@ -- * Transforming UArrs mapU, - -- * Reducing 'UArr's (folds)+ -- * Reducing UArrs (folds) foldU, fold1U, fold1MaybeU,@@ -86,9 +90,14 @@ mapAccumLU, -- ** Generating UArrs+ iterateU, replicateU, replicateEachU, + -- ** Unfolding UArrs++ unfoldU, + -- * Subarrays -- ** Breaking arrays@@ -110,10 +119,10 @@ -- ** Searching with a predicate filterU, findU,+ findIndexU, - -- * Indexing UArr+ -- * Indexing UArrs indexU,- findIndexU, lookupU, -- * Zipping and unzipping@@ -131,15 +140,15 @@ enumFromStepLenU, enumFromToEachU, - -- * Low level conversions-+{- -- * Low level conversions -- ** Copying arrays- -- ** Packing 'CString's and pointers- -- ** Using UArrs as 'CString's- -- * I\/O with 'UArr's+ -- ** Packing CStrings and pointers+ -- ** Using UArrs as CStrings+ -- * I\/O with UArrs -- creating them, generating new arrays from old ones.+-} ------------------------------------------------------------------------ @@ -148,8 +157,9 @@ indexedU, repeatU, +{- -- * Permutations- -- permuteU, bpermuteU, bpermuteDftU, reverseU, updateU,+ -- permuteU, bpermuteU, bpermuteDftU, reverseU, updateU, -- * Searching {- indexOfU,-}@@ -159,8 +169,7 @@ -- * Random arrays -- randomU, randomRU,-- unfoldU,+-} -- * I\/O UIO(..),@@ -168,6 +177,8 @@ -- * Operations on mutable arrays newU, lengthMU, newMU, readMU, writeMU, unsafeFreezeMU, unsafeFreezeAllMU, copyMU, permuteMU, atomicUpdateMU, unstreamMU,+ memcpyMU, memcpyOffMU, memmoveOffMU,+ unsafeZipMU, unsafeUnzipMU, module Data.Array.Vector.Prim.Hyperstrict
Data/Array/Vector/Prim/BUArr.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE ForeignFunctionInterface #-} #include "MachDeps.h" @@ -62,6 +63,9 @@ lengthMBU, newMBU, extractMBU, copyMBU, unsafeFreezeMBU, unsafeFreezeAllMBU, + -- * Fast copying of mutable arrays+ memcpyMBU, memcpyOffMBU, memmoveOffMBU,+ -- * Basic operations lengthBU, emptyBU, replicateBU, sliceBU, extractBU, @@ -228,7 +232,46 @@ unsafeFreezeAllMBU (MBUArr m mba#) = ST $ \s# -> (# s#, BUArr 0 m (unsafeCoerce# mba#) #) +foreign import ccall unsafe "string.h memcpy"+ memcpy :: MutableByteArray# s -> MutableByteArray# s -> CInt -> IO (Ptr a) +foreign import ccall unsafe "memcpy_extra.h memcpy_offset"+ memcpyOffset :: MutableByteArray# s -> MutableByteArray# s -> CInt -> CInt -> CInt -> IO ()++foreign import ccall unsafe "memcpy_extra.h memmove_offset"+ memmoveOffset :: MutableByteArray# s -> MutableByteArray# s -> CInt -> CInt -> CInt -> IO ()++-- | Copy values from one mutable array to another.+memcpyMBU :: forall s e. UAE e => MBUArr s e -> MBUArr s e -> Int -> ST s ()+memcpyMBU (MBUArr _ src) (MBUArr _ dst) l+ = ST (\s -> case memcpy dst src (fromIntegral len) of+ IO m -> case unsafeCoerce# m s of+ (# s, _ #) -> (# s, () #))+ where+ len = sizeBU l (undefined :: e)+{-# inline memcpyMBU #-}++memcpyOffMBU :: forall s e. UAE e => MBUArr s e -> MBUArr s e -> Int -> Int -> Int -> ST s ()+memcpyOffMBU (MBUArr _ src) (MBUArr _ dst) s d l+ = ST (\s -> case memcpyOffset dst src (fromIntegral dOff) (fromIntegral sOff) (fromIntegral len) of+ IO m -> unsafeCoerce# m s)+ where+ sOff = sizeBU s (undefined :: e)+ dOff = sizeBU d (undefined :: e)+ len = sizeBU l (undefined :: e)+{-# INLINE memcpyOffMBU #-}++memmoveOffMBU :: forall s e. UAE e => MBUArr s e -> MBUArr s e -> Int -> Int -> Int -> ST s ()+memmoveOffMBU (MBUArr _ src) (MBUArr _ dst) s d l+ = ST (\s -> case memmoveOffset dst src (fromIntegral dOff) (fromIntegral sOff) (fromIntegral len) of+ IO m -> unsafeCoerce# m s)+ where+ sOff = sizeBU s (undefined :: e)+ dOff = sizeBU d (undefined :: e)+ len = sizeBU l (undefined :: e)+{-# INLINE memmoveOffMBU #-}++ -- |Instances of unboxed arrays -- - @@ -324,7 +367,7 @@ (# s2#, () #)} instance UAE Int where- sizeBU (I# n#) _ = I# (wORD_SCALE n#)+ sizeBU (I# n#) _ = I# (iINT_SCALE n#) {-# INLINE indexBU #-} indexBU (BUArr (I# s#) n ba#) i@(I# i#) =@@ -416,7 +459,7 @@ (# s2#, () #)} instance UAE Word8 where- sizeBU (I# n#) _ = I# (wORD_SCALE n#)+ sizeBU (I# n#) _ = I# (wORD8_SCALE n#) {-# INLINE indexBU #-} indexBU (BUArr (I# s#) n ba#) i@(I# i#) =@@ -439,7 +482,7 @@ (# s2#, () #)} instance UAE Word16 where- sizeBU (I# n#) _ = I# (wORD_SCALE n#)+ sizeBU (I# n#) _ = I# (wORD16_SCALE n#) {-# INLINE indexBU #-} indexBU (BUArr (I# s#) n ba#) i@(I# i#) =@@ -462,7 +505,7 @@ (# s2#, () #)} instance UAE Word32 where- sizeBU (I# n#) _ = I# (wORD_SCALE n#)+ sizeBU (I# n#) _ = I# (wORD32_SCALE n#) {-# INLINE indexBU #-} indexBU (BUArr (I# s#) n ba#) i@(I# i#) =@@ -485,7 +528,7 @@ (# s2#, () #)} instance UAE Word64 where- sizeBU (I# n#) _ = I# (wORD_SCALE n#)+ sizeBU (I# n#) _ = I# (wORD64_SCALE n#) {-# INLINE indexBU #-} indexBU (BUArr (I# s#) n ba#) i@(I# i#) =@@ -508,7 +551,7 @@ (# s2#, () #)} instance UAE Int8 where- sizeBU (I# n#) _ = I# (wORD_SCALE n#)+ sizeBU (I# n#) _ = I# (iNT8_SCALE n#) {-# INLINE indexBU #-} indexBU (BUArr (I# s#) n ba#) i@(I# i#) =@@ -531,7 +574,7 @@ (# s2#, () #)} instance UAE Int16 where- sizeBU (I# n#) _ = I# (wORD_SCALE n#)+ sizeBU (I# n#) _ = I# (iNT16_SCALE n#) {-# INLINE indexBU #-} indexBU (BUArr (I# s#) n ba#) i@(I# i#) =@@ -554,7 +597,7 @@ (# s2#, () #)} instance UAE Int32 where- sizeBU (I# n#) _ = I# (wORD_SCALE n#)+ sizeBU (I# n#) _ = I# (iNT32_SCALE n#) {-# INLINE indexBU #-} indexBU (BUArr (I# s#) n ba#) i@(I# i#) =@@ -577,7 +620,7 @@ (# s2#, () #)} instance UAE Int64 where- sizeBU (I# n#) _ = I# (wORD_SCALE n#)+ sizeBU (I# n#) _ = I# (iNT64_SCALE n#) {-# INLINE indexBU #-} indexBU (BUArr (I# s#) n ba#) i@(I# i#) =@@ -799,10 +842,9 @@ hGetBU :: forall e. UAE e => Handle -> IO (BUArr e) hGetBU h =- alloca $ \iptr -> do- hGetBuf h iptr (sizeOf (undefined :: Int))- n <- peek iptr+ let elemSize = sizeBU 1 (undefined :: e)+ n <- fmap ((`div`elemSize) . fromInteger) $ hFileSize h marr@(MBUArr _ marr#) <- stToIO (newMBU n) let bytes = sizeBU n (undefined :: e) wantReadableHandle "hGetBU" h $@@ -833,10 +875,7 @@ hPutBU :: forall e. UAE e => Handle -> BUArr e -> IO () hPutBU h arr@(BUArr i n arr#) =- alloca $ \iptr -> do- poke iptr n- hPutBuf h iptr (sizeOf n) wantWritableHandle "hPutBU" h $ \handle@Handle__{ haFD=fd, haBuffer=ref, haIsStream=stream } -> do old_buf <- readIORef ref@@ -858,16 +897,24 @@ -- Translation between elements and bytes -- Duplicated here from Data.Array.Base to avoid build dependency -cHAR_SCALE, wORD_SCALE, dOUBLE_SCALE, fLOAT_SCALE :: Int# -> Int#+cHAR_SCALE, wORD_SCALE, iINT_SCALE, dOUBLE_SCALE, fLOAT_SCALE :: Int# -> Int# cHAR_SCALE n# = scale# *# n# where I# scale# = SIZEOF_HSCHAR+iINT_SCALE n# = scale# *# n# where I# scale# = SIZEOF_HSINT wORD_SCALE n# = scale# *# n# where I# scale# = SIZEOF_HSWORD dOUBLE_SCALE n# = scale# *# n# where I# scale# = SIZEOF_HSDOUBLE fLOAT_SCALE n# = scale# *# n# where I# scale# = SIZEOF_HSFLOAT -wORD16_SCALE, wORD32_SCALE, wORD64_SCALE :: Int# -> Int#+wORD8_SCALE, wORD16_SCALE, wORD32_SCALE, wORD64_SCALE :: Int# -> Int#+wORD8_SCALE n# = scale# *# n# where I# scale# = SIZEOF_WORD8 wORD16_SCALE n# = scale# *# n# where I# scale# = SIZEOF_WORD16 wORD32_SCALE n# = scale# *# n# where I# scale# = SIZEOF_WORD32 wORD64_SCALE n# = scale# *# n# where I# scale# = SIZEOF_WORD64++iNT8_SCALE, iNT16_SCALE, iNT32_SCALE, iNT64_SCALE :: Int# -> Int#+iNT8_SCALE n# = scale# *# n# where I# scale# = SIZEOF_INT8+iNT16_SCALE n# = scale# *# n# where I# scale# = SIZEOF_INT16+iNT32_SCALE n# = scale# *# n# where I# scale# = SIZEOF_INT32+iNT64_SCALE n# = scale# *# n# where I# scale# = SIZEOF_INT64 bOOL_SCALE, bOOL_WORD_SCALE :: Int# -> Int# bOOL_SCALE n# = (n# +# last#) `uncheckedIShiftRA#` 3#
Data/Array/Vector/Prim/Hyperstrict.hs view
@@ -27,11 +27,13 @@ -- * Strict Maybe MaybeS(..), maybeS, fromMaybeS, +{- -- * Lazy wrapper -- Lazy(..), -- * Class of hyperstrict types -- HS+-} ) where infixl 2 :*:@@ -39,23 +41,35 @@ -- |Strict pair data (:*:) a b = !a :*: !b deriving(Eq,Ord,Show,Read) +-- |Analog to 'fst' in regular pairs.+-- fstS :: a :*: b -> a fstS (x :*: _) = x {-# INLINE fstS #-} +-- |Analog to 'snd' in regular pairs.+-- sndS :: a :*: b -> b sndS (_ :*: y) = y +-- |Converts a pair to a strict pair.+-- pairS :: (a,b) -> a :*: b pairS = uncurry (:*:) +-- |Converts a strict pair to a pair.+-- unpairS :: a :*: b -> (a,b) unpairS (x :*: y) = (x,y) +-- |Analogous to 'curry' in regular pairs.+-- curryS :: (a :*: b -> c) -> a -> b -> c curryS f x y = f (x :*: y) {-# INLINE curryS #-} +-- |Analogous to 'uncurry' in regular pairs.+-- uncurryS :: (a -> b -> c) -> a :*: b -> c uncurryS f (x :*: y) = f x y {-# INLINE uncurryS #-}@@ -72,6 +86,9 @@ "unsafe_unpairS/unsafe_pairS" forall p. unsafe_unpairS (unsafe_pairS p) = p+ +"unsafe_pairS/unsafe_unpairS" forall p.+ unsafe_pairS (unsafe_unpairS p) = p #-} -- |Strict sum@@ -79,6 +96,7 @@ -- |Strict Maybe data MaybeS a = NothingS | JustS !a+ deriving (Show, Read, Eq) instance Functor MaybeS where fmap f (JustS x) = JustS (f x)@@ -89,10 +107,16 @@ -- -- return _|_ >>= const Nothing = _|_ /= const Nothing _|_ +-- |/O(1)/. @'maybeS' n f m@ is the catamorphism for 'MaybeS', returning @n@ if +-- @m@ is 'NothingS', and applying @f@ to the value wrapped in 'JustS' otherwise.+-- maybeS :: b -> (a -> b) -> MaybeS a -> b maybeS b f (JustS a) = f a maybeS b f NothingS = b +-- |/O(1)/. @'fromMaybeS' n m@ returns @n@ if @m@ is 'NothingS' and the value+-- wrapped in 'JustS' otherwise.+-- fromMaybeS :: a -> MaybeS a -> a fromMaybeS x (JustS y) = y fromMaybeS x NothingS = x
Data/Array/Vector/Stream.hs view
@@ -430,7 +430,7 @@ case next1 s of Done -> Done Skip s' -> Skip (s' :*: t1 :*: t2 )- Yield c s' -> if trace ("\n\t\tstream: " ++ (show c) ++ "\n") c+ Yield c s' -> if {-trace ("\n\t\tstream: " ++ (show c) ++ "\n")-} c then case nextS1 t1 of Done -> error "combineS: stream 1 terminated unexpectedly" Skip t1' -> Skip (s :*: t1' :*: t2)@@ -517,7 +517,7 @@ enumFromToFracS :: (Ord a, RealFrac a) => a -> a -> Stream a {-# INLINE_STREAM enumFromToFracS #-}-enumFromToFracS n m = Stream next n (truncate (m - n))+enumFromToFracS n m = Stream next n (truncate (m - n) + 2) -- FIXME: this isn't exact, but is safe where lim = m + 1/2 -- important to float this out. @@ -630,13 +630,14 @@ unfoldS :: Int -> (b -> MaybeS (a :*: b)) -> b -> Stream a {-# INLINE_STREAM unfoldS #-}+unfoldS 0 _ _ = emptyS -- there's probably a more elegant way of fixing this unfoldS n f s0 = Stream next (JustS (0 :*: s0)) n where {-# INLINE next #-} next (JustS (i :*: s)) = case f s of NothingS -> Done JustS (w :*: s')- | n == i -> Yield w NothingS+ | (n-1) == i-> Yield w NothingS | otherwise -> Yield w (JustS (i+1 :*: s')) next _ = Done
Data/Array/Vector/Strict/Basics.hs view
@@ -57,7 +57,7 @@ -- Then use the direct version --- | /O(1)/, 'length' returns the length of a UArr as an 'Int'.+-- |/O(1)/. 'lengthU' returns the length of a 'UArr' as an 'Int'. lengthU :: UA e => UArr e -> Int lengthU = foldlU (const . (+1)) 0 -- lengthU = Prim.lengthU@@ -83,14 +83,14 @@ -- lengthU is reexported from UArr --- |Test whether the given array is empty+-- |/O(1)/. 'nullU' tests whether the given array is empty. -- nullU :: UA e => UArr e -> Bool nullU = nullS . streamU -- better code if we short circuit {-# INLINE_U nullU #-} -- nullU = (== 0) . lengthU --- |Yield an empty array+-- |/O(1)/. 'emptyU' yields an empty array. -- emptyU :: UA e => UArr e emptyU = unstreamU emptyS@@ -98,19 +98,19 @@ -- emptyU = newU 0 (const $ return ()) --- |Yield a singleton array+-- |/O(1)/. 'singletonU' yields a singleton array containing the given element. -- singletonU :: UA e => e -> UArr e {-# INLINE_U singletonU #-} singletonU = unstreamU . singletonS --- |Prepend an element to an array+-- |/O(n)/. 'consU' prepends the given element to an array. -- consU :: UA e => e -> UArr e -> UArr e {-# INLINE_U consU #-} consU x = unstreamU . consS x . streamU --- |Append an element to an array+-- |/O(n)/. 'snocU' appends the given element to an array. -- snocU :: UA e => UArr e -> e -> UArr e {-# INLINE_U snocU #-}@@ -118,43 +118,59 @@ -- unitsU is reexported from Loop --- |Yield an array where all elements contain the same value+-- |/O(n)/. @'replicateU' n e@ yields an array containing @n@ repetitions of @e@. -- replicateU :: UA e => Int -> e -> UArr e {-# INLINE_U replicateU #-} replicateU n e = unstreamU (replicateS n e) +-- |/O(n)/. @'replicateEachU' n r e@ yields an array such that each element in+-- @e@ is repeated as many times as the value contained at the corresponding+-- index in @r@. For example:+--+-- @replicateEachU 10 (toU [1..3]) (toU [3..5])@ yields @toU [3.0,4.0,4.0,5.0,5.0,5.0]@+--+-- /N.B/: the @n@ parameter specifies how many elements are /allocated/ for the+-- output array, but the function will happily overrun the allocated buffer for+-- all sorts of interesting effects! The caller is expected to ensure that +-- @n <= sumU r@.+-- replicateEachU :: UA e => Int -> UArr Int -> UArr e -> UArr e {-# INLINE_U replicateEachU #-} replicateEachU n ns es = unstreamU . replicateEachS n $ zipS (streamU ns) (streamU es) --- |Array indexing+-- |/O(n)/. 'indexU' extracts an element out of an immutable unboxed array. -- indexU :: UA e => UArr e -> Int -> e indexU arr n = indexS (streamU arr) n {-# INLINE_U indexU #-} +-- |/O(1)/. 'headU' yields the first element of an array.+-- headU :: UA e => UArr e -> e headU = headS . streamU {-# INLINE_U headU #-} +-- |/O(n)/. 'lastU' yields the last element of an array.+-- lastU :: UA e => UArr e -> e lastU = foldl1U (flip const) {-# INLINE lastU #-} --- |Concatenate two arrays+-- |/O(n)/. 'appendU' concatenates two arrays. -- appendU :: UA e => UArr e -> UArr e -> UArr e {-# INLINE_U appendU #-} a1 `appendU` a2 = unstreamU (streamU a1 +++ streamU a2) +-- |/O(n)/. 'initU' yields the input array without its last element. initU :: UA e => UArr e -> UArr e -- not unboxing initU = unstreamU . initS . streamU {-# INLINE initU #-} --- |Repeat an array @n@ times+-- |/O(n)/. @'repeatU' n u@ repeats an array @u@ @n@ times. -- repeatU :: UA e => Int -> UArr e -> UArr e repeatU n = unstreamU . repS n@@ -172,25 +188,25 @@ next (i :*: k) | i == n = Skip (0 :*: k-1) | otherwise = Yield (xs `Prim.indexU` i) (i+1 :*: k) --- |Indexing+-- *Indexing -- --------- --- |Associate each element of the array with its index+-- |/O(n)/. 'indexedU' associates each element of the array with its index. -- indexedU :: UA e => UArr e -> UArr (Int :*: e) {-# INLINE_U indexedU #-} indexedU = unstreamU . indexedS . streamU --- |Conversion+-- *Conversion -- ----------- --- |Turn a list into a parallel array+-- |/O(n)/. 'toU' turns a list into a 'UArr'. -- toU :: UA e => [e] -> UArr e {-# INLINE_U toU #-} toU = unstreamU . toStream --- |Collect the elements of a parallel array in a list+-- |/O(n)/. 'fromU' collects the elements of a 'UArr' into a list. -- fromU :: UA e => UArr e -> [e] {-# INLINE_U fromU #-}@@ -201,36 +217,50 @@ here s = "Data.Array.Vector.Strict.Combinators." ++ s --- |Map a function over an array+-- |/O(n)/. @'iterateU' n f a@ constructs an array of size @n@ by iteratively +-- applying @f@ to @a@. --+iterateU :: (UA a) => Int -> (a -> a) -> a -> UArr a+iterateU n f = unfoldU n (\x -> JustS $ x :*: f x)++-- |/O(n)/. 'mapU' maps a function over an array.+-- mapU :: (UA e, UA e') => (e -> e') -> UArr e -> UArr e' {-# INLINE_U mapU #-} mapU f = unstreamU . mapS f . streamU --- |Extract all elements from an array that meet the given predicate+-- |/O(n)/. 'filterU' extracts all elements from an array that satisfy +-- the given predicate. -- filterU :: UA e => (e -> Bool) -> UArr e -> UArr e {-# INLINE_U filterU #-} filterU p = unstreamU . filterS p . streamU --- |Extract all elements from an array according to a given flag array+-- |/O(n)/. 'packU' extracts all elements from an array according to the +-- provided flag array. For example:+--+-- @packU (toU [1..5]) (toU [True,False,False,False,True])@+--+-- yields @toU [1.0,5.0]@. -- packU:: UA e => UArr e -> UArr Bool -> UArr e {-# INLINE_U packU #-} packU xs = fstU . filterU sndS . zipU xs ---- |Array reduction proceeding from the left+-- |/O(n)/. 'foldlU' reduces an array proceeding from the left. -- foldlU :: UA a => (b -> a -> b) -> b -> UArr a -> b {-# INLINE_U foldlU #-} foldlU f z = foldS f z . streamU --- |Array reduction proceeding from the left for non-empty arrays+-- |/O(n)/. 'foldl1U' is a variant of 'foldlU' that assumes a non-empty input+-- array, but requires no starting element. Throws an exception if the input+-- array is empty. --+ -- FIXME: Rewrite for 'Stream's.---+ -- foldl1U :: UA a => (a -> a -> a) -> UArr a -> a -- {-# INLINE_U foldl1U #-} -- foldl1U f arr = checkNotEmpty (here "foldl1U") (lengthU arr) $@@ -240,55 +270,77 @@ foldl1U f = foldl1S f . streamU {-# INLINE foldl1U #-} +-- |/O(n)/. 'foldl1MaybeU' behaves like 'foldl1U' but returns 'NothingS' if the+-- input array is empty. foldl1MaybeU :: UA a => (a -> a -> a) -> UArr a -> MaybeS a {-# INLINE_U foldl1MaybeU #-} foldl1MaybeU f = fold1MaybeS f . streamU --- |Array reduction that requires an associative combination function with its--- unit+-- |/O(n)/. 'foldU' reduces an array using an associative combination function+-- and its unit. -- foldU :: UA a => (a -> a -> a) -> a -> UArr a -> a {-# INLINE_U foldU #-} foldU = foldlU +-- |/O(n)/. 'fold1MaybeU' behaves like 'fold1U' but returns 'NothingS' if the+-- input array is empty. fold1MaybeU :: UA a => (a -> a -> a) -> UArr a -> MaybeS a {-# INLINE_U fold1MaybeU #-} fold1MaybeU = foldl1MaybeU --- |Reduction of a non-empty array which requires an associative combination--- function+-- |/O(n)/. 'fold1U' is a variant of 'foldU' that requires a non-empty input+-- array. Throws an exception if its input array is empty. -- fold1U :: UA a => (a -> a -> a) -> UArr a -> a {-# INLINE_U fold1U #-} fold1U = foldl1U --- |Prefix scan proceedings from left to right+-- |/O(n)/. 'scanlU' is equivalent to 'foldlU' on all prefixes (except the+-- array itself) of the input array. --+-- /N.B/: the behavior of this function differs from that of Data.List. Compare:+--+-- @scanl (+) 0.0 [1..5]@ gives @[0.0,1.0,3.0,6.0,10.0,15.0]@+--+-- @scanlU (+) 0.0 $ toU [1..5]@ gives @toU [0.0,1.0,3.0,6.0,10.0]@+--+-- To get behavior closer to the List counterpart, see 'scanResU'.+-- scanlU :: (UA a, UA b) => (b -> a -> b) -> b -> UArr a -> UArr b {-# INLINE_U scanlU #-} scanlU f z = unstreamU . scanS f z . streamU --- |Prefix scan of a non-empty array proceeding from left to right+-- |/O(n)/. 'scanl1U' is like 'scanlU', but requires no starting value. -- scanl1U :: UA a => (a -> a -> a) -> UArr a -> UArr a {-# INLINE_U scanl1U #-} scanl1U f arr = checkNotEmpty (here "scanl1U") (lengthU arr) $ unstreamU (scan1S f (streamU arr)) --- |Prefix scan proceeding from left to right that needs an associative--- combination function with its unit+-- |/O(n)/. 'scanU' is equivalent to 'foldU' on all prefixes (except the array+-- itself) of the input array. -- scanU :: UA a => (a -> a -> a) -> a -> UArr a -> UArr a {-# INLINE_U scanU #-} scanU = scanlU --- |Prefix scan of a non-empty array proceeding from left to right that needs--- an associative combination function+-- |/O(n)/. 'scan1U' is like 'scanU', but requires no starting value. -- scan1U :: UA a => (a -> a -> a) -> UArr a -> UArr a {-# INLINE_U scan1U #-} scan1U = scanl1U +-- |/O(n)/. 'scanResU' behaves like 'scanU', but yields a strict pair with the+-- 'scanU' result as its @fstS@ and the "missing" element ('foldU' on the same+-- arguments) as its @sndS@. Compare:+--+-- @scanl (+) 0.0 [1..5]@ gives @[0.0,1.0,3.0,6.0,10.0,15.0]@+--+-- @scanlU (+) 0.0 $ toU [1..5]@ gives @toU [0.0,1.0,3.0,6.0,10.0]@+--+-- @scanResU (+) 0.0 $ toU [1..5]@ gives @toU [0.0,1.0,3.0,6.0,10.0] :*: 15.0@.+-- scanResU :: UA a => (a -> a -> a) -> a -> UArr a -> UArr a :*: a {-# INLINE_U scanResU #-} scanResU f z = unstreamScan f z . streamU@@ -311,8 +363,10 @@ writeMU marr i z fill s' (f z x) (i+1) --- |Accumulating map from left to right. Does not return the accumulator.+-- |/O(n)/. 'mapAccumLU' is an accumulating map from left to right. Unlike its+-- List counterpart, it does not return the accumulator. --+ -- FIXME: Naming inconsistent with lists. -- mapAccumLU :: (UA a, UA b) => (c -> a -> c :*: b) -> c -> UArr a -> UArr b@@ -321,20 +375,24 @@ -- zipU is re-exported from UArr --- |+-- |/O(1)/. 'zip3U' takes three arrays and returns an array of triples. -- zip3U :: (UA e1, UA e2, UA e3) => UArr e1 -> UArr e2 -> UArr e3 -> UArr (e1 :*: e2 :*: e3) {-# INLINE_U zip3U #-} zip3U a1 a2 a3 = (a1 `zipU` a2) `zipU` a3 --- |+-- |/O(n)/. 'zipWithU' applies a function to corresponding elements of two +-- arrays, yielding an array containing the results.+-- zipWithU :: (UA a, UA b, UA c) => (a -> b -> c) -> UArr a -> UArr b -> UArr c {-# INLINE_U zipWithU #-} zipWithU f a1 a2 = unstreamU (zipWithS f (streamU a1) (streamU a2)) --- |+-- |/O(n)/. 'zipWith3U' applies a function to corresponding elements of three+-- arrays, yielding an array with the results.+-- zipWith3U :: (UA a, UA b, UA c, UA d) => (a -> b -> c -> d) -> UArr a -> UArr b -> UArr c -> UArr d {-# INLINE_U zipWith3U #-}@@ -344,7 +402,7 @@ -- unzipU is re-exported from UArr --- |+-- |/O(1)/. 'unzip3U' unpairs an array of strict triples into three arrays. unzip3U :: (UA e1, UA e2, UA e3) => UArr (e1 :*: e2 :*: e3) -> (UArr e1 :*: UArr e2 :*: UArr e3) {-# INLINE_U unzip3U #-}@@ -354,14 +412,21 @@ (a1 :*: a2 :*: a3) -- fstU and sndU reexported from UArr--- |++-- |/O(n)/. @'combineU' f a1 a2@ yields an array by picking elements from @a1@+-- if @f@ is @True@ at the given position, and picking elements from @a2@ +-- otherwise. For example:+--+-- @combineU (toU [True,True,False,True,False,False]) (toU [1..3]) (toU [4..6])@+--+-- yields @toU [1.0,2.0,4.0,3.0,5.0,6.0]@. combineU :: UA a => UArr Bool -> UArr a -> UArr a -> UArr a {-# INLINE_U combineU #-} combineU f a1 a2 = checkEq (here "combineU") ("flag length not equal to sum of arg length") (lengthU f) (lengthU a1 + lengthU a2) $ - trace ("combineU:\n\t" ++ show (lengthU f) ++ "\n\t" ++ show (lengthU a1) ++ "\n\t" ++ show (lengthU a2) ++ "\n")+-- trace ("combineU:\n\t" ++ show (lengthU f) ++ "\n\t" ++ show (lengthU a1) ++ "\n\t" ++ show (lengthU a2) ++ "\n") unstreamU (combineS (streamU f) (streamU a1) (streamU a2)) ------------------------------------------------------------------------@@ -372,30 +437,29 @@ -- extractU :: UA a => UArr a -> Int -> Int -> UArr a -- extractU arr i n = newU n $ \marr -> copyMU marr 0 (sliceU arr i n) +-- |/O(n)/. 'tailU' yields the given array without its initial element. tailU :: UA e => UArr e -> UArr e tailU = unstreamU . tailS . streamU {-# INLINE_U tailU #-} +-- |/O(n)/. 'dropU' yields the suffix obtained by dropping the given number+-- of elements from an array. dropU :: UA e=> Int -> UArr e -> UArr e dropU n = unstreamU . dropS n . streamU {-# INLINE dropU #-} +-- |/O(n)/. 'takeU' yields the prefix of the given length of an array. takeU :: UA e=> Int -> UArr e -> UArr e takeU n = unstreamU . takeS n . streamU {-# INLINE takeU #-} --- |Split an array into two halves at the given index+-- |/O(n)/. 'splitAtU' splits an array into two subarrays at the given index. -- splitAtU :: UA e => Int -> UArr e -> (UArr e, UArr e) splitAtU n a = (takeU n a, dropU n a) {-# INLINE splitAtU #-} {---- |Yield the tail of an array----tailU :: UA e => UArr e -> UArr e-{-# INLINE_U tailU #-}-tailU = unstreamU . tailS . streamU -- |Extract a prefix of an array --@@ -421,14 +485,14 @@ ------------------------------------------------------------------------ --- | 'takeWhile', applied to a predicate @p@ and a UArr @xs@,+-- |/O(n)/. 'takeWhileU', applied to a predicate @p@ and a UArr @xs@, -- returns the longest prefix (possibly empty) of @xs@ of elements that satisfy @p@. -- takeWhileU :: UA e => (e -> Bool) -> UArr e -> UArr e takeWhileU f = unstreamU . takeWhileS f . streamU {-# INLINE_U takeWhileU #-} --- | 'dropWhile' @p xs@ returns the suffix remaining after 'takeWhile' @p xs@.+-- |/O(n)/. 'dropWhileU' @p xs@ returns the suffix remaining after 'takeWhileU' @p xs@. dropWhileU :: UA e => (e -> Bool) -> UArr e -> UArr e dropWhileU f = unstreamU . dropWhileS f . streamU {-# INLINE_U dropWhileU #-}@@ -436,14 +500,14 @@ ------------------------------------------------------------------------ -- ** Searching with a predicate --- | /O(n)/,/fusion/. The 'find' function takes a predicate and an array+-- |/O(n)/, /fusion/. The 'findU' function takes a predicate and an array -- and returns the first element in the list matching the predicate, or -- 'Nothing' if there is no such element. findU :: UA a => (a -> Bool) -> UArr a -> Maybe a {-# INLINE_U findU #-} findU p = findS p . streamU --- | /O(n)/, /fusion/, The 'findIndex' function takes a predicate and an array and returns+-- |/O(n)/, /fusion/. The 'findIndexU' function takes a predicate and an array and returns -- the index of the first element in the array satisfying the predicate, -- or 'Nothing' if there is no such element. --@@ -451,7 +515,7 @@ {-# INLINE_U findIndexU #-} findIndexU p = findIndexS p . streamU --- | /O(n)/,/fusion/. 'lookup' @key assocs@ looks up a key in an array+-- |/O(n)/, /fusion/. 'lookupU' @key assocs@ looks up a key in an array -- of pairs treated as an association table. -- lookupU :: (Eq a, UA a, UA b) => a -> UArr (a :*: b) -> Maybe b@@ -460,6 +524,10 @@ ------------------------------------------------------------------------ +-- |/O(n)/. @'unfoldU' n f z@ builds an array of size @n@ from a seed value+-- @z@ by iteratively applying @f@, stopping when @n@ elements have been +-- generated or @f@ returns 'NothingS'.+-- unfoldU :: UA a => Int -> (b -> MaybeS (a :*: b)) -> b -> UArr a {-# INLINE_U unfoldU #-} unfoldU n f z = unstreamU (unfoldS n f z)
Data/Array/Vector/Strict/Enum.hs view
@@ -31,28 +31,48 @@ import Data.Array.Vector.Prim.Hyperstrict import Data.Array.Vector.Strict.Stream --- |Yield an enumerated array+-- |/O(n)/. 'enumFromToU' yields an enumerated array, analogous to 'enumFromTo',+-- but only works on instances of Integral. --+ -- FIXME: See comments about enumFromThenToS enumFromToU :: (UA a, Integral a) => a -> a -> UArr a {-# INLINE_U enumFromToU #-} enumFromToU start end = unstreamU (enumFromToS start end) +-- |/O(n)/. Like 'enumFromToU', but works on fractional numbers (still +-- incrementing by 1 each time). enumFromToFracU :: (UA a, RealFrac a) => a -> a -> UArr a {-# INLINE_U enumFromToFracU #-} enumFromToFracU start end = unstreamU (enumFromToFracS start end) --- |Yield an enumerated array using a specific step+-- |/O(n)/. 'enumFromThenToU' yields an enumerated array using a specific +-- step value. --+ -- FIXME: See comments about enumFromThenToS enumFromThenToU :: Int -> Int -> Int -> UArr Int {-# INLINE_U enumFromThenToU #-} enumFromThenToU start next end = unstreamU (enumFromThenToS start next end) +-- |/O(n)/. @'enumFromStepLenU' s d n@ yields an enumerated array of length @n@+-- starting from @s@ with an increment of @d@.+-- enumFromStepLenU :: Int -> Int -> Int -> UArr Int {-# INLINE_U enumFromStepLenU #-} enumFromStepLenU s d n = unstreamU (enumFromStepLenS s d n) +-- |/O(n)/. @'enumFromToEachU' n u@ yields an array by taking each strict pair+-- @u@ and treating it as a range to generate successive values over. For+-- example:+--+-- @enumFromToEachU 7 (toU [3 :*: 6, 8 :*: 10])@+-- yields @toU [3,4,5,6,8,9,10]@ +--+-- /N.B/: This function will allocate @n@ slots for the output array, and will+-- happily overrun its allocated space if the @u@ leads it to do so. The caller+-- is expected to ensure that @n <= (sumU . mapU (\(x :*: y) -> y - x + 1) $ u)@.+-- enumFromToEachU :: Int -> UArr (Int :*: Int) -> UArr Int {-# INLINE_U enumFromToEachU #-} enumFromToEachU n = unstreamU . enumFromToEachS n . streamU
Data/Array/Vector/Strict/Permute.hs view
@@ -44,9 +44,11 @@ import Data.Array.Vector.Strict.Enum ( enumFromToU) --- |Permutations+-- *Permutations -- ------------- +-- |/O(n)/. 'permuteMU' permutes a 'MUArr' according to a UArr of permuted+-- indices. permuteMU :: UA e => MUArr e s -> UArr e -> UArr Int -> ST s () permuteMU mpa arr is = permute 0 where@@ -85,6 +87,9 @@ {-# INLINE_U bpermuteDftU #-} bpermuteDftU n init = updateU (mapU init . enumFromToU 0 $ n-1) +-- |/O(n)/. @'atomicUpdateMU' arr upds@ replaces elements at specific indices+-- of @arr@ based on the contents of @upds@ (where @'fstS'@ indicates the index to+-- replace, @'sndS'@ the replacement value). atomicUpdateMU :: UA e => MUArr e s -> UArr (Int :*: e) -> ST s () {-# INLINE_U atomicUpdateMU #-} atomicUpdateMU marr upd = updateM writeMU marr (streamU upd)
Data/Array/Vector/Strict/Stream.hs view
@@ -31,7 +31,7 @@ import Data.Array.Vector.UArr ( UArr, MUArr, UA, indexU, lengthU, zipU, fstU, sndU, newDynU, writeMU) --- | Generate a stream from an array, from left to right+-- |/O(1)/. 'streamU' generates a stream from an array, from left to right. -- streamU :: UA a => UArr a -> Stream a {-# INLINE_STREAM streamU #-}@@ -42,14 +42,15 @@ next i | i == n = Done | otherwise = Yield (arr `indexU` i) (i+1) --- | Create an array from a stream, filling it from left to right+-- |/O(n)/. 'unstreamU' creates an array from a stream, filling it from left +-- to right. -- unstreamU :: UA a => Stream a -> UArr a {-# INLINE_STREAM unstreamU #-} unstreamU st@(Stream next s n) = newDynU n (\marr -> unstreamMU marr st) --- | Fill a mutable array from a stream from left to right and yield--- the number of elements written.+-- |/O(n)/. 'unstreamMU' fills a mutable array from a stream from left to right+-- and yields the number of elements written. -- unstreamMU :: UA a => MUArr a s -> Stream a -> ST s Int {-# INLINE_U unstreamMU #-}
Data/Array/Vector/Strict/Sums.hs view
@@ -30,53 +30,59 @@ infix 4 `elemU`, `notElemU` --- |+-- |/O(n)/. 'andU' yields the conjunction of a boolean array. andU :: UArr Bool -> Bool {-# INLINE andU #-} andU = foldU (&&) True --- |+-- |/O(n)/. 'andU' yields the disjunction of a boolean array. orU :: UArr Bool -> Bool {-# INLINE orU #-} orU = foldU (||) False --- |+-- |/O(n)/. @'allU' p u@ determines whether all elements in array @u@ satisfy +-- predicate @p@.+-- allU :: UA e => (e -> Bool) -> UArr e -> Bool {-# INLINE allU #-} allU p = andU . mapU p --- |+-- |/O(n)/. @'anyU' p u@ determines whether any element in array @u@ satisfies+-- predicate @p@.+-- anyU :: UA e => (e -> Bool) -> UArr e -> Bool {-# INLINE anyU #-} anyU p = orU . mapU p --- |Compute the sum of an array of numerals+-- |/O(n)/. 'sumU' computes the sum of an array of a 'Num' instance. -- sumU :: (Num e, UA e) => UArr e -> e {-# INLINE sumU #-} sumU = foldU (+) 0 --- |Compute the product of an array of numerals+-- |/O(n)/. 'productU' computes the product of an array of a 'Num' instance. -- productU :: (Num e, UA e) => UArr e -> e {-# INLINE productU #-} productU = foldU (*) 1 --- |Determine the maximum element in an array+-- |/O(n)/. 'maximumU' finds the maximum element in an array of orderable +-- elements. -- maximumU :: (Ord e, UA e) => UArr e -> e {-# INLINE maximumU #-} maximumU = fold1U max --- |Determine the maximum element in an array under the given ordering+-- |/O(n)/. 'maximumByU' finds the maximum element in an array under the given +-- ordering. -- maximumByU :: UA e => (e -> e -> Ordering) -> UArr e -> e {-# INLINE maximumByU #-} maximumByU = fold1U . maxBy where maxBy compare x y = case x `compare` y of- LT -> y- _ -> x+ GT -> x+ _ -> y {- -- |Determine the index of the maximum element in an array@@ -95,13 +101,15 @@ cmp' (_ :*: x) (_ :*: y) = cmp x y -} --- |Determine the minimum element in an array+-- |/O(n)/. 'minimumU' finds the minimum element in an array of orderable +-- elements. -- minimumU :: (Ord e, UA e) => UArr e -> e {-# INLINE minimumU #-} minimumU = fold1U min --- |Determine the minimum element in an array under the given ordering+-- |/O(n)/. 'minimumByU' finds the minimum element in an array under the given +-- ordering. -- minimumByU :: UA e => (e -> e -> Ordering) -> UArr e -> e {-# INLINE minimumByU #-}@@ -128,13 +136,13 @@ cmp' (_ :*: x) (_ :*: y) = cmp x y -} --- |Determine whether the given element is in an array+-- |/O(n)/. 'elemU' determines whether the given element is in an array. -- elemU :: (Eq e, UA e) => e -> UArr e -> Bool elemU e = elemS e . streamU -- anyU (== e) (better code) {-# INLINE elemU #-} --- |Negation of `elemU'+-- |/O(n)/. Negation of `elemU'. -- notElemU :: (Eq e, UA e) => e -> UArr e -> Bool notElemU e = allU (/= e)
Data/Array/Vector/UArr.hs view
@@ -2,6 +2,10 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE Rank2Types #-}+++#include "fusion-phases.h"+ ----------------------------------------------------------------------------- -- | -- Module : Data.Array.Vector.UArr@@ -14,9 +18,8 @@ -- Portability : non-portable (GADTS) -- -- Description ------------------------------------------------------------------ -- This module defines unlifted arrays generically as a GADT.---+-- -- Slicing is implemented by each `BUArr' having the slicing information. A -- possible alternative design would be to maintain this information in -- `UArr', but not in the representations, but at the root. This may seem@@ -27,9 +30,6 @@ -- -- Todo ---------------------------------------------------------------------- ----#include "fusion-phases.h"- module Data.Array.Vector.UArr ( -- * Array types and classes containing the admissable elements types@@ -39,6 +39,8 @@ lengthU, indexU, sliceU, {-extractU,-} unitsU, zipU, unzipU, fstU, sndU, newU, newDynU, newDynResU, lengthMU, newMU, readMU, writeMU, copyMU, unsafeFreezeMU, unsafeFreezeAllMU,+ memcpyMU, memcpyOffMU, memmoveOffMU,+ unsafeZipMU, unsafeUnzipMU, -- * I\/O UIO(..)@@ -56,7 +58,8 @@ import Data.Array.Vector.Prim.BUArr ( BUArr, MBUArr, UAE, lengthBU, indexBU, sliceBU, hGetBU, hPutBU,- lengthMBU, newMBU, readMBU, writeMBU, copyMBU, unsafeFreezeMBU)+ lengthMBU, newMBU, readMBU, writeMBU, copyMBU, unsafeFreezeMBU,+ memcpyMBU, memcpyOffMBU, memmoveOffMBU) import System.IO import GHC.ST@@ -68,7 +71,7 @@ infixl 9 `indexU`, `readMU` --- |Basic operations on representation types+-- *Basic operations on representation types -- ----------------------------------------- -- |This type class determines the types that can be elements immutable@@ -77,41 +80,60 @@ -- of this class. -- class UA e where+ -- |The basic array datatype. data UArr e data MUArr e :: * -> * - -- |Yield the length of an unboxed array+ -- |/O(1?)/. Yield the length of an unboxed array. lengthU :: UArr e -> Int - -- |Extract an element out of an immutable unboxed array indexU :: UArr e -> Int -> e - -- |Restrict access to a subrange of the original array (no copying)+ -- |/O(1)/. 'sliceU' restricts access to a subrange of the original array + -- (no copying). sliceU :: UArr e -> Int -> Int -> UArr e ------------------------------------------------------------------------ - -- |Yield the length of a mutable unboxed array+ -- |/O(1)/. 'lengthMU' yields the length of a mutable unboxed array. lengthMU :: MUArr e s -> Int - -- |Allocate a mutable unboxed array+ -- |/O(1)/. 'newMU' allocates a mutable unboxed array of the specified length. newMU :: Int -> ST s (MUArr e s) - -- |Read an element from a mutable unboxed array+ -- |/O(1)/. 'readMU' reads the element at the specified index of a mutable + -- unboxed array. readMU :: MUArr e s -> Int -> ST s e - -- |Update an element in a mutable unboxed array+ -- |/O(1)/. 'writeMU' writes a new value to the specified index of a+ -- mutable unboxed array. writeMU :: MUArr e s -> Int -> e -> ST s () ------------------------------------------------------------------------ - -- |Copy the contents of an immutable unboxed array into a mutable one- -- from the specified position on+ -- |/O(n)/. 'copyMU' copies the contents of an immutable unboxed array into + -- a mutable one starting from the specified index.+ -- copyMU :: MUArr e s -> Int -> UArr e -> ST s () - -- |Convert a mutable into an immutable unboxed array+ -- |/O(1)/. 'unsafeFreezeMU' converts a prefix of a mutable array into an + -- immutable unboxed array, without copying. The mutable array must not be + -- mutated after this.+ -- unsafeFreezeMU :: MUArr e s -> Int -> ST s (UArr e) + -- |Copy a portion of one mutable array to a second.+ memcpyMU :: MUArr e s -> MUArr e s -> Int -> ST s ()++ -- |Copy a portion of one mutable array to a second, beginning at the+ -- specified offsets for each.+ memcpyOffMU :: MUArr e s -> MUArr e s -> Int -> Int -> Int -> ST s ()++ -- |Copy a portion of one mutable array to a second, beginning at the+ -- specified offsets for each. This operation is safe even if the source+ -- and destination are the same.+ memmoveOffMU :: MUArr e s -> MUArr e s -> Int -> Int -> Int -> ST s ()+ -- instance HS e => HS (UArr e) -- instance HS e => HS (MUArr e s) @@ -122,12 +144,20 @@ mkMUAPrim :: MBUArr s e -> MUArr e s unMUAPrim :: MUArr e s -> MBUArr s e +-- |/O(1)/. 'unsafeFreezeAllMU' converts an entire mutable array into an +-- immutable array, without copying. The mutable array must not be mutated +-- after this.+-- unsafeFreezeAllMU :: UA e => MUArr e s -> ST s (UArr e) unsafeFreezeAllMU marr = unsafeFreezeMU marr (lengthMU marr) --- |Creating unboxed arrays+-- *Creating unboxed arrays -- ------------------------ +-- |/O(n)/. 'newU' constructs an immutable array of the given size by +-- performing the provided initialization function on a mutable representation+-- of the output array.+-- newU :: UA e => Int -> (forall s. MUArr e s -> ST s ()) -> UArr e {-# INLINE_U newU #-} newU n init = newDynU n (\ma -> init ma >> return n)@@ -152,40 +182,59 @@ return (arr :*: r) ) --- |Basic operations on unboxed arrays+-- *Basic operations on unboxed arrays -- ----------------------------------- --- |Yield an array of units +-- |/O(1)/. Yield an array of units. -- unitsU :: Int -> UArr () {-# INLINE_STREAM unitsU #-} unitsU = UAUnit --- |Elementwise pairing of array elements.+-- |/O(1)/. Elementwise pairing of array elements. --+-- /N.B/: The output will be as long as the first array (and will thus +-- access past the end of the second array), unlike its List counterpart.+-- This will not occur at the time zipU is called, but only after the resulting+-- array is accessed.+-- zipU :: (UA a, UA b) => UArr a -> UArr b -> UArr (a :*: b) {-# INLINE_STREAM zipU #-} zipU = UAProd --- |Elementwise unpairing of array elements.+-- |/O(1)/. Elementwise unpairing of array elements. -- unzipU :: (UA a, UA b) => UArr (a :*: b) -> (UArr a :*: UArr b) {-# INLINE_STREAM unzipU #-} unzipU (UAProd l r) = (l :*: r) --- |Yield the first components of an array of pairs.+-- |/O(1)/. Yield the first components of an array of pairs. -- fstU :: (UA a, UA b) => UArr (a :*: b) -> UArr a {-# INLINE_STREAM fstU #-} fstU (UAProd l r) = l --- |Yield the second components of an array of pairs.+-- |/O(1)/. Yield the second components of an array of pairs. -- sndU :: (UA a, UA b) => UArr (a :*: b) -> UArr b {-# INLINE_STREAM sndU #-} sndU (UAProd l r) = r --- |Family of representation types+-- |Elementwise pairing of mutable arrays. This is an unsafe+-- operation, as no copying is performed, so changes to the+-- pair array will affect the original arrays, and vice versa.+unsafeZipMU :: (UA a, UA b) => MUArr a s -> MUArr b s -> MUArr (a :*: b) s+{-# INLINE_U unsafeZipMU #-}+unsafeZipMU = MUAProd++-- |Elementwise unpairing of mutable arrays. This is an unsafe+-- operation, as no copying is performed, so changes to the+-- unpaired arrays will affect the original, and vice versa.+unsafeUnzipMU :: (UA a, UA b) => MUArr (a :*: b) s -> MUArr a s :*: MUArr b s+{-# INLINE_U unsafeUnzipMU #-}+unsafeUnzipMU (MUAProd mua mub) = mua :*: mub++-- *Family of representation types -- ------------------------------- -- |Array operations on the unit representation.@@ -196,7 +245,7 @@ lengthU (UAUnit n) = n indexU (UAUnit _) _ = ()- sliceU (UAUnit _) _ n = UAUnit n+ sliceU (UAUnit len) i n = if i == len then UAUnit 0 else UAUnit (min n (len - i)) lengthMU (MUAUnit n) = n newMU n = return $ MUAUnit n@@ -205,6 +254,10 @@ copyMU (MUAUnit _) _ (UAUnit _) = return () unsafeFreezeMU (MUAUnit _) n = return $ UAUnit n + memcpyMU (MUAUnit _) (MUAUnit _) _ = return ()+ memcpyOffMU (MUAUnit _) (MUAUnit _) _ _ _ = return ()+ memmoveOffMU (MUAUnit _) (MUAUnit _) _ _ _ = return ()+ -- |Array operations on the pair representation. -- instance (UA a, UA b) => UA (a :*: b) where@@ -248,6 +301,21 @@ b' <- unsafeFreezeMU b n return $ UAProd a' b' + {-# INLINE_U memcpyMU #-}+ memcpyMU (MUAProd ma mb) (MUAProd ma' mb') l =+ do memcpyMU ma ma' l+ memcpyMU mb mb' l++ {-# INLINE_U memcpyOffMU #-}+ memcpyOffMU (MUAProd ma mb) (MUAProd ma' mb') s d l =+ do memcpyOffMU ma ma' s d l+ memcpyOffMU mb mb' s d l++ {-# INLINE_U memmoveOffMU #-}+ memmoveOffMU (MUAProd ma mb) (MUAProd ma' mb') s d l = + do memmoveOffMU ma ma' s d l+ memmoveOffMU mb mb' s d l+ {- -- |Selector for immutable arrays of sums --@@ -389,6 +457,18 @@ {-# INLINE_U primUnsafeFreezeMU #-} primUnsafeFreezeMU ma = liftM mkUAPrim . unsafeFreezeMBU (unMUAPrim ma) +primMemcpyMU :: UPrim e => MUArr e s -> MUArr e s -> Int -> ST s ()+{-# INLINE_U primMemcpyMU #-}+primMemcpyMU src dst l = memcpyMBU (unMUAPrim src) (unMUAPrim dst) l++primMemcpyOffMU :: UPrim e => MUArr e s -> MUArr e s -> Int -> Int -> Int -> ST s ()+{-# INLINE_U primMemcpyOffMU #-}+primMemcpyOffMU src dst s d l = memcpyOffMBU (unMUAPrim src) (unMUAPrim dst) s d l++primMemmoveOffMU :: UPrim e => MUArr e s -> MUArr e s -> Int -> Int -> Int -> ST s ()+{-# INLINE_U primMemmoveOffMU #-}+primMemmoveOffMU src dst s d l = memmoveOffMBU (unMUAPrim src) (unMUAPrim dst) s d l+ instance UPrim Bool where mkUAPrim = UABool unUAPrim (UABool arr) = arr@@ -411,6 +491,10 @@ copyMU = primCopyMU unsafeFreezeMU = primUnsafeFreezeMU + memcpyMU = primMemcpyMU+ memcpyOffMU = primMemcpyOffMU+ memmoveOffMU = primMemmoveOffMU+ instance UPrim Char where mkUAPrim = UAChar unUAPrim (UAChar arr) = arr@@ -433,6 +517,11 @@ copyMU = primCopyMU unsafeFreezeMU = primUnsafeFreezeMU + memcpyMU = primMemcpyMU+ memcpyOffMU = primMemcpyOffMU+ memmoveOffMU = primMemmoveOffMU++ instance UPrim Int where mkUAPrim = UAInt unUAPrim (UAInt arr) = arr@@ -455,6 +544,10 @@ copyMU = primCopyMU unsafeFreezeMU = primUnsafeFreezeMU + memcpyMU = primMemcpyMU+ memcpyOffMU = primMemcpyOffMU+ memmoveOffMU = primMemmoveOffMU+ -- FIXME: For now, we assume that Int writes are atomic but we should really -- configure this. @@ -477,6 +570,10 @@ writeMU = primWriteMU copyMU = primCopyMU unsafeFreezeMU = primUnsafeFreezeMU++ memcpyMU = primMemcpyMU+ memcpyOffMU = primMemcpyOffMU+ memmoveOffMU = primMemmoveOffMU -- FIXME: For now, we assume that Word writes are atomic but we should really -- configure this. @@ -502,6 +599,10 @@ copyMU = primCopyMU unsafeFreezeMU = primUnsafeFreezeMU + memcpyMU = primMemcpyMU+ memcpyOffMU = primMemcpyOffMU+ memmoveOffMU = primMemmoveOffMU+ instance UPrim Double where mkUAPrim = UADouble unUAPrim (UADouble arr) = arr@@ -524,6 +625,10 @@ copyMU = primCopyMU unsafeFreezeMU = primUnsafeFreezeMU + memcpyMU = primMemcpyMU+ memcpyOffMU = primMemcpyOffMU+ memmoveOffMU = primMemmoveOffMU+ instance UPrim Word8 where mkUAPrim = UAWord8 unUAPrim (UAWord8 arr) = arr@@ -543,6 +648,10 @@ writeMU = primWriteMU copyMU = primCopyMU unsafeFreezeMU = primUnsafeFreezeMU++ memcpyMU = primMemcpyMU+ memcpyOffMU = primMemcpyOffMU+ memmoveOffMU = primMemmoveOffMU -- FIXME: For now, we assume that Word8 writes are atomic but we should really -- configure this. @@ -566,6 +675,10 @@ copyMU = primCopyMU unsafeFreezeMU = primUnsafeFreezeMU + memcpyMU = primMemcpyMU+ memcpyOffMU = primMemcpyOffMU+ memmoveOffMU = primMemmoveOffMU+ instance UPrim Word32 where mkUAPrim = UAWord32 unUAPrim (UAWord32 arr) = arr@@ -586,6 +699,10 @@ copyMU = primCopyMU unsafeFreezeMU = primUnsafeFreezeMU + memcpyMU = primMemcpyMU+ memcpyOffMU = primMemcpyOffMU+ memmoveOffMU = primMemmoveOffMU+ instance UPrim Word64 where mkUAPrim = UAWord64 unUAPrim (UAWord64 arr) = arr@@ -606,6 +723,10 @@ copyMU = primCopyMU unsafeFreezeMU = primUnsafeFreezeMU + memcpyMU = primMemcpyMU+ memcpyOffMU = primMemcpyOffMU+ memmoveOffMU = primMemmoveOffMU+ instance UPrim Int8 where mkUAPrim = UAInt8 unUAPrim (UAInt8 arr) = arr@@ -625,6 +746,10 @@ writeMU = primWriteMU copyMU = primCopyMU unsafeFreezeMU = primUnsafeFreezeMU++ memcpyMU = primMemcpyMU+ memcpyOffMU = primMemcpyOffMU+ memmoveOffMU = primMemmoveOffMU -- FIXME: For now, we assume that Int8 writes are atomic but we should really -- configure this. @@ -648,6 +773,10 @@ copyMU = primCopyMU unsafeFreezeMU = primUnsafeFreezeMU + memcpyMU = primMemcpyMU+ memcpyOffMU = primMemcpyOffMU+ memmoveOffMU = primMemmoveOffMU+ instance UPrim Int32 where mkUAPrim = UAInt32 unUAPrim (UAInt32 arr) = arr@@ -668,6 +797,10 @@ copyMU = primCopyMU unsafeFreezeMU = primUnsafeFreezeMU + memcpyMU = primMemcpyMU+ memcpyOffMU = primMemcpyOffMU+ memmoveOffMU = primMemmoveOffMU+ instance UPrim Int64 where mkUAPrim = UAInt64 unUAPrim (UAInt64 arr) = arr@@ -688,6 +821,10 @@ copyMU = primCopyMU unsafeFreezeMU = primUnsafeFreezeMU + memcpyMU = primMemcpyMU+ memcpyOffMU = primMemcpyOffMU+ memmoveOffMU = primMemmoveOffMU+ ------------------------------------------------------------------------ -- TODO could use a single array of 'a', doubly packed@@ -715,7 +852,9 @@ unsafeFreezeMU (MUAComplex arr) n = do arr' <- unsafeFreezeMU arr n; return (UAComplex arr') -+ memcpyMU (MUAComplex src) (MUAComplex dst) l = memcpyMU src dst l+ memcpyOffMU (MUAComplex src) (MUAComplex dst) s d l = memcpyOffMU src dst s d l+ memmoveOffMU (MUAComplex src) (MUAComplex dst) s d l = memmoveOffMU src dst s d l instance (Integral a, UA a) => UA (Ratio a) where newtype UArr (Ratio a) = UARatio (UArr (a :*: a))@@ -731,6 +870,11 @@ writeMU (MUARatio arr) i (n :% d) = writeMU arr i (n :*: d) copyMU (MUARatio mua) n (UARatio ua) = copyMU mua n ua unsafeFreezeMU (MUARatio arr) n = do arr' <- unsafeFreezeMU arr n; return (UARatio arr')++ memcpyMU (MUARatio src) (MUARatio dst) l = memcpyMU src dst l+ memcpyOffMU (MUARatio src) (MUARatio dst) s d l = memcpyOffMU src dst s d l+ memmoveOffMU (MUARatio src) (MUARatio dst) s d l = memmoveOffMU src dst s d l+ ------------------------------------------------------------------------
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2008 Don Stewart+Copyright (c) 2008-2009 Don Stewart Copyright (c) 2001-2002, Manuel M T Chakravarty & Gabriele Keller Copyright (c) 2006-2007, Manuel M T Chakravarty & Roman Leshchinskiy
TODO view
@@ -52,3 +52,23 @@ Possibles: * Maybe provide ST interface for low level things?++The following are not currently tested because they crash the testsuite, but should be caught and tested:+Unsafe functions that allow reading or writing of memory that doesn't belong to the parameters. In square brackets is whether you can read or write memory using the function, and whether the safe mode flag currently prevents this:+ * replicateEachU: the user can specify allocated length of the output array, but other parameters allow the actual resulting array to be longer [READ?]+ * replicateEachU 1 (toU [10]) (toU [1])+ * zipU, zip3U: the production has length of the first parameter, and many functions on the result (lengthU, for example, will catch mismatched lengths on a UAProd) are unsafe [READ]+ * zipU (toU [1..10]) (toU [1])+ * enumFromToEachU: the user can specify allocated length of the output array, which isn't required to match the length implied by the other parameters [READ]+ * enumFromToEachU 1 $ toU [(1 :*: 100)]+ * packU: if the first argument is longer than the second, it will keep reading off the end of the second [READ]+ * packU (toU [1..100]) (toU [True,False,False,False,True])+ * writeMU and friends [WRITE]+ +Functions that crash on unexpected inputs (not because of memory issues):+ * enumFromStepLenU+ * enumFromStepLenU 1 0 (-1) -- bus error+ * enumFromToFracU+ * enumFromToFracU 1 (-2) -- ghc internal error (requested zero blocks)+ * sliceU+ * sliceU (toU [1..10]) 1 (-1) -- segfault
+ cbits/memcpy_extra.c view
@@ -0,0 +1,13 @@+#include <string.h>++#include "memcpy_extra.h"++void memcpy_offset (char *dst, char *src, int doff, int soff, int len)+{+ memcpy(dst + doff, src + soff, len);+}++void memmove_offset (char *dst, char *src, int doff, int soff, int len)+{+ memmove(dst + doff, src + soff, len);+}
+ cbits/memcpy_extra.h view
@@ -0,0 +1,7 @@+#ifndef __UVECTOR_MEMCPY_EXTRA_H__+#define __UVECTOR_MEMCPY_EXTRA_H__++void memcpy_offset (char *dst, char *src, int doff, int soff, int len);+void memmove_offset (char *dst, char *src, int doff, int soff, int len);++#endif
tests/Examples/Test.hs view
@@ -1,5 +1,13 @@+{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ < 610 import System.Process+import qualified Control.Exception as C+#else+import System.Process hiding (readProcess)+import qualified Control.OldException as C+#endif+ import System.Exit import System.IO import Data.List@@ -8,7 +16,6 @@ import Control.Monad import Control.Concurrent-import qualified Control.Exception as C import Text.Printf import Text.Regex.PCRE.Light.Char8
tests/Fusion/Test.hs view
@@ -1,5 +1,13 @@+{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ < 610 import System.Process+import qualified Control.Exception as C+#else+import System.Process hiding (readProcess)+import qualified Control.OldException as C+#endif+ import System.Exit import System.IO import Data.List@@ -8,7 +16,6 @@ import Control.Monad import Control.Concurrent-import qualified Control.Exception as C import Text.Printf import Text.Regex.PCRE.Light.Char8
tests/Makefile view
@@ -1,13 +1,19 @@+# These should have dependencies on the library too so we don't need to+# force recompilation each time.+ all: hpc fusion +memcpy_extra: ../cbits/memcpy_extra.c+ $(CC) -O3 -c ../cbits/memcpy_extra.c+ FLAGS=-fglasgow-exts -O2 -funbox-strict-fields -fdicts-cheap -fno-method-sharing -fmax-simplifier-iterations10 -fcpr-off -DSAFE -cpp -I../include-hpc:+hpc: memcpy_extra rm -f run.tix- ghc ${FLAGS} -no-recomp --make Properties/Test.hs -i.. -fhpc -o run- time ./run+ ghc ${FLAGS} --make Properties/Test.hs -i.. -fhpc memcpy_extra.o -o run+ ./run hpc markup run --exclude=Properties.Utils --exclude=Properties.Monomorphic.Base --exclude=Properties.Monomorphic.UVector -fusion:+fusion: ./Fusion/*.hs ./Examples/*.hs ( cd Fusion && ghc -O --make Test.hs && ./Test ) ( cd Examples && ghc -O --make Test.hs && ./Test ) @@ -21,5 +27,7 @@ find ../Data -name '*.hi' -exec rm {} \; find ../Data -name '*.o' -exec rm {} \; rm -f fuse raw run Performance Fusion/Test Examples/Test+ rm -f memcpy_extra.o rm -f *.tix rm -rf .hpc+
tests/Properties/Monomorphic/UVector.hs view
@@ -8,7 +8,7 @@ import Properties.Utils import qualified Data.Array.Vector as List-import Data.Array.Vector (UArr, (:*:))+import Data.Array.Vector (UArr, (:*:), MaybeS) -- * Basic interface cons :: A -> UArr A -> UArr A@@ -59,8 +59,9 @@ -- ** Scans scanl :: (A -> B -> A) -> A -> UArr B -> UArr A+scanl1 :: (A -> A -> A) -> UArr A -> UArr A+ {--scanl1 :: (A -> A -> A) -> [A] -> [A] scanr :: (A -> B -> B) -> B -> [A] -> [B] scanr1 :: (A -> A -> A) -> [A] -> [A] -}@@ -71,17 +72,17 @@ mapAccumR :: (C -> A -> (C, B)) -> C -> [A] -> (C, [B]) -- ** Infinite lists-iterate :: (A -> A) -> A -> [A] repeat :: A -> [A] -}+iterate :: Int -> (A -> A) -> A -> UArr A+ replicate :: Int -> A -> UArr A {- cycle :: [A] -> [A] --- ** Unfolding-unfoldr :: (B -> Maybe (A, B)) -> B -> [A]- -}+-- ** Unfolding+unfoldr :: Int -> (B -> MaybeS (A :*: B)) -> B -> UArr A -- * Sublists -- ** Extracting sublists@@ -119,10 +120,10 @@ -- * Indexing lists index :: UArr A -> Int -> A+findIndex :: (A -> Bool) -> UArr A -> Maybe Int {- elemIndex :: A -> [A] -> Maybe Int elemIndices :: A -> [A] -> [Int]-findIndex :: (A -> Bool) -> [A] -> Maybe Int findIndices :: (A -> Bool) -> [A] -> [Int] -} @@ -146,9 +147,9 @@ zipWith6 :: (A -> B -> C -> D -> E -> F -> G) -> [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [G] zipWith7 :: (A -> B -> C -> D -> E -> F -> G -> H) -> [A] -> [B] -> [C] -> [D] -> [E] -> [F] -> [G] -> [H] -}--- unzip :: [(A, B)] -> ([A], [B])+unzip :: UArr (A :*: B) -> (UArr A :*: UArr B)+unzip3 :: UArr (A :*: B :*: C) -> (UArr A :*: UArr B :*: UArr C) {--unzip3 :: [(A, B, C)] -> ([A], [B], [C]) unzip4 :: [(A, B, C, D)] -> ([A], [B], [C], [D]) unzip5 :: [(A, B, C, D, E)] -> ([A], [B], [C], [D], [E]) unzip6 :: [(A, B, C, D, E, F)] -> ([A], [B], [C], [D], [E], [F])@@ -254,8 +255,8 @@ -- ** Scans scanl = List.scanlU+scanl1 = List.scanl1U {--scanl1 = List.scanl1 scanr = List.scanr scanr1 = List.scanr1 @@ -264,17 +265,17 @@ mapAccumR = List.mapAccumR -- ** Infinite lists-iterate = List.iterate repeat = List.repeat -}+iterate = List.iterateU replicate = List.replicateU {- cycle = List.cycle +-} -- ** Unfolding-unfoldr = List.unfoldr+unfoldr = List.unfoldU --} -- * Sublists -- ** Extracting sublists take = List.takeU@@ -310,10 +311,10 @@ -- * Indexing lists index = List.indexU+findIndex = List.findIndexU {- elemIndex = List.elemIndex elemIndices = List.elemIndices-findIndex = List.findIndex findIndices = List.findIndices -} @@ -334,9 +335,9 @@ zipWith6 = List.zipWith6 zipWith7 = List.zipWith7 -}---unzip = List.unzipU+unzip = List.unzipU+unzip3 = List.unzip3U {--unzip3 = List.unzip3 unzip4 = List.unzip4 unzip5 = List.unzip5 unzip6 = List.unzip6
+ tests/Properties/Specific.hs view
@@ -0,0 +1,265 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE TypeOperators #-}++module Properties.Specific where++import Properties.Utils++import Data.Array.Vector.Stream+import Data.Array.Vector.Prim.Hyperstrict+import Data.Array.Vector++import Control.Monad.ST++import Data.Word+import Data.Int+import Data.Complex+import Data.Ratio +import Data.List++import System.IO+import System.Directory++import System.IO.Unsafe +import Debug.Trace++prop_scanResU :: (A -> A -> A) -> A -> UArr A -> Bool+prop_scanResU f x xs = ((\(initU :*: lastU) -> fromU initU ++ [lastU]) $ scanResU f x xs) == scanl f x (fromU xs)+++-- Not dealing with the allocation size parameter for now+prop_replicateEachU :: PosUArr -> UArr A -> Bool+prop_replicateEachU (PosUArr r) e = replicateEachU (sumU r) r e == (toU . concat $ zipWith replicate (fromU r) (fromU e))++-- FIXME: doesn't check negative numbers+prop_unitsU n = n >= 0 ==> (fromU . unitsU $ n) == replicate n ()++prop_indexedU :: UArr A -> Bool+prop_indexedU xs = indexedU xs == (toU . zipWith (:*:) [0..] . fromU $ xs)++prop_fstU :: UArr (A :*: B) -> Bool+prop_fstU xs = (fromU . fstU $ xs) == (map fstS . fromU $ xs)++prop_sndU :: UArr (A :*: B) -> Bool+prop_sndU xs = (fromU . sndU $ xs) == (map sndS . fromU $ xs)++prop_repeatU :: Int -> UArr A -> Property+prop_repeatU n xs = n > 0 ==> (fromU $ repeatU n xs) == (concat $ replicate n (fromU xs))++-- FIXME: test for mismatching lengths when it stops crashing the testsuite+prop_packU :: ELUArrs A Bool -> Bool+prop_packU (ELUArrs xs fs) = (fromU $ packU xs fs) == (map fst . filter snd $ zip (fromU xs) (fromU fs))++prop_foldl1MaybeU :: (A -> A -> A) -> UArr A -> Bool+prop_foldl1MaybeU f xs = case foldl1MaybeU f xs of+ JustS a -> a == foldl1 f (fromU xs)+ _ -> nullU xs+-- FIXME: DRY+prop_fold1MaybeU :: (A -> A -> A) -> UArr A -> Bool+prop_fold1MaybeU f xs = case fold1MaybeU f xs of+ JustS a -> a == foldl1 f (fromU xs)+ _ -> nullU xs++prop_scanU :: (A -> A -> A) -> A -> UArr A -> Bool+prop_scanU f x xs = (fromU $ scanU f x xs) == (init $ scanl f x (fromU xs))++-- FIXME: test for empty input exception+prop_scan1U :: (A -> A -> A) -> UArr A -> Property+prop_scan1U f xs = (not . nullU $ xs) ==>+ (fromU $ scan1U f xs) == (scanl1 f (fromU xs))+ +prop_mapAccumLU :: (C -> A -> C :*: B) -> C -> UArr A -> Bool+prop_mapAccumLU f x xs = (fromU $ mapAccumLU f x xs) == (snd $ mapAccumL (\a b -> unpairS $ f a b) x (fromU xs))++-- FIXME: we want to test cases in which the generating array doesn't satisfy +-- our conditions, too.+prop_combineU :: (CombineGen A) -> Property+prop_combineU (CombineGen f xs ys) = (lengthU $ filterU id f) == lengthU xs + && (lengthU $ filterU not f) == lengthU ys ==>+ (fromU $ combineU f xs ys) == (reverse . snd $ foldl (\((xs, ys), acc) a -> if a then ((tail xs, ys), (head xs):acc) else ((xs, tail ys), (head ys):acc)) ((fromU xs, fromU ys), []) (fromU f))++------------------------------------------------------------------------+-- *** Enumerated array generators++prop_enumFromToU :: Int -> Int -> Bool+prop_enumFromToU start end = (fromU $ enumFromToU start end) == [start..end]++-- FIXME: not checking when end > start or if either is negative (those should all throw exceptions probably)+prop_enumFromToFracU :: Double -> Double -> Property+prop_enumFromToFracU start end = start <= end ==> (property $ (fromU $ enumFromToFracU start end) == [start..end])++prop_enumFromThenToU :: Int -> Int -> Int -> Property+prop_enumFromThenToU start next end = next /= start ==> (property $ (fromU $ enumFromThenToU start next end) == [start,next..end])++-- FIXME: not checking the length for now+prop_enumFromStepLenU :: Int -> Int -> Int -> Property+prop_enumFromStepLenU start step len = len >= 0 ==> (property $ (fromU $ enumFromStepLenU start step len) == (take len $ [start, (start + step)..]))++-- FIXME: not checking the length for now+prop_enumFromToEachU :: UArr (Int :*: Int) -> Bool+prop_enumFromToEachU reps = (fromU $ enumFromToEachU (sumU . mapU (\(x :*: y) -> max (y - x + 1) 0) $ reps) reps) == (concatMap (\(x :*: y) -> [x..y]) . fromU $ reps)++------------------------------------------------------------------------+-- *** Representation-specific operations++-- These aren't very good tests...+prop_lengthU :: (UA a, Show a) => UArr a -> Bool+prop_lengthU xs = lengthU xs == (length . fromU $ xs)+ +prop_indexU :: (UA a, Eq a, Show a) => UArr a -> Int -> Property+prop_indexU xs i = i >= 0 && i < lengthU xs ==>+ xs `indexU` i == ((!! i) . fromU $ xs)+ +-- FIXME: check for bounds issues rather than excluding them+prop_sliceU :: (UA a, Eq a, Show a) => BoundedIndex a -> Int -> Property+prop_sliceU (BoundedIndex u start) len = len >= 0 && start >= 0 && lengthU u > 0 ==> + (fromU $ sliceU u start len) == (take len . drop start . fromU $ u)+ +prop_newMU_copyMU_lengthMU :: (UA a, Show a) => UArr a -> Bool+prop_newMU_copyMU_lengthMU xs = runST (do let len = lengthU xs+ mu <- newMU len+ copyMU mu 0 xs+ return $ lengthMU mu == len)+ +prop_readMU :: (UA a, Eq a, Show a) => UArr a -> Int -> Property+prop_readMU xs i = i >= 0 && i < lengthU xs ==>+ runST (do let len = lengthU xs+ mu <- newMU len+ copyMU mu 0 xs+ x <- readMU mu i+ return $ x == xs `indexU` i)+ +prop_writeMU :: (UA a, Eq a, Show a) => UArr a -> Int -> a -> Property+prop_writeMU xs i e = i >= 0 && i < lengthU xs ==>+ runST (do let len = lengthU xs+ mu <- newMU len+ copyMU mu 0 xs+ writeMU mu i e+ x <- readMU mu i+ return $ x == e)+ +prop_unsafeFreezeMU :: (UA a, Eq a, Show a) => UArr a -> Int -> Property+prop_unsafeFreezeMU xs len = len >= 0 && len < lengthU xs ==>+ runST (do let l = lengthU xs+ mu <- newMU l+ copyMU mu 0 xs+ unsafeFreezeMU mu len) == takeU len xs+ +prop_hPutU_hGetU :: (UIO a, Eq a, Show a) => UArr a -> Bool+prop_hPutU_hGetU xs = unsafePerformIO $+ do tmp <- getTemporaryDirectory+ (path, h) <- openTempFile tmp "uvector_test"+ hPutU h xs+ hSeek h AbsoluteSeek 0+ ys <- hGetU h+ hClose h+ removeFile path+ return $ xs == ys+ +prop_memcpyMU :: (UA a, Eq a, Show a) => UArr a -> Int -> Property+prop_memcpyMU xs len = len >= 0 && len < lengthU xs ==> takeU len frozen == takeU len xs+ where frozen = runST (do mu <- newMU $ lengthU xs+ mu1 <- newMU $ lengthU xs+ copyMU mu 0 xs+ memcpyMU mu mu1 len+ unsafeFreezeAllMU mu1)++prop_memcpyOffMU :: (UA a, Eq a, Show a) => Ind2LenUArr a -> Property+prop_memcpyOffMU (Ind2LenUArr xs startxs startys len) = + len >= 0 && startxs + len < lengthU xs && startys + len < lengthU xs &&+ startxs >= 0 && startys >= 0 ==>+ sliceU xs startxs len == sliceU frozen startys len+ where frozen = runST (do mu <- newMU $ lengthU xs+ mu1 <- newMU $ lengthU xs+ copyMU mu 0 xs+ memcpyOffMU mu mu1 startxs startys len+ unsafeFreezeAllMU mu1)+ +prop_memmoveOffMU :: (UA a, Eq a, Show a) => Ind2LenUArr a -> Property+prop_memmoveOffMU (Ind2LenUArr xs startxs startys len) = + len >= 0 && startxs + len < lengthU xs && startys + len < lengthU xs &&+ startxs >= 0 && startys >= 0 ==>+ sliceU xs startxs len == sliceU frozen startys len+ where frozen = runST (do mu <- newMU $ lengthU xs+ copyMU mu 0 xs+ memmoveOffMU mu mu startxs startys len+ unsafeFreezeAllMU mu)++------------------------------------------------------------++prop_unsafeFreezeAllMU :: UArr A -> Bool+prop_unsafeFreezeAllMU xs = + runST (do mu <- newMU $ lengthU xs+ copyMU mu 0 xs+ unsafeFreezeAllMU mu) == xs+ +prop_newU :: UArr A -> Bool+prop_newU a = newU (lengthU a) (\a' -> copyMU a' 0 a) == a++------------------------------------------------------------------------------++-- these are a bit silly, but I'm aiming for 100% coverage++prop_fstS :: A -> B -> Bool+prop_fstS a b = fstS (a :*: b) == a++prop_sndS :: A -> B -> Bool+prop_sndS a b = sndS (a :*: b) == b++prop_pairS :: A -> B -> Bool+prop_pairS a b = pairS (a, b) == (a :*: b)++prop_unpairS :: A -> B -> Bool+prop_unpairS a b = unpairS (a :*: b) == (a, b)++prop_curryS :: (A :*: B -> C) -> A -> B -> Bool+prop_curryS f a b = curryS f a b == f (a :*: b)++prop_uncurryS :: (A -> B -> C) -> A -> B -> Bool+prop_uncurryS f a b = uncurryS f (a :*: b) == f a b++prop_unsafePairS :: A -> B -> Bool+prop_unsafePairS a b = unsafe_pairS (a, b) == (a :*: b)++prop_unsafeUnpairS :: A -> B -> Bool+prop_unsafeUnpairS a b = unsafe_unpairS (a :*: b) == (a, b)++prop_maybeS :: B -> (A -> B) -> MaybeS A -> Bool+prop_maybeS b f m@(JustS a) = maybeS b f m == f a+prop_maybeS b f m = maybeS b f m == b++prop_fromMaybeS :: A -> MaybeS A -> Bool+prop_fromMaybeS x m@(JustS a) = fromMaybeS x m == a+prop_fromMaybeS x m = fromMaybeS x m == x++prop_functorMaybeS :: (A -> MaybeS A) -> MaybeS A -> Bool+prop_functorMaybeS f m@(JustS a) = fmap f m == JustS (f a)+prop_functorMaybeS f m = fmap f m == NothingS++------------------------------------------------------------------------------++prop_show_read :: UArr A -> Bool+prop_show_read xs = (read . show $ xs) == xs++------------------------------------------------------------------------------++prop_unsafeZipMU :: ELUArrs A A -> Bool+prop_unsafeZipMU (ELUArrs a b) = fstU prod == a && sndU prod == b+ where prod = runST (do let aLen = lengthU a+ let bLen = lengthU b+ aMU <- newMU aLen+ bMU <- newMU bLen+ copyMU aMU 0 a+ copyMU bMU 0 b+ unsafeFreezeAllMU $ unsafeZipMU aMU bMU)+ +prop_unsafeUnzipMU :: UArr (A :*: B) -> Bool+prop_unsafeUnzipMU xs = fstU xs == x && sndU xs == y+ where x = runST (do let len = lengthU xs+ mu <- newMU len+ copyMU mu 0 xs+ (\(x :*: y) -> unsafeFreezeAllMU x) $ unsafeUnzipMU mu)+ y = runST (do let len = lengthU xs+ mu <- newMU len+ copyMU mu 0 xs+ (\(x :*: y) -> unsafeFreezeAllMU y) $ unsafeUnzipMU mu)
tests/Properties/Test.hs view
@@ -10,6 +10,7 @@ import System.IO import System.Environment import Properties.Utils+import Debug.Trace import qualified Data.Array.Vector as Test import qualified Properties.Monomorphic.UVector as Test -- stream functions@@ -19,7 +20,12 @@ import Data.Array.Vector.Prim.Hyperstrict import Data.Array.Vector +import Properties.Specific +import Data.Word+import Data.Int+import Data.Complex+import Data.Ratio -- -- Data.Stream <=> Data.List@@ -85,9 +91,10 @@ -- * Building lists -- ** Scans --- prop_scanl = (\f x xs -> Test.snoc (Test.scanl f x xs) x) `eq3` Spec.scanl+prop_scanl = Test.scanl `eq3` (\f x xs -> Spec.init $ Spec.scanl f x xs)+prop_scanl1 = Test.scanl1 `eqnotnull2` Spec.scanl1+ {--prop_scanl1 = Test.scanl1 `eq2` Spec.scanl1 -- prop_scanr = Test.scanr `eq3` Spec.scanr {-@@ -108,16 +115,18 @@ prop_iterate = Test.iterate `eqfinite2` Spec.iterate prop_repeat = Test.repeat `eqfinite1` Spec.repeat -}+prop_iterate = \x -> x >= 0 ==> Test.iterate x `eq2` ((Spec.take x .) . Spec.iterate) prop_replicate = \x -> x >= 0 ==> Test.replicate x `eq1` Spec.replicate x+ {- prop_cycle = \x -> not (null x) ==> (Test.cycle `eqfinite1` Spec.cycle) x-+-} ------------------------------------------------------------------------+ -- ** Unfolding -prop_unfoldr = Test.unfoldr `eqfinite2` Spec.unfoldr--}+prop_unfoldr = \x -> x >= 0 ==> Test.unfoldr x `eq2` ((Spec.take x .) . Spec.unfoldr) ------------------------------------------------------------------------ -- * Sublists@@ -155,9 +164,7 @@ prop_elem = Test.elem `eq2` Spec.elem prop_notElem = Test.notElem `eq2` Spec.notElem -- no specific implementation -{--prop_lookup = Test.lookup `eq2` Spec.lookup--}+prop_lookup a xs= Test.lookup a xs == Spec.lookup a (map unpairS . fromU $ xs) ------------------------------------------------------------------------ -- ** Searching with a predicate@@ -176,8 +183,8 @@ prop_index = \xs n -> n >= 0 && n < Test.length xs ==> (Test.index `eq2` Spec.index) xs n -{- prop_findIndex = Test.findIndex `eq2` Spec.findIndex+{- prop_elemIndex = Test.elemIndex `eq2` Spec.elemIndex prop_elemIndices = Test.elemIndices `eq2` Spec.elemIndices prop_findIndices = Test.findIndices `eq2` Spec.findIndices@@ -186,11 +193,16 @@ ------------------------------------------------------------------------ -- * Zipping and unzipping lists --- prop_zip = Test.zip `eq2` Spec.zip--- prop_zip3 = Test.zip3 `eq3` Spec.zip3+-- To not be this ugly, we would need to define a NatTrans instance for UArr to [],+-- which requires a Functor instance on UArr, which seems currently impossible+-- due to the UA restriction on the UArr elements. RFunctor could work, but we'd+-- need to rewire quickcheck to use that, so this is probably easier.+--+prop_zip (ELUArrs a b) = (map unpairS . fromU $ Test.zip a b) == Spec.zip (fromU a) (fromU b)+prop_zip3 (ELUArrs3 a b c) = (map (\(x :*: y :*: z) -> (x, y, z)) . fromU $ Test.zip3 a b c) == Spec.zip3 (fromU a) (fromU b) (fromU c) --- prop_zipWith = Test.zipWith `eq3` Spec.zipWith--- prop_zipWith3 = Test.zipWith3 `eq4` Spec.zipWith3+prop_zipWith f (ELUArrs a b) = (fromU $ Test.zipWith f a b) == Spec.zipWith f (fromU a) (fromU b)+prop_zipWith3 f (ELUArrs3 a b c) = (fromU $ Test.zipWith3 f a b c) == Spec.zipWith3 f (fromU a) (fromU b) (fromU c) {- prop_zip4 = Test.zip4 `eq4` Spec.zip4@@ -205,10 +217,10 @@ ------------------------------------------------------------------------ --- prop_unzip = Test.unzip `eq1` Spec.unzip+prop_unzip xs = ((\(x :*: y) -> (fromU x, fromU y)) . Test.unzip $ (toU . map pairS $ xs)) == Spec.unzip xs+prop_unzip3 xs = ((\(x :*: y :*: z) -> (fromU x, fromU y, fromU z)) . Test.unzip3 $ (toU . map (\(x, y, z) -> (x :*: y :*: z)) $ xs)) == Spec.unzip3 xs {--prop_unzip3 = Test.unzip3 `eq1` Spec.unzip3 prop_unzip4 = Test.unzip4 `eq1` Spec.unzip4 prop_unzip5 = Test.unzip5 `eq1` Spec.unzip5 prop_unzip6 = Test.unzip6 `eq1` Spec.unzip6@@ -232,7 +244,7 @@ {- prop_nub = Test.nub `eq1` Spec.nub prop_delete = Test.delete `eq2` Spec.delete-prop_difference = (Test.\\) `eq2` (Spec.\\)+prop_difference = (Test.\) `eq2` (Spec.\) prop_union = Test.union `eq2` Spec.union prop_intersect = Test.intersect `eq2` Spec.intersect -}@@ -270,11 +282,9 @@ -} - prop_maximumBy = Test.maximumBy `eqnotnull2` Spec.maximumBy prop_minimumBy = Test.minimumBy `eqnotnull2` Spec.minimumBy - {- ------------------------------------------------------------------------ -- * The \"generic\" operations@@ -302,7 +312,7 @@ _ -> opts hSetBuffering stdout NoBuffering- putStrLn "Testing: Data.Stream <=> Data.List"+ putStrLn "Testing: Data.Array.Vector <=> Data.List" putStrLn "==================================\n" runTests "Extras" opts'@@ -323,7 +333,7 @@ ,run prop_length ] - runTests "List transformations" opts'+ runTests "Array transformations" opts' [run prop_map {- -- ,run prop_reverse@@ -333,7 +343,7 @@ -} ] - runTests "Reducing lists (folds)" opts'+ runTests "Reducing arrays (folds)" opts' [run prop_foldl -- ,run prop_foldr @@ -341,6 +351,9 @@ -- ,run prop_foldl' -- ,run prop_foldl1' -- ,run prop_foldr1+ ,run prop_foldl1MaybeU+ ,run prop_fold1MaybeU+ ,run prop_mapAccumLU ] runTests "Special folds" opts'@@ -358,8 +371,11 @@ ] runTests "Scans" opts'- [-- run prop_scanl--- ,run prop_scanl1+ [run prop_scanl+ ,run prop_scanl1+ ,run prop_scanResU+ ,run prop_scanU+ ,run prop_scan1U -- ,run prop_scanr -- ,run prop_scanr1 ]@@ -371,20 +387,24 @@ ] -} - runTests "Infinite lists" opts'- [-- run prop_iterate- --,run prop_repeat- run prop_replicate+ runTests "Generating arrays" opts'+ [run prop_iterate+ ,run prop_repeatU+ ,run prop_replicate+ ,run prop_replicateEachU+ ,run prop_unitsU+ ,run prop_packU+ ,run prop_combineU -- ,run prop_cycle ] -{-+ runTests "Unfolding" opts' [run prop_unfoldr ]--} - runTests "Extracting sublists" opts'++ runTests "Extracting subarrays" opts' [run prop_take ,run prop_drop ,run prop_splitAt@@ -408,7 +428,7 @@ runTests "Searching by equality" opts' [run prop_elem ,run prop_notElem-- no specific implementation--- ,run prop_lookup+ ,run prop_lookup ] runTests "Searching by a predicate" opts'@@ -417,24 +437,24 @@ -- ,run prop_partition ] - runTests "Indexing lists" opts'+ runTests "Indexing arrays" opts' [run prop_index--- ,run prop_findIndex+ ,run prop_indexedU+ ,run prop_findIndex -- ,run prop_elemIndex -- ,run prop_elemIndices -- ,run prop_findIndices ] runTests "Zipping" opts'- [--- run prop_zip--- ,run prop_zip3+ [run prop_zip+ ,run prop_zip3 -- ,run prop_zip4 -- ,run prop_zip5 -- ,run prop_zip6 -- ,run prop_zip7--- ,run prop_zipWith--- ,run prop_zipWith3+ ,run prop_zipWith+ ,run prop_zipWith3 -- ,run prop_zipWith4 -- ,run prop_zipWith5 -- ,run prop_zipWith6@@ -442,8 +462,10 @@ ] runTests "Unzipping" opts'- [-- run prop_unzip--- ,run prop_unzip3+ [run prop_fstU+ ,run prop_sndU+ ,run prop_unzip+ ,run prop_unzip3 -- ,run prop_unzip4 -- ,run prop_unzip5 -- ,run prop_unzip6@@ -495,6 +517,290 @@ ,run prop_minimumBy ] + runTests "Enumerated arrays" opts'+ [run prop_enumFromToU+ ,run prop_enumFromToFracU+ ,run prop_enumFromThenToU+ ,run prop_enumFromStepLenU+ ,run prop_enumFromToEachU+ ]+ + runTests "Mutable arrays" opts'+ [run prop_unsafeFreezeAllMU+ ,run prop_newU+ ,run prop_unsafeZipMU+ ,run prop_unsafeUnzipMU+ ]+ + runTests "Hyperstrict" opts'+ [run prop_fstS+ ,run prop_sndS+ ,run prop_pairS + ,run prop_unpairS+ ,run prop_curryS+ ,run prop_uncurryS+ ,run prop_unsafePairS+ ,run prop_unsafeUnpairS+ ,run prop_maybeS+ ,run prop_fromMaybeS+ ,run prop_functorMaybeS+ ]+ + runTests "Text output" opts'+ [run prop_show_read+ ]+ + -- These are a little overkillish (and should be generated by TH, probably)+ + runTests "()-specific" opts'+ [run (prop_lengthU :: UArr () -> Bool)+ ,run (prop_indexU :: UArr () -> Int -> Property)+ ,run (prop_sliceU :: BoundedIndex () -> Int -> Property)+ ,run (prop_newMU_copyMU_lengthMU :: UArr () -> Bool)+ ,run (prop_readMU :: UArr () -> Int -> Property)+ ,run (prop_writeMU :: UArr () -> Int -> () -> Property)+ ,run (prop_unsafeFreezeMU :: UArr () -> Int -> Property)+ ,run (prop_memcpyMU :: UArr () -> Int -> Property)+ ,run (prop_memcpyOffMU :: Ind2LenUArr () -> Property)+ ,run (prop_memmoveOffMU :: Ind2LenUArr () -> Property)+ ]+ + runTests "(a :*: b)-specific" opts'+ [run (prop_lengthU :: UArr (A :*: B) -> Bool)+ ,run (prop_indexU :: UArr (A :*: B) -> Int -> Property)+ ,run (prop_sliceU :: BoundedIndex (A :*: B) -> Int -> Property)+ ,run (prop_newMU_copyMU_lengthMU :: UArr (A :*: B) -> Bool)+ ,run (prop_readMU :: UArr (A :*: B) -> Int -> Property)+ ,run (prop_writeMU :: UArr (A :*: B) -> Int -> (A :*: B) -> Property)+ ,run (prop_unsafeFreezeMU :: UArr (A :*: B) -> Int -> Property)+ ,run (prop_memcpyMU :: UArr (A :*: B) -> Int -> Property)+ ,run (prop_memcpyOffMU :: Ind2LenUArr (A :*: B) -> Property)+ ,run (prop_memmoveOffMU :: Ind2LenUArr (A :*: B) -> Property)+ ]+ + runTests "Bool-specific" opts'+ [run (prop_lengthU :: UArr Bool -> Bool)+ ,run (prop_indexU :: UArr Bool -> Int -> Property)+ ,run (prop_sliceU :: BoundedIndex Bool -> Int -> Property)+ ,run (prop_newMU_copyMU_lengthMU :: UArr Bool -> Bool)+ ,run (prop_readMU :: UArr Bool -> Int -> Property)+ ,run (prop_writeMU :: UArr Bool -> Int -> Bool -> Property)+ ,run (prop_unsafeFreezeMU :: UArr Bool -> Int -> Property)+ ,run (prop_memcpyMU :: UArr Bool -> Int -> Property)+ ,run (prop_memcpyOffMU :: Ind2LenUArr Bool -> Property)+ ,run (prop_memmoveOffMU :: Ind2LenUArr Bool -> Property)+ ,run (prop_hPutU_hGetU :: UArr Bool -> Bool)+ ]+ + runTests "Char-specific" opts'+ [run (prop_lengthU :: UArr Char -> Bool)+ ,run (prop_indexU :: UArr Char -> Int -> Property)+ ,run (prop_sliceU :: BoundedIndex Char -> Int -> Property)+ ,run (prop_newMU_copyMU_lengthMU :: UArr Char -> Bool)+ ,run (prop_readMU :: UArr Char -> Int -> Property)+ ,run (prop_writeMU :: UArr Char -> Int -> Char -> Property)+ ,run (prop_unsafeFreezeMU :: UArr Char -> Int -> Property)+ ,run (prop_memcpyMU :: UArr Char -> Int -> Property)+ ,run (prop_memcpyOffMU :: Ind2LenUArr Char -> Property)+ ,run (prop_memmoveOffMU :: Ind2LenUArr Char -> Property)+ ,run (prop_hPutU_hGetU :: UArr Char -> Bool)+ ]+ + runTests "Int-specific" opts'+ [run (prop_lengthU :: UArr Int -> Bool)+ ,run (prop_indexU :: UArr Int -> Int -> Property)+ ,run (prop_sliceU :: BoundedIndex Int -> Int -> Property)+ ,run (prop_newMU_copyMU_lengthMU :: UArr Int -> Bool)+ ,run (prop_readMU :: UArr Int -> Int -> Property)+ ,run (prop_writeMU :: UArr Int -> Int -> Int -> Property)+ ,run (prop_unsafeFreezeMU :: UArr Int -> Int -> Property)+ ,run (prop_memcpyMU :: UArr Int -> Int -> Property)+ ,run (prop_memcpyOffMU :: Ind2LenUArr Int -> Property)+ ,run (prop_memmoveOffMU :: Ind2LenUArr Int -> Property)+ ,run (prop_hPutU_hGetU :: UArr Int -> Bool)+ ]++ runTests "Word-specific" opts'+ [run (prop_lengthU :: UArr Word -> Bool)+ ,run (prop_indexU :: UArr Word -> Int -> Property)+ ,run (prop_sliceU :: BoundedIndex Word -> Int -> Property)+ ,run (prop_newMU_copyMU_lengthMU :: UArr Word -> Bool)+ ,run (prop_readMU :: UArr Word -> Int -> Property)+ ,run (prop_writeMU :: UArr Word -> Int -> Word -> Property)+ ,run (prop_unsafeFreezeMU :: UArr Word -> Int -> Property)+ ,run (prop_memcpyMU :: UArr Word -> Int -> Property)+ ,run (prop_memcpyOffMU :: Ind2LenUArr Word -> Property)+ ,run (prop_memmoveOffMU :: Ind2LenUArr Word -> Property)+ ,run (prop_hPutU_hGetU :: UArr Word -> Bool)+ ]+ + runTests "Float-specific" opts'+ [run (prop_lengthU :: UArr Float -> Bool)+ ,run (prop_indexU :: UArr Float -> Int -> Property)+ ,run (prop_sliceU :: BoundedIndex Float -> Int -> Property)+ ,run (prop_newMU_copyMU_lengthMU :: UArr Float -> Bool)+ ,run (prop_readMU :: UArr Float -> Int -> Property)+ ,run (prop_writeMU :: UArr Float -> Int -> Float -> Property)+ ,run (prop_unsafeFreezeMU :: UArr Float -> Int -> Property)+ ,run (prop_memcpyMU :: UArr Float -> Int -> Property)+ ,run (prop_memcpyOffMU :: Ind2LenUArr Float -> Property)+ ,run (prop_memmoveOffMU :: Ind2LenUArr Float -> Property)+ ,run (prop_hPutU_hGetU :: UArr Float -> Bool)+ ]++ runTests "Double-specific" opts'+ [run (prop_lengthU :: UArr Double -> Bool)+ ,run (prop_indexU :: UArr Double -> Int -> Property)+ ,run (prop_sliceU :: BoundedIndex Double -> Int -> Property)+ ,run (prop_newMU_copyMU_lengthMU :: UArr Double -> Bool)+ ,run (prop_readMU :: UArr Double -> Int -> Property)+ ,run (prop_writeMU :: UArr Double -> Int -> Double -> Property)+ ,run (prop_unsafeFreezeMU :: UArr Double -> Int -> Property)+ ,run (prop_memcpyMU :: UArr Double -> Int -> Property)+ ,run (prop_memcpyOffMU :: Ind2LenUArr Double -> Property)+ ,run (prop_memmoveOffMU :: Ind2LenUArr Double -> Property)+ ,run (prop_hPutU_hGetU :: UArr Double -> Bool)+ ]++ runTests "Word8-specific" opts'+ [run (prop_lengthU :: UArr Word8 -> Bool)+ ,run (prop_indexU :: UArr Word8 -> Int -> Property)+ ,run (prop_sliceU :: BoundedIndex Word8 -> Int -> Property)+ ,run (prop_newMU_copyMU_lengthMU :: UArr Word8 -> Bool)+ ,run (prop_readMU :: UArr Word8 -> Int -> Property)+ ,run (prop_writeMU :: UArr Word8 -> Int -> Word8 -> Property)+ ,run (prop_unsafeFreezeMU :: UArr Word8 -> Int -> Property)+ ,run (prop_memcpyMU :: UArr Word8 -> Int -> Property)+ ,run (prop_memcpyOffMU :: Ind2LenUArr Word8 -> Property)+ ,run (prop_memmoveOffMU :: Ind2LenUArr Word8 -> Property)+ ,run (prop_hPutU_hGetU :: UArr Word8 -> Bool)+ ]++ runTests "Word16-specific" opts'+ [run (prop_lengthU :: UArr Word16 -> Bool)+ ,run (prop_indexU :: UArr Word16 -> Int -> Property)+ ,run (prop_sliceU :: BoundedIndex Word16 -> Int -> Property)+ ,run (prop_newMU_copyMU_lengthMU :: UArr Word16 -> Bool)+ ,run (prop_readMU :: UArr Word16 -> Int -> Property)+ ,run (prop_writeMU :: UArr Word16 -> Int -> Word16 -> Property)+ ,run (prop_unsafeFreezeMU :: UArr Word16 -> Int -> Property)+ ,run (prop_memcpyMU :: UArr Word16 -> Int -> Property)+ ,run (prop_memcpyOffMU :: Ind2LenUArr Word16 -> Property)+ ,run (prop_memmoveOffMU :: Ind2LenUArr Word16 -> Property)+ ,run (prop_hPutU_hGetU :: UArr Word16 -> Bool)+ ]++ runTests "Word32-specific" opts'+ [run (prop_lengthU :: UArr Word32 -> Bool)+ ,run (prop_indexU :: UArr Word32 -> Int -> Property)+ ,run (prop_sliceU :: BoundedIndex Word32 -> Int -> Property)+ ,run (prop_newMU_copyMU_lengthMU :: UArr Word32 -> Bool)+ ,run (prop_readMU :: UArr Word32 -> Int -> Property)+ ,run (prop_writeMU :: UArr Word32 -> Int -> Word32 -> Property)+ ,run (prop_unsafeFreezeMU :: UArr Word32 -> Int -> Property)+ ,run (prop_memcpyMU :: UArr Word32 -> Int -> Property)+ ,run (prop_memcpyOffMU :: Ind2LenUArr Word32 -> Property)+ ,run (prop_memmoveOffMU :: Ind2LenUArr Word32 -> Property)+ ,run (prop_hPutU_hGetU :: UArr Word32 -> Bool)+ ]++ runTests "Word64-specific" opts'+ [run (prop_lengthU :: UArr Word64 -> Bool)+ ,run (prop_indexU :: UArr Word64 -> Int -> Property)+ ,run (prop_sliceU :: BoundedIndex Word64 -> Int -> Property)+ ,run (prop_newMU_copyMU_lengthMU :: UArr Word64 -> Bool)+ ,run (prop_readMU :: UArr Word64 -> Int -> Property)+ ,run (prop_writeMU :: UArr Word64 -> Int -> Word64 -> Property)+ ,run (prop_unsafeFreezeMU :: UArr Word64 -> Int -> Property)+ ,run (prop_memcpyMU :: UArr Word64 -> Int -> Property)+ ,run (prop_memcpyOffMU :: Ind2LenUArr Word64 -> Property)+ ,run (prop_memmoveOffMU :: Ind2LenUArr Word64 -> Property)+ ,run (prop_hPutU_hGetU :: UArr Word64 -> Bool)+ ]++ runTests "Int8-specific" opts'+ [run (prop_lengthU :: UArr Int8 -> Bool)+ ,run (prop_indexU :: UArr Int8 -> Int -> Property)+ ,run (prop_sliceU :: BoundedIndex Int8 -> Int -> Property)+ ,run (prop_newMU_copyMU_lengthMU :: UArr Int8 -> Bool)+ ,run (prop_readMU :: UArr Int8 -> Int -> Property)+ ,run (prop_writeMU :: UArr Int8 -> Int -> Int8 -> Property)+ ,run (prop_unsafeFreezeMU :: UArr Int8 -> Int -> Property)+ ,run (prop_memcpyMU :: UArr Int8 -> Int -> Property)+ ,run (prop_memcpyOffMU :: Ind2LenUArr Int8 -> Property)+ ,run (prop_memmoveOffMU :: Ind2LenUArr Int8 -> Property)+ ,run (prop_hPutU_hGetU :: UArr Int8 -> Bool)+ ]++ runTests "Int16-specific" opts'+ [run (prop_lengthU :: UArr Int16 -> Bool)+ ,run (prop_indexU :: UArr Int16 -> Int -> Property)+ ,run (prop_sliceU :: BoundedIndex Int16 -> Int -> Property)+ ,run (prop_newMU_copyMU_lengthMU :: UArr Int16 -> Bool)+ ,run (prop_readMU :: UArr Int16 -> Int -> Property)+ ,run (prop_writeMU :: UArr Int16 -> Int -> Int16 -> Property)+ ,run (prop_unsafeFreezeMU :: UArr Int16 -> Int -> Property)+ ,run (prop_memcpyMU :: UArr Int16 -> Int -> Property)+ ,run (prop_memcpyOffMU :: Ind2LenUArr Int16 -> Property)+ ,run (prop_memmoveOffMU :: Ind2LenUArr Int16 -> Property)+ ,run (prop_hPutU_hGetU :: UArr Int16 -> Bool)+ ]++ runTests "Int32-specific" opts'+ [run (prop_lengthU :: UArr Int32 -> Bool)+ ,run (prop_indexU :: UArr Int32 -> Int -> Property)+ ,run (prop_sliceU :: BoundedIndex Int32 -> Int -> Property)+ ,run (prop_newMU_copyMU_lengthMU :: UArr Int32 -> Bool)+ ,run (prop_readMU :: UArr Int32 -> Int -> Property)+ ,run (prop_writeMU :: UArr Int32 -> Int -> Int32 -> Property)+ ,run (prop_unsafeFreezeMU :: UArr Int32 -> Int -> Property)+ ,run (prop_memcpyMU :: UArr Int32 -> Int -> Property)+ ,run (prop_memcpyOffMU :: Ind2LenUArr Int32 -> Property)+ ,run (prop_memmoveOffMU :: Ind2LenUArr Int32 -> Property)+ ,run (prop_hPutU_hGetU :: UArr Int32 -> Bool)+ ]++ runTests "Int64-specific" opts'+ [run (prop_lengthU :: UArr Int64 -> Bool)+ ,run (prop_indexU :: UArr Int64 -> Int -> Property)+ ,run (prop_sliceU :: BoundedIndex Int64 -> Int -> Property)+ ,run (prop_newMU_copyMU_lengthMU :: UArr Int64 -> Bool)+ ,run (prop_readMU :: UArr Int64 -> Int -> Property)+ ,run (prop_writeMU :: UArr Int64 -> Int -> Int64 -> Property)+ ,run (prop_unsafeFreezeMU :: UArr Int64 -> Int -> Property)+ ,run (prop_memcpyMU :: UArr Int64 -> Int -> Property)+ ,run (prop_memcpyOffMU :: Ind2LenUArr Int64 -> Property)+ ,run (prop_memmoveOffMU :: Ind2LenUArr Int64 -> Property)+ ,run (prop_hPutU_hGetU :: UArr Int64 -> Bool)+ ]++ runTests "Complex-specific" opts'+ [run (prop_lengthU :: UArr (Complex Double) -> Bool)+ ,run (prop_indexU :: UArr (Complex Double) -> Int -> Property)+ ,run (prop_sliceU :: BoundedIndex (Complex Double) -> Int -> Property)+ ,run (prop_newMU_copyMU_lengthMU :: UArr (Complex Double) -> Bool)+ ,run (prop_readMU :: UArr (Complex Double) -> Int -> Property)+ ,run (prop_writeMU :: UArr (Complex Double) -> Int -> (Complex Double) -> Property)+ ,run (prop_unsafeFreezeMU :: UArr (Complex Double) -> Int -> Property)+ ,run (prop_memcpyMU :: UArr (Complex Double) -> Int -> Property)+ ,run (prop_memcpyOffMU :: Ind2LenUArr (Complex Double) -> Property)+ ,run (prop_memmoveOffMU :: Ind2LenUArr (Complex Double) -> Property)+ --,run (prop_hPutU_hGetU :: UArr (Complex Float) -> Bool)+ ]+ + runTests "Ratio-specific" opts'+ [run (prop_lengthU :: UArr (Ratio Int) -> Bool)+ ,run (prop_indexU :: UArr (Ratio Int) -> Int -> Property)+ ,run (prop_sliceU :: BoundedIndex (Ratio Int) -> Int -> Property)+ ,run (prop_newMU_copyMU_lengthMU :: UArr (Ratio Int) -> Bool)+ ,run (prop_readMU :: UArr (Ratio Int) -> Int -> Property)+ ,run (prop_writeMU :: UArr (Ratio Int) -> Int -> (Ratio Int) -> Property)+ ,run (prop_unsafeFreezeMU :: UArr (Ratio Int) -> Int -> Property)+ ,run (prop_memcpyMU :: UArr (Ratio Int) -> Int -> Property)+ ,run (prop_memcpyOffMU :: Ind2LenUArr (Ratio Int) -> Property)+ ,run (prop_memmoveOffMU :: Ind2LenUArr (Ratio Int) -> Property)+ --,run (prop_hPutU_hGetU :: UArr (Ratio Int) -> Bool)+ ] {- runTests "The \"generic\" operations" opts' [run prop_genericLength
tests/Properties/Utils.hs view
@@ -16,11 +16,17 @@ import Text.Show.Functions import Control.Monad.Instances -import Control.Monad (liftM,liftM5)+import Control.Monad (liftM,liftM2,liftM5) import qualified Data.Array.Vector as S import Data.Array.Vector ((:*:)(..)) +import Data.Word+import Data.Int+import Data.Complex+import Data.Ratio+import Data.List+ opts = TestOptions { no_of_tests = 500, length_of_tests = 0,@@ -56,20 +62,72 @@ eqfinite3 f g = \x y z -> forAll arbitrary $ \n -> Prelude.take n (f x y z) == Prelude.take n (g x y z) -} -newtype A = A Int deriving (Eq, Show, Arbitrary, S.UA)-newtype B = B Int deriving (Eq, Show, Arbitrary, S.UA)-newtype C = C Int deriving (Eq, Show, Arbitrary, S.UA)+newtype A = A Int deriving (Eq, Show, Read, Arbitrary, S.UA)+newtype B = B Int deriving (Eq, Show, Read, Arbitrary, S.UA)+newtype C = C Int deriving (Eq, Show, Read, Arbitrary, S.UA) type D = A type E = B type F = C type G = A type H = B +{-}+instance NatTrans S.UArr [] where+ eta = S.fromU+-} +instance NatTrans S.MaybeS Maybe where+ eta (S.JustS a) = Just a+ eta S.NothingS = Nothing + newtype OrdA = OrdA Int deriving (Eq, Ord, Show, Arbitrary, S.UA) newtype N = N Int deriving (Eq, Ord, Num, Show, Arbitrary, S.UA) newtype I = I Int deriving (Eq, Ord, Num, Enum, Real, Integral, Show, Arbitrary, S.UA) +instance Arbitrary Word where+ arbitrary = fmap fromIntegral (arbitrary :: Gen Int)+ coarbitrary = undefined+ +instance Arbitrary Word8 where+ arbitrary = fmap fromIntegral (arbitrary :: Gen Int)+ coarbitrary = undefined+ +instance Arbitrary Word16 where+ arbitrary = fmap fromIntegral (arbitrary :: Gen Int)+ coarbitrary = undefined+ +instance Arbitrary Word32 where+ arbitrary = fmap fromIntegral (arbitrary :: Gen Int)+ coarbitrary = undefined++instance Arbitrary Word64 where+ arbitrary = fmap fromIntegral (arbitrary :: Gen Integer)+ coarbitrary = undefined++instance Arbitrary Int8 where+ arbitrary = fmap fromIntegral (arbitrary :: Gen Int)+ coarbitrary = undefined++instance Arbitrary Int16 where+ arbitrary = fmap fromIntegral (arbitrary :: Gen Int)+ coarbitrary = undefined++instance Arbitrary Int32 where+ arbitrary = fmap fromIntegral (arbitrary :: Gen Int)+ coarbitrary = undefined++instance Arbitrary Int64 where+ arbitrary = fmap fromIntegral (arbitrary :: Gen Integer)+ coarbitrary = undefined ++instance (Arbitrary a, RealFloat a) => Arbitrary (Complex a) where+ arbitrary = liftM2 (:+) arbitrary arbitrary+ coarbitrary = undefined+ +instance (Arbitrary a, Integral a) => Arbitrary (Ratio a) where+ arbitrary = liftM2 (\x y -> x % if y == 0 then 1 else y) arbitrary arbitrary+ coarbitrary = undefined+ instance Arbitrary Char where arbitrary = elements ([' ', '\n', '\0'] ++ ['a'..'h']) coarbitrary c = variant (fromEnum c `rem` 4)@@ -80,14 +138,12 @@ coarbitrary EQ = variant 1 coarbitrary GT = variant 2 -{--instance Arbitrary a => Arbitrary (Maybe a) where- arbitrary = frequency [ (1, return Nothing)- , (3, liftM Just arbitrary) ]- coarbitrary Nothing = variant 0- coarbitrary (Just a) = variant 1 . coarbitrary a- -}-+instance Arbitrary a => Arbitrary (S.MaybeS a) where+ arbitrary = frequency [ (1, return S.NothingS)+ , (3, liftM S.JustS arbitrary) ]+ coarbitrary S.NothingS = variant 0+ coarbitrary (S.JustS a) = variant 1 . coarbitrary a+ instance (Arbitrary a, Arbitrary b) => Arbitrary (a :*: b) where arbitrary = do x <- arbitrary y <- arbitrary@@ -130,6 +186,71 @@ return $ S.toU xs coarbitrary = undefined +-- To let us generate two UArrs of equal length+data ELUArrs a b = ELUArrs !(S.UArr a) !(S.UArr b)+ deriving (Show, Eq)+ +instance (S.UA a, S.UA b, Arbitrary a, Arbitrary b) => Arbitrary (ELUArrs a b) where+ arbitrary = do n <- arbitrary+ xs <- mapM (const arbitrary) $ replicate n 0+ ys <- mapM (const arbitrary) $ replicate n 0+ return $ ELUArrs (S.toU xs) (S.toU ys)+ coarbitrary = undefined+ +data ELUArrs3 a b c = ELUArrs3 !(S.UArr a) !(S.UArr b) !(S.UArr c)+ deriving (Show, Eq)++instance (S.UA a, S.UA b, S.UA c, Arbitrary a, Arbitrary b, Arbitrary c) => + Arbitrary (ELUArrs3 a b c) where+ arbitrary = do n <- arbitrary+ xs <- mapM (const arbitrary) $ replicate n 0+ ys <- mapM (const arbitrary) $ replicate n 0+ zs <- mapM (const arbitrary) $ replicate n 0+ return $ ELUArrs3 (S.toU xs) (S.toU ys) (S.toU zs)+ coarbitrary = undefined++data PosUArr = PosUArr !(S.UArr Int)+ deriving (Show, Eq)++instance Arbitrary PosUArr where+ arbitrary = do xs <- arbitrary+ -- this isn't really uniform, but whatever+ return $ PosUArr (S.toU . map abs $ xs)+ coarbitrary = undefined+ +data Ind2LenUArr a = Ind2LenUArr !(S.UArr a) !Int !Int !Int+ deriving (Show, Eq)+ +instance (Arbitrary a, S.UA a) => Arbitrary (Ind2LenUArr a) where+ arbitrary = do xs <- arbitrary+ index1 <- fmap (`mod` (length xs + 1)) arbitrary -- TODO: check that this length + 1 stuff is correct+ index2 <- fmap (`mod` (length xs + 1)) arbitrary+ len <- fmap (`mod` (length xs - (max index1 index2) + 1)) arbitrary+ return $ Ind2LenUArr (S.toU xs) index1 index2 len+ coarbitrary = undefined++data BoundedIndex a = BoundedIndex !(S.UArr a) !Int+ deriving (Show, Eq)+ +instance (Arbitrary a, S.UA a) => Arbitrary (BoundedIndex a) where+ arbitrary = do xs <- arbitrary+ index <- fmap (`mod` (length xs + 1)) arbitrary+ return $ BoundedIndex (S.toU xs) index+ coarbitrary = undefined++data CombineGen a = CombineGen !(S.UArr Bool) !(S.UArr a) !(S.UArr a) + deriving (Show, Eq)+ +instance (Arbitrary a, S.UA a) => Arbitrary (CombineGen a) where+ arbitrary = do fs <- arbitrary+ -- don't want to depend on arrow, but I'm not sure why not+ let (xl, yl) = (\(x, y) -> (length x, length y)) $ partition id fs+ -- really ugly way to generate arbitraries of specific length+ xs <- mapM (const arbitrary) [1..xl]+ ys <- mapM (const arbitrary) [1..yl]+ return $ CombineGen (S.toU fs) (S.toU xs) (S.toU ys)+ coarbitrary = undefined+ {- instance (Arbitrary a, Arbitrary s) => Arbitrary (S.Step a s) where arbitrary = do x <- arbitrary
uvector.cabal view
@@ -1,5 +1,5 @@ name: uvector-version: 0.1.0.3+version: 0.1.0.4 license: BSD3 license-file: LICENSE author: Manuel Chakravarty, Gabriele Keller, Roman Leshchinskiy, Don Stewart@@ -13,21 +13,22 @@ Streams to Nothing at All/. . For best results, compile with your user programs - with -O2 -fvia-C -optc-O2.+ with -O2 -fvia-C -optc-O3. build-type: Simple stability: experimental-cabal-version: >= 1.2-extra-source-files: include/fusion-phases.h README TODO+cabal-version: >= 1.2.3+extra-source-files: README TODO include/fusion-phases.h cbits/memcpy_extra.h flag safe description: Compile the library with read/write bound checking enabled. default: False library- build-depends: base+ build-depends: base < 6 exposed-modules: Data.Array.Vector+ Data.Array.Vector.UArr other-modules: Data.Array.Vector.Prim.BUArr@@ -36,7 +37,6 @@ Data.Array.Vector.Prim.Text Data.Array.Vector.Stream- Data.Array.Vector.UArr Data.Array.Vector.Strict.Stream Data.Array.Vector.Strict.Basics@@ -45,7 +45,8 @@ Data.Array.Vector.Strict.Permute Data.Array.Vector.Strict.Text - include-dirs: include+ include-dirs: include, cbits+ install-includes: memcpy_extra.h extensions: MagicHash,@@ -56,12 +57,13 @@ ScopedTypeVariables, TypeOperators, Rank2Types,- TypeFamilies+ TypeFamilies,+ ForeignFunctionInterface ghc-options: -fglasgow-exts -O2- -fvia-C -optc-O2+ -fvia-C -optc-O3 -fspec-constr -funbox-strict-fields -fdicts-cheap@@ -75,3 +77,7 @@ if impl(ghc >= 6.9) build-depends: ghc-prim ghc-options: -fno-spec-constr-threshold++ includes: memcpy_extra.h++ c-sources: cbits/memcpy_extra.c