storablevector 0.1.2 → 0.1.2.2
raw patch · 8 files changed
+77/−472 lines, 8 filesdep +mtldep ~basenew-component:exe:speedtest
Dependencies added: mtl
Dependency ranges changed: base
Files
- Data/StorableVector.hs +34/−41
- Data/StorableVector/Base.hs +6/−23
- slow-foreign-ptr/Data/StorableVector/Memory.hs +9/−0
- storablevector.cabal +28/−8
- tests-1/Instances.hs +0/−13
- tests-2/Instances.hs +0/−1
- tests/QuickCheckUtils.hs +0/−228
- tests/tests.hs +0/−158
Data/StorableVector.hs view
@@ -16,7 +16,7 @@ -- Stability : experimental -- Portability : portable, requires ffi and cpp -- Tested with : GHC 6.4.1 and Hugs March 2005--- +-- -- -- | A time and space-efficient implementation of vectors using@@ -181,9 +181,9 @@ import Control.Exception (assert, bracket, ) -import Foreign.ForeignPtr-import Foreign.Marshal.Array-import Foreign.Ptr+import Foreign.ForeignPtr (withForeignPtr, )+import Foreign.Marshal.Array (advancePtr, copyArray, )+import Foreign.Ptr (Ptr, minusPtr, ) import Foreign.Storable (Storable(..)) import Data.Monoid (Monoid, mempty, mappend, mconcat, )@@ -192,15 +192,8 @@ hGetBuf, hPutBuf, Handle, IOMode(..), ) -#if !defined(__GLASGOW_HASKELL__) import System.IO.Unsafe-#endif--#if defined(__GLASGOW_HASKELL__)--import GHC.IOBase--#endif+-- import GHC.IOBase -- ----------------------------------------------------------------------------- --@@ -244,7 +237,7 @@ singleton c = unsafeCreate 1 $ \p -> poke p c {-# INLINE singleton #-} --- | /O(n)/ Convert a '[a]' into a 'Vector a'. +-- | /O(n)/ Convert a '[a]' into a 'Vector a'. -- pack :: (Storable a) => [a] -> Vector a pack str = unsafeCreate (P.length str) $ \p -> go p str@@ -315,7 +308,7 @@ -- | /O(n)/ Append an element to the end of a 'Vector' snoc :: (Storable a) => Vector a -> a -> Vector a snoc (SV x s l) c = unsafeCreate (l+1) $ \p -> withForeignPtr x $ \f -> do- copyArray (castPtr p) (f `advancePtr` s) l+ copyArray p (f `advancePtr` s) l pokeElemOff p l c {-# INLINE snoc #-} @@ -378,8 +371,8 @@ -- | /O(n)/ 'reverse' @xs@ efficiently returns the elements of @xs@ in reverse order. reverse :: (Storable a) => Vector a -> Vector a-reverse (SV x s l) = unsafeCreate l $ \p -> withForeignPtr x $ \f -> - sequence_ [peekElemOff (f `plusPtr` s) i >>= pokeElemOff p (l - i - 1) +reverse (SV x s l) = unsafeCreate l $ \p -> withForeignPtr x $ \f ->+ sequence_ [peekElemOff (f `advancePtr` s) i >>= pokeElemOff p (l - i - 1) | i <- [0 .. l - 1]] -- | /O(n)/ The 'intersperse' function takes a element and a@@ -428,7 +421,7 @@ -- | 'foldl1' is a variant of 'foldl' that has no starting value -- argument, and thus must be applied to non-empty 'Vector's.--- This function is subject to array fusion. +-- This function is subject to array fusion. -- An exception will be thrown in the case of an empty 'Vector'. foldl1 :: (Storable a) => (a -> a -> a) -> Vector a -> a foldl1 f =@@ -654,11 +647,11 @@ | w <= 0 = empty | otherwise = fst $ unfoldrN w (const $ return (c, ())) () --- | /O(n)/, where /n/ is the length of the result. The 'unfoldr' --- function is analogous to the List \'unfoldr\'. 'unfoldr' builds a --- 'Vector' from a seed value. The function takes the element and --- returns 'Nothing' if it is done producing the 'Vector or returns --- 'Just' @(a,b)@, in which case, @a@ is the next element in the 'Vector', +-- | /O(n)/, where /n/ is the length of the result. The 'unfoldr'+-- function is analogous to the List \'unfoldr\'. 'unfoldr' builds a+-- 'Vector' from a seed value. The function takes the element and+-- returns 'Nothing' if it is done producing the 'Vector or returns+-- 'Just' @(a,b)@, in which case, @a@ is the next element in the 'Vector', -- and @b@ is the seed value for further production. -- -- Examples:@@ -762,7 +755,7 @@ {-# INLINE break #-} -- | 'breakEnd' behaves like 'break' but from the end of the 'Vector'--- +-- -- breakEnd p == spanEnd (not.p) breakEnd :: (Storable a) => (a -> Bool) -> Vector a -> (Vector a, Vector a) breakEnd p ps = splitAt (findFromEndUntil p ps) ps@@ -781,8 +774,8 @@ -- and -- -- > spanEnd (not . isSpace) ps--- > == --- > let (x,y) = span (not.isSpace) (reverse ps) in (reverse y, reverse x) +-- > ==+-- > let (x,y) = span (not.isSpace) (reverse ps) in (reverse y, reverse x) -- spanEnd :: (Storable a) => (a -> Bool) -> Vector a -> (Vector a, Vector a) spanEnd p ps = splitAt (findFromEndUntil (not.p) ps) ps@@ -812,12 +805,12 @@ -- > split '\n' "a\nb\nd\ne" == ["a","b","d","e"] -- > split 'a' "aXaXaXa" == ["","X","X","X"] -- > split 'x' "x" == ["",""]--- +-- -- and -- -- > join [c] . split c == id -- > split == splitWith . (==)--- +-- -- As for all splitting functions in this library, this function does -- not copy the substrings, it just constructs new 'Vector's that -- are slices of the original.@@ -828,7 +821,7 @@ -- | Like 'splitWith', except that sequences of adjacent separators are -- treated as a single separator. eg.--- +-- -- > tokens (=='a') "aabbaca" == ["bb","c"] -- tokens :: (Storable a) => (a -> Bool) -> Vector a -> [Vector a]@@ -843,7 +836,7 @@ -- > group "Mississippi" = ["M","i","ss","i","ss","i","pp","i"] -- -- It is a special case of 'groupBy', which allows the programmer to--- supply their own equality test. It is about 40% faster than +-- supply their own equality test. It is about 40% faster than -- /groupBy (==)/ group :: (Storable a, Eq a) => Vector a -> [Vector a] group xs =@@ -885,7 +878,7 @@ -- | /O(n)/ The 'elemIndex' function returns the index of the first -- element in the given 'Vector' which is equal to the query--- element, or 'Nothing' if there is no such element. +-- element, or 'Nothing' if there is no such element. -- This implementation uses memchr(3). elemIndex :: (Storable a, Eq a) => a -> Vector a -> Maybe Int elemIndex c (SV x s l) = inlinePerformIO $ withForeignPtr x $ \p -> go p (s + l) 0@@ -904,7 +897,7 @@ -- element, or 'Nothing' if there is no such element. The following -- holds: ----- > elemIndexEnd c xs == +-- > elemIndexEnd c xs == -- > (-) (length xs - 1) `fmap` elemIndex c (reverse xs) -- elemIndexEnd :: (Storable a, Eq a) => a -> Vector a -> Maybe Int@@ -934,7 +927,7 @@ ps' {-# INLINE elemIndices #-} --- | count returns the number of times its argument appears in the 'Vector' +-- | count returns the number of times its argument appears in the 'Vector' -- -- > count = length . elemIndices --@@ -944,7 +937,7 @@ {-# INLINE count #-} -- | The 'findIndex' function takes a predicate and a 'Vector' and--- returns the index of the first element in the 'Vector' +-- returns the index of the first element in the 'Vector' -- satisfying the predicate. findIndex :: (Storable a) => (a -> Bool) -> Vector a -> Maybe Int findIndex k (SV x s l) = inlinePerformIO $ withForeignPtr x $ \f -> go (f `advancePtr` s) 0@@ -1004,14 +997,14 @@ filter :: (Storable a) => (a -> Bool) -> Vector a -> Vector a filter k ps@(SV x s l) | null ps = ps- | otherwise = unsafePerformIO $ createAndTrim l $ \p -> withForeignPtr x $ \f -> + | otherwise = unsafePerformIO $ createAndTrim l $ \p -> withForeignPtr x $ \f -> let STRICT3(go) go end i j | i == end = return j | otherwise = do w <- peekElemOff f i if k w then do- pokeElemOff p j w + pokeElemOff p j w go end (i+1) (j + 1) else go end (i+1) j@@ -1039,7 +1032,7 @@ -- | /O(n)/ The 'isSuffixOf' function takes two 'Vector's and returns 'True' -- iff the first is a suffix of the second.--- +-- -- The following holds: -- -- > isSuffixOf x y == reverse x `isPrefixOf` reverse y@@ -1065,9 +1058,9 @@ -- | 'zipWith' generalises 'zip' by zipping with the function given as -- the first argument, instead of a tupling function. For example, -- @'zipWith' (+)@ is applied to two 'Vector's to produce the list of--- corresponding sums. -zipWith :: (Storable a, Storable b, Storable c) - => (a -> b -> c) -> Vector a -> Vector b -> Vector c+-- corresponding sums.+zipWith :: (Storable a, Storable b, Storable c) =>+ (a -> b -> c) -> Vector a -> Vector b -> Vector c zipWith f ps0 qs0 = fst $ unfoldrN (min (length ps0) (length qs0))@@ -1104,10 +1097,10 @@ -- --------------------------------------------------------------------- -- Low level constructors --- | /O(n)/ Make a copy of the 'Vector' with its own storage. +-- | /O(n)/ Make a copy of the 'Vector' with its own storage. -- This is mainly useful to allow the rest of the data pointed -- to by the 'Vector' to be garbage collected, for example--- if a large string has been read in, and only a small part of it +-- if a large string has been read in, and only a small part of it -- is needed in the rest of the program. copy :: (Storable a) => Vector a -> Vector a copy (SV x s l) = unsafeCreate l $ \p -> withForeignPtr x $ \f ->
Data/StorableVector/Base.hs view
@@ -43,26 +43,20 @@ ) where import Foreign.Ptr (Ptr)-import Foreign.ForeignPtr+import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, ) import Foreign.Marshal.Array (advancePtr, copyArray)-import Foreign.Storable (Storable(..))+import Foreign.Storable (Storable(peekElemOff)) +import Data.StorableVector.Memory (mallocForeignPtrArray, )+ import Control.Exception (assert) #if defined(__GLASGOW_HASKELL__)-import qualified Foreign.Concurrent as FC (newForeignPtr)- import Data.Generics (Data(..), Typeable(..))-import GHC.Ptr (Ptr(..)) import GHC.Base (realWorld#)-import GHC.IOBase--#if defined(__GLASGOW_HASKELL__) && !defined(SLOW_FOREIGN_PTR)-import GHC.ForeignPtr (mallocPlainForeignPtrBytes)-#endif+import GHC.IOBase (IO(IO), unsafePerformIO, ) #else-import Data.Char (chr) import System.IO.Unsafe (unsafePerformIO) #endif @@ -158,6 +152,7 @@ fromForeignPtr fp l = SV fp 0 l -- | /O(1)/ Deconstruct a ForeignPtr from a Vector+toForeignPtr :: Vector a -> (ForeignPtr a, Int, Int) toForeignPtr (SV ps s l) = (ps, s, l) -- | A way of creating Vectors outside the IO monad. The @Int@@@ -171,11 +166,7 @@ -- | Wrapper of mallocForeignPtrArray. create :: (Storable a) => Int -> (Ptr a -> IO ()) -> IO (Vector a) create l f = do-#if defined(SLOW_FOREIGN_PTR) || !defined(__GLASGOW_HASKELL__) fp <- mallocForeignPtrArray l-#else- fp <- mallocPlainForeignPtrArray l-#endif withForeignPtr fp $ \p -> f p return $! SV fp 0 l @@ -189,11 +180,7 @@ -- createAndTrim :: (Storable a) => Int -> (Ptr a -> IO Int) -> IO (Vector a) createAndTrim l f = do-#if defined(SLOW_FOREIGN_PTR) || !defined(__GLASGOW_HASKELL__) fp <- mallocForeignPtrArray l-#else- fp <- mallocPlainForeignPtrArray l-#endif withForeignPtr fp $ \p -> do l' <- f p if assert (l' <= l) $ l' >= l@@ -204,11 +191,7 @@ -> (Ptr a -> IO (Int, Int, b)) -> IO (Vector a, b) createAndTrim' l f = do-#if defined(SLOW_FOREIGN_PTR) || !defined(__GLASGOW_HASKELL__) fp <- mallocForeignPtrArray l-#else- fp <- mallocPlainForeignPtrArray l-#endif withForeignPtr fp $ \p -> do (off, l', res) <- f p if assert (l' <= l) $ l' >= l
+ slow-foreign-ptr/Data/StorableVector/Memory.hs view
@@ -0,0 +1,9 @@+module Data.StorableVector.Memory where++import Foreign.Storable (Storable)+import qualified Foreign.ForeignPtr as F+++{-# INLINE mallocForeignPtrArray #-}+mallocForeignPtrArray :: Storable a => Int -> IO (F.ForeignPtr a)+mallocForeignPtrArray = F.mallocForeignPtrArray
storablevector.cabal view
@@ -1,5 +1,5 @@ Name: storablevector-Version: 0.1.2+Version: 0.1.2.2 Category: Data Synopsis: Fast, packed, strict storable arrays with a list interface like ByteString Description:@@ -11,16 +11,19 @@ Maintainer: Henning Thielemann <storablevector@henning-thielemann.de> Homepage: http://darcs.haskell.org/storablevector Package-URL: http://code.haskell.org/~sjanssen/storablevector-Build-Depends: base Build-Type: Simple Tested-With: GHC==6.4.1, GHC==6.8.2 Cabal-Version: >=1.2 - Flag splitBase description: Choose the new smaller, split-up base package. +Flag buildTests+ description: Build test executables+ default: False+ Library+ Build-Depends: mtl >= 1 && <2 If flag(splitBase) Build-Depends: base >= 3 Else@@ -28,23 +31,40 @@ Extensions: CPP, ForeignFunctionInterface GHC-Options: -Wall -funbox-strict-fields- CPP-Options: -DSLOW_FOREIGN_PTR+ Hs-Source-Dirs: ., slow-foreign-ptr - Exposed-modules:+ Exposed-Modules: Data.StorableVector Data.StorableVector.Base + Other-Modules:+ Data.StorableVector.Memory + Executable test GHC-Options: -Wall -funbox-strict-fields- CPP-Options: -DSLOW_FOREIGN_PTR+ Hs-Source-Dirs: ., slow-foreign-ptr, tests Main-Is: tests.hs Other-Modules: QuickCheckUtils, Instances Build-Depends: bytestring >= 0.9 && < 0.10, QuickCheck >= 1 && < 2 Extensions: CPP, ForeignFunctionInterface If flag(splitBase)- Hs-Source-Dirs: ., tests, tests-2+ Hs-Source-Dirs: tests-2 Build-Depends: base >= 3, random >= 1.0 && < 1.1 Else- Hs-Source-Dirs: ., tests, tests-1+ Hs-Source-Dirs: tests-1 Build-Depends: base >= 1.0 && < 2+ if !flag(buildTests)+ buildable: False++Executable speedtest+ GHC-Options: -Wall -funbox-strict-fields+ Main-Is: SpeedTestLazy.hs+ Extensions: CPP, ForeignFunctionInterface+ Hs-Source-Dirs: ., slow-foreign-ptr, speedtest+ If flag(splitBase)+ Build-Depends: base >= 3+ Else+ Build-Depends: base >= 1.0 && < 2+ if !flag(buildTests)+ buildable: False
− tests-1/Instances.hs
@@ -1,13 +0,0 @@-module Instances where---instance Functor ((->) r) where- fmap = (.)--instance Monad ((->) r) where- return = const- f >>= k = \ r -> k (f r) r--instance Functor ((,) a) where- fmap f (x,y) = (x, f y)-
− tests-2/Instances.hs
@@ -1,1 +0,0 @@-module Instances where
− tests/QuickCheckUtils.hs
@@ -1,228 +0,0 @@-{-# OPTIONS_GHC -O -fglasgow-exts #-}------ Uses multi-param type classes----module QuickCheckUtils where--import Instances ()--import Test.QuickCheck--- import Test.QuickCheck (Arbitrary(arbitrary, coarbitrary), variant, choose, sized, (==>), Property, )-import Text.Show.Functions ()-import System.Random (RandomGen, StdGen, Random, newStdGen, split, randomR, random, )--import Control.Monad (liftM2)-import Data.Char (ord)-import Data.Word (Word8)-import Data.Int (Int64)-import System.IO (hFlush, stdout, )--import qualified Data.ByteString as P-import qualified Data.StorableVector as V-import qualified Data.List as List--import qualified Data.ByteString.Char8 as PC---- Enable this to get verbose test output. Including the actual tests.-debug = False--mytest :: Testable a => a -> Int -> IO ()-mytest a n = mycheck defaultConfig- { configMaxTest=n- , configEvery= \n args -> if debug then show n ++ ":\n" ++ unlines args else [] } a--mycheck :: Testable a => Config -> a -> IO ()-mycheck config a =- do rnd <- newStdGen- mytests config (evaluate a) rnd 0 0 []--mytests :: Config -> Gen Result -> StdGen -> Int -> Int -> [[String]] -> IO ()-mytests config gen rnd0 ntest nfail stamps- | ntest == configMaxTest config = do done "OK," ntest stamps- | nfail == configMaxFail config = do done "Arguments exhausted after" ntest stamps- | otherwise =- do putStr (configEvery config ntest (arguments result)) >> hFlush stdout- case ok result of- Nothing ->- mytests config gen rnd1 ntest (nfail+1) stamps- Just True ->- mytests config gen rnd1 (ntest+1) nfail (stamp result:stamps)- Just False ->- putStr ( "Falsifiable after "- ++ show ntest- ++ " tests:\n"- ++ unlines (arguments result)- ) >> hFlush stdout- where- result = generate (configSize config ntest) rnd2 gen- (rnd1,rnd2) = split rnd0--done :: String -> Int -> [[String]] -> IO ()-done mesg ntest stamps =- do putStr ( mesg ++ " " ++ show ntest ++ " tests" ++ table )- where- table = display- . map entry- . reverse- . List.sort- . map pairLength- . List.group- . List.sort- . filter (not . null)- $ stamps-- display [] = ".\n"- display [x] = " (" ++ x ++ ").\n"- display xs = ".\n" ++ unlines (map (++ ".") xs)-- pairLength xss@(xs:_) = (length xss, xs)- entry (n, xs) = percentage n ntest- ++ " "- ++ concat (List.intersperse ", " xs)-- percentage n m = show ((100 * n) `div` m) ++ "%"----------------------------------------------------------------------------instance Arbitrary Char where- arbitrary = choose ('a', 'i')- coarbitrary c = variant (ord c `rem` 4)--instance Arbitrary Word8 where- arbitrary = choose (97, 105)- coarbitrary c = variant (fromIntegral ((fromIntegral c) `rem` 4))--instance Arbitrary Int64 where- arbitrary = sized $ \n -> choose (-fromIntegral n,fromIntegral n)- coarbitrary n = variant (fromIntegral (if n >= 0 then 2*n else 2*(-n) + 1))--{--instance Arbitrary Char where- arbitrary = choose ('\0', '\255') -- since we have to test words, unlines too- coarbitrary c = variant (ord c `rem` 16)--instance Arbitrary Word8 where- arbitrary = choose (minBound, maxBound)- coarbitrary c = variant (fromIntegral ((fromIntegral c) `rem` 16))--}--instance Random Word8 where- randomR = integralRandomR- random = randomR (minBound,maxBound)--instance Random Int64 where- randomR = integralRandomR- random = randomR (minBound,maxBound)--integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)-integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,- fromIntegral b :: Integer) g of- (x,g) -> (fromIntegral x, g)--instance Arbitrary V where- arbitrary = V.pack `fmap` arbitrary- coarbitrary s = coarbitrary (V.unpack s)--instance Arbitrary P.ByteString where- arbitrary = P.pack `fmap` arbitrary- coarbitrary s = coarbitrary (P.unpack s)--------------------------------------------------------------------------------- We're doing two forms of testing here. Firstly, model based testing.--- For our Lazy and strict bytestring types, we have model types:------ i.e. Lazy == Byte--- \\ //--- List ------ That is, the Lazy type can be modeled by functions in both the Byte--- and List type. For each of the 3 models, we have a set of tests that--- check those types match.------ The Model class connects a type and its model type, via a conversion--- function. -------class Model a b where- model :: a -> b -- get the abstract value from a concrete value------- Connecting our Lazy and Strict types to their models. We also check--- the data invariant on Lazy types.------ These instances represent the arrows in the above diagram----instance Model P [W] where model = P.unpack-instance Model P [Char] where model = PC.unpack-instance Model V [W] where model = V.unpack-instance Model V P where model = P.pack . V.unpack---- Types are trivially modeled by themselves-instance Model Bool Bool where model = id-instance Model Int Int where model = id-instance Model Int64 Int64 where model = id-instance Model Int64 Int where model = fromIntegral-instance Model Word8 Word8 where model = id-instance Model Ordering Ordering where model = id-instance Model Char Char where model = id---- More structured types are modeled recursively, using the NatTrans class from Gofer.-class (Functor f, Functor g) => NatTrans f g where- eta :: f a -> g a---- The transformation of the same type is identity-instance NatTrans [] [] where eta = id-instance NatTrans Maybe Maybe where eta = id-instance NatTrans ((->) X) ((->) X) where eta = id-instance NatTrans ((->) W) ((->) W) where eta = id-instance NatTrans ((->) Char) ((->) Char) where eta = id---- We have a transformation of pairs, if the pairs are in Model-instance Model f g => NatTrans ((,) f) ((,) g) where eta (f,a) = (model f, a)---- And finally, we can take any (m a) to (n b), if we can Model m n, and a b-instance (NatTrans m n, Model a b) => Model (m a) (n b) where model x = fmap model (eta x)------------------------------------------------------------------------------ Some short hand.-type X = Int-type W = Word8-type P = P.ByteString-type V = V.Vector Word8-------------------------------------------------------------------------------- These comparison functions handle wrapping and equality.------ A single class for these would be nice, but note that they differe in--- the number of arguments, and those argument types, so we'd need HList--- tricks. See here: http://okmij.org/ftp/Haskell/vararg-fn.lhs-----eq1 f g = \a ->- model (f a) == g (model a)-eq2 f g = \a b ->- model (f a b) == g (model a) (model b)-eq3 f g = \a b c ->- model (f a b c) == g (model a) (model b) (model c)-eq4 f g = \a b c d ->- model (f a b c d) == g (model a) (model b) (model c) (model d)-eq5 f g = \a b c d e ->- model (f a b c d e) == g (model a) (model b) (model c) (model d) (model e)------- And for functions that take non-null input----eqnotnull1 f g = \x -> (not (isNull x)) ==> eq1 f g x-eqnotnull2 f g = \x y -> (not (isNull y)) ==> eq2 f g x y-eqnotnull3 f g = \x y z -> (not (isNull z)) ==> eq3 f g x y z--class IsNull t where isNull :: t -> Bool-instance IsNull P.ByteString where isNull = P.null-instance IsNull V where isNull = V.null--instance Show V where- show = show . V.unpack
− tests/tests.hs
@@ -1,158 +0,0 @@-{-# OPTIONS_GHC -O #-}-import qualified Data.StorableVector as V-import qualified Data.ByteString as P-import QuickCheckUtils- (V, W, X, P, mytest,- eq1, eq2, eq3, eqnotnull1, eqnotnull2, eqnotnull3, )-import Text.Printf (printf)-import System.Environment (getArgs)------- Data.StorableVector <=> ByteString-----prop_concatVP = (V.concat :: [V] -> V) `eq1` P.concat-prop_nullVP = (V.null :: V -> Bool) `eq1` P.null-prop_reverseVP = (V.reverse :: V -> V) `eq1` P.reverse-prop_transposeVP = (V.transpose :: [V] -> [V]) `eq1` P.transpose-prop_groupVP = (V.group :: V -> [V]) `eq1` P.group-prop_initsVP = (V.inits :: V -> [V]) `eq1` P.inits-prop_tailsVP = (V.tails :: V -> [V]) `eq1` P.tails-prop_allVP = (V.all :: (W -> Bool) -> V -> Bool) `eq2` P.all-prop_anyVP = (V.any :: (W -> Bool) -> V -> Bool) `eq2` P.any-prop_appendVP = (V.append :: V -> V -> V) `eq2` P.append-prop_breakVP = (V.break :: (W -> Bool) -> V -> (V, V)) `eq2` P.break-prop_concatMapVP = (V.concatMap :: (W -> V) -> V -> V) `eq2` P.concatMap-prop_consVP = (V.cons :: W -> V -> V) `eq2` P.cons-prop_countVP = (V.count :: W -> V -> X) `eq2` P.count-prop_dropVP = (V.drop :: X -> V -> V) `eq2` P.drop-prop_dropWhileVP = (V.dropWhile :: (W -> Bool) -> V -> V) `eq2` P.dropWhile-prop_filterVP = (V.filter :: (W -> Bool) -> V -> V) `eq2` P.filter-prop_findVP = (V.find :: (W -> Bool) -> V -> Maybe W) `eq2` P.find-prop_findIndexVP = (V.findIndex :: (W -> Bool) -> V -> Maybe X) `eq2` P.findIndex-prop_findIndicesVP = (V.findIndices :: (W -> Bool) -> V -> [X]) `eq2` P.findIndices-prop_isPrefixOfVP = (V.isPrefixOf :: V -> V -> Bool) `eq2` P.isPrefixOf-prop_mapVP = (V.map :: (W -> W) -> V -> V) `eq2` P.map-prop_replicateVP = (V.replicate :: X -> W -> V) `eq2` P.replicate-prop_snocVP = (V.snoc :: V -> W -> V) `eq2` P.snoc-prop_spanVP = (V.span :: (W -> Bool) -> V -> (V, V)) `eq2` P.span-prop_splitVP = (V.split :: W -> V -> [V]) `eq2` P.split-prop_splitAtVP = (V.splitAt :: X -> V -> (V, V)) `eq2` P.splitAt-prop_takeVP = (V.take :: X -> V -> V) `eq2` P.take-prop_takeWhileVP = (V.takeWhile :: (W -> Bool) -> V -> V) `eq2` P.takeWhile-prop_elemVP = (V.elem :: W -> V -> Bool) `eq2` P.elem-prop_notElemVP = (V.notElem :: W -> V -> Bool) `eq2` P.notElem-prop_elemIndexVP = (V.elemIndex :: W -> V -> Maybe X) `eq2` P.elemIndex-prop_elemIndicesVP = (V.elemIndices :: W -> V -> [X])`eq2` P.elemIndices-prop_lengthVP = (V.length :: V -> X) `eq1` P.length--prop_headVP = (V.head :: V -> W) `eqnotnull1` P.head-prop_initVP = (V.init :: V -> V) `eqnotnull1` P.init-prop_lastVP = (V.last :: V -> W) `eqnotnull1` P.last-prop_maximumVP = (V.maximum :: V -> W) `eqnotnull1` P.maximum-prop_minimumVP = (V.minimum :: V -> W) `eqnotnull1` P.minimum-prop_tailVP = (V.tail :: V -> V) `eqnotnull1` P.tail-prop_foldl1VP = (V.foldl1 :: (W -> W -> W) -> V -> W) `eqnotnull2` P.foldl1-prop_foldl1VP' = (V.foldl1' :: (W -> W -> W) -> V -> W) `eqnotnull2` P.foldl1'-prop_foldr1VP = (V.foldr1 :: (W -> W -> W) -> V -> W) `eqnotnull2` P.foldr1-prop_scanlVP = (V.scanl :: (W -> W -> W) -> W -> V -> V) `eqnotnull3` P.scanl-prop_scanrVP = (V.scanr :: (W -> W -> W) -> W -> V -> V) `eqnotnull3` P.scanr--prop_eqVP = eq2- ((==) :: V -> V -> Bool)- ((==) :: P -> P -> Bool)-prop_foldlVP = eq3- (V.foldl :: (X -> W -> X) -> X -> V -> X)- (P.foldl :: (X -> W -> X) -> X -> P -> X)-prop_foldlVP' = eq3- (V.foldl' :: (X -> W -> X) -> X -> V -> X)- (P.foldl' :: (X -> W -> X) -> X -> P -> X)-prop_foldrVP = eq3- (V.foldr :: (W -> X -> X) -> X -> V -> X)- (P.foldr :: (W -> X -> X) -> X -> P -> X)-prop_mapAccumLVP = eq3- (V.mapAccumL :: (X -> W -> (X,W)) -> X -> V -> (X, V))- (P.mapAccumL :: (X -> W -> (X,W)) -> X -> P -> (X, P))-prop_mapAccumRVP = eq3- (V.mapAccumR :: (X -> W -> (X,W)) -> X -> V -> (X, V))- (P.mapAccumR :: (X -> W -> (X,W)) -> X -> P -> (X, P))-prop_zipWithVP = eq3- (V.zipWith :: (W -> W -> W) -> V -> V -> V)--- (P.zipWith :: (W -> W -> W) -> P -> P -> P)- (\f x y -> P.pack (P.zipWith f x y) :: P)--prop_unfoldrVP = eq3- ((\n f a -> V.take (fromIntegral n) $- V.unfoldr f a) :: Int -> (X -> Maybe (W,X)) -> X -> V)- ((\n f a -> fst $- P.unfoldrN n f a) :: Int -> (X -> Maybe (W,X)) -> X -> P)----------------------------------------------------------------------------- StorableVector <=> ByteString--vp_tests =- [("all", mytest prop_allVP)- ,("any", mytest prop_anyVP)- ,("append", mytest prop_appendVP)- ,("concat", mytest prop_concatVP)- ,("cons", mytest prop_consVP)- ,("eq", mytest prop_eqVP)- ,("filter", mytest prop_filterVP)- ,("find", mytest prop_findVP)- ,("findIndex", mytest prop_findIndexVP)- ,("findIndices", mytest prop_findIndicesVP)- ,("foldl", mytest prop_foldlVP)- ,("foldl'", mytest prop_foldlVP')- ,("foldl1", mytest prop_foldl1VP)- ,("foldl1'", mytest prop_foldl1VP')- ,("foldr", mytest prop_foldrVP)- ,("foldr1", mytest prop_foldr1VP)- ,("mapAccumL", mytest prop_mapAccumLVP)- ,("mapAccumR", mytest prop_mapAccumRVP)- ,("zipWith", mytest prop_zipWithVP)- -- ,("unfoldr", mytest prop_unfoldrVP)- ,("head", mytest prop_headVP)- ,("init", mytest prop_initVP)- ,("isPrefixOf", mytest prop_isPrefixOfVP)- ,("last", mytest prop_lastVP)- ,("length", mytest prop_lengthVP)- ,("map", mytest prop_mapVP)- ,("maximum ", mytest prop_maximumVP)- ,("minimum" , mytest prop_minimumVP)- ,("null", mytest prop_nullVP)- ,("reverse", mytest prop_reverseVP)- ,("snoc", mytest prop_snocVP)- ,("tail", mytest prop_tailVP)- ,("scanl", mytest prop_scanlVP)- ,("scanr", mytest prop_scanrVP)- ,("transpose", mytest prop_transposeVP)- ,("replicate", mytest prop_replicateVP)- ,("take", mytest prop_takeVP)- ,("drop", mytest prop_dropVP)- ,("splitAt", mytest prop_splitAtVP)- ,("takeWhile", mytest prop_takeWhileVP)- ,("dropWhile", mytest prop_dropWhileVP)- ,("break", mytest prop_breakVP)- ,("span", mytest prop_spanVP)- ,("split", mytest prop_splitVP)- ,("count", mytest prop_countVP)- ,("group", mytest prop_groupVP)- ,("inits", mytest prop_initsVP)- ,("tails", mytest prop_tailsVP)- ,("elem", mytest prop_elemVP)- ,("notElem", mytest prop_notElemVP)- ,("elemIndex", mytest prop_elemIndexVP)- ,("elemIndices", mytest prop_elemIndicesVP)- ,("concatMap", mytest prop_concatMapVP)- ]----------------------------------------------------------------------------- The entry point--main = run vp_tests--run :: [(String, Int -> IO ())] -> IO ()-run tests = do- x <- getArgs- let n = if null x then 100 else read . head $ x- mapM_ (\(s,a) -> printf "%-25s: " s >> a n) tests