5240fe5 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

add array test cases

5240fe5Harendra Kumar7 years ago

Changelog.md+1−1

compare with master

unifiedsplit

@@ -14,7 +14,7 @@

14* Add the following to "Streamly.Prelude":

15 * `foldrS` to fold a stream to a stream

16 * `foldrT` to fold a stream to an arbitrary transformer monad

17− * `toRevList` to fold a stream to a reverse list

17+ * `reverse'` a several times faster reverse using Storable instance

19### Deprecations

src/Streamly/Array/Types.hs+19−17

@@ -388,63 +388,65 @@ fromStreamDArraysOf n str = D.groupsOf n (toArrayN n) str

388

389-- XXX concatMap does not seem to have the best possible performance so we have

390-- a custom way to concat arrays.

391+data FlattenState s a =

392+ OuterLoop s

391−data CAState s a = CAParent s | CANested s (ForeignPtr a) (Ptr a) (Ptr a)

393+ | InnerLoop s (ForeignPtr a) (Ptr a) (Ptr a)

392

394

393{-# INLINE_NORMAL flattenArrays #-}

395{-# INLINE_NORMAL flattenArrays #-}

394flattenArrays :: forall m a. (Monad m, Storable a)

396flattenArrays :: forall m a. (Monad m, Storable a)

395 => D.Stream m (Array a) -> D.Stream m a

397 => D.Stream m (Array a) -> D.Stream m a

396−flattenArrays (D.Stream step state) = D.Stream step' (CAParent state)

398+flattenArrays (D.Stream step state) = D.Stream step' (OuterLoop state)

397

399

398 where

400 where

399

401

400 {-# INLINE_LATE step' #-}

402 {-# INLINE_LATE step' #-}

401− step' gst (CAParent st) = do

403+ step' gst (OuterLoop st) = do

402 r <- step (adaptState gst) st

404 r <- step (adaptState gst) st

403 return $ case r of

405 return $ case r of

404 D.Yield Array{..} s ->

406 D.Yield Array{..} s ->

405 let p = unsafeForeignPtrToPtr aStart

407 let p = unsafeForeignPtrToPtr aStart

406− in D.Skip (CANested s aStart p aEnd)

408+ in D.Skip (InnerLoop s aStart p aEnd)

407− D.Skip s -> D.Skip (CAParent s)

409+ D.Skip s -> D.Skip (OuterLoop s)

408 D.Stop -> D.Stop

410 D.Stop -> D.Stop

409

411

410− step' _ (CANested st _ p end) | p == end =

412+ step' _ (InnerLoop st _ p end) | p == end =

411− return $ D.Skip $ CAParent st

413+ return $ D.Skip $ OuterLoop st

412

414

413− step' _ (CANested st startf p end) = do

415+ step' _ (InnerLoop st startf p end) = do

414 let !x = unsafeInlineIO $ do

416 let !x = unsafeInlineIO $ do

415 r <- peek p

417 r <- peek p

416 touchForeignPtr startf

418 touchForeignPtr startf

417 return r

419 return r

418− return $ D.Yield x (CANested st startf

420+ return $ D.Yield x (InnerLoop st startf

419 (p `plusPtr` (sizeOf (undefined :: a))) end)

421 (p `plusPtr` (sizeOf (undefined :: a))) end)

420

422

421{-# INLINE_NORMAL flattenArraysRev #-}

423{-# INLINE_NORMAL flattenArraysRev #-}

422flattenArraysRev :: forall m a. (Monad m, Storable a)

424flattenArraysRev :: forall m a. (Monad m, Storable a)

423 => D.Stream m (Array a) -> D.Stream m a

425 => D.Stream m (Array a) -> D.Stream m a

424−flattenArraysRev (D.Stream step state) = D.Stream step' (CAParent state)

426+flattenArraysRev (D.Stream step state) = D.Stream step' (OuterLoop state)

425

427

426 where

428 where

427

429

428 {-# INLINE_LATE step' #-}

430 {-# INLINE_LATE step' #-}

429− step' gst (CAParent st) = do

431+ step' gst (OuterLoop st) = do

430 r <- step (adaptState gst) st

432 r <- step (adaptState gst) st

431 return $ case r of

433 return $ case r of

432 D.Yield Array{..} s ->

434 D.Yield Array{..} s ->

433 let p = aEnd `plusPtr` negate (sizeOf (undefined :: a))

435 let p = aEnd `plusPtr` negate (sizeOf (undefined :: a))

434 -- XXX we do not need aEnd

436 -- XXX we do not need aEnd

435− in D.Skip (CANested s aStart p aEnd)

437+ in D.Skip (InnerLoop s aStart p aEnd)

436− D.Skip s -> D.Skip (CAParent s)

438+ D.Skip s -> D.Skip (OuterLoop s)

437 D.Stop -> D.Stop

439 D.Stop -> D.Stop

438

440

439− step' _ (CANested st start p _) | p < unsafeForeignPtrToPtr start =

441+ step' _ (InnerLoop st start p _) | p < unsafeForeignPtrToPtr start =

440− return $ D.Skip $ CAParent st

442+ return $ D.Skip $ OuterLoop st

441

443

442− step' _ (CANested st startf p end) = do

444+ step' _ (InnerLoop st startf p end) = do

443 let !x = unsafeInlineIO $ do

445 let !x = unsafeInlineIO $ do

444 r <- peek p

446 r <- peek p

445 touchForeignPtr startf

447 touchForeignPtr startf

446 return r

448 return r

447− return $ D.Yield x (CANested st startf

449+ return $ D.Yield x (InnerLoop st startf

448 (p `plusPtr` negate (sizeOf (undefined :: a))) end)

450 (p `plusPtr` negate (sizeOf (undefined :: a))) end)

449

451

450-- CAUTION: a very large number (millions) of arrays can degrade performance

452-- CAUTION: a very large number (millions) of arrays can degrade performance

streamly.cabal+1−1

@@ -346,7 +346,7 @@ test-suite properties

346 transformers >= 0.4 && < 0.6

347 default-language: Haskell2010

348

349−test-suite arrays

349+test-suite array-test

350 type: exitcode-stdio-1.0

351 main-is: Arrays.hs

352 js-sources: jsbits/clock.js

test/Arrays.hs+71−16

@@ -4,10 +4,11 @@

4module Main (main) where

6import Data.Functor.Identity (runIdentity)

7−import GHC.Word (Word8)

7+import Foreign.Storable (Storable(..))

9import Test.Hspec.QuickCheck

10−import Test.QuickCheck (Property, forAll, Gen, vectorOf, arbitrary, (===))

10+import Test.QuickCheck (Property, forAll, Gen, vectorOf, arbitrary, (===),

11+ choose)

12import Test.Hspec as H

13import Test.Hspec as H

@@ -22,19 +23,70 @@ maxTestCount = 100

22maxTestCount = 10

23maxTestCount = 10

23#endif

24#endif

25−randomLengthArray :: Word8 -> Property

26+allocOverhead :: Int

26−randomLengthArray len =

27+allocOverhead = 2 * sizeOf (undefined :: Int)

27− forAll (vectorOf (fromIntegral len) (arbitrary :: Gen Int)) $ \list ->

28− let arr = runIdentity $ A.fromStreamN (fromIntegral len)

29− $ S.fromList list

30− in A.length arr === fromIntegral len

32−randomArrayRoundTrip :: Word8 -> Property

29+-- XXX this should be in sync with the defaultChunkSize in Array code, or we

33−randomArrayRoundTrip len =

30+-- should expose that and use that. For fast testing we could reduce the

31+-- defaultChunkSize under CPP conditionals.

32+--

33+defaultChunkSize :: Int

34+defaultChunkSize = 32 * k - allocOverhead

35+ where k = 1024

36+

37+maxArrLen :: Int

38+maxArrLen = defaultChunkSize * 8

39+

40+testLength :: Property

41+testLength =

42+ forAll (choose (0, maxArrLen)) $ \len ->

34− forAll (vectorOf (fromIntegral len) (arbitrary :: Gen Int)) $ \list ->

43+ forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->

35− let arr = runIdentity $ A.fromStreamN (fromIntegral len)

44+ let arr = runIdentity $ A.fromStreamN len

45+ $ S.fromList list

46+ in A.length arr === len

47+

48+testFromToStreamN :: Property

49+testFromToStreamN =

50+ forAll (choose (0, maxArrLen)) $ \len ->

51+ forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->

52+ let arr = runIdentity $ A.fromStreamN len

36− $ S.fromList list

53+ $ S.fromList list

37− in runIdentity (S.toList (A.toStream arr)) === list

54+ in runIdentity (S.toList (A.toStream arr)) === list

55+

56+testArraysOf :: Property

57+testArraysOf =

58+ forAll (choose (0, maxArrLen)) $ \len ->

59+ forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->

60+ let xs = runIdentity

61+ $ S.toList

62+ $ S.concatMap A.toStream

63+ $ A.arraysOf 240

64+ $ S.fromList list

65+ in xs === list

66+

67+testFlattenArrays :: Property

68+testFlattenArrays =

69+ forAll (choose (0, maxArrLen)) $ \len ->

70+ forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->

71+ let xs = runIdentity

72+ $ S.toList

73+ $ A.flattenArrays

74+ $ A.arraysOf 240

75+ $ S.fromList list

76+ in xs === list

77+

78+{-

79+testFromToStream :: Property

80+testFromToStream =

81+ forAll (choose (0, maxArrLen)) $ \len ->

82+ forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->

83+ let xs = runIdentity

84+ $ S.toList

85+ $ A.toStream

86+ $ runIdentity. A.fromStream

87+ $ S.fromList list

88+ in xs === list

89+-}

39main :: IO ()

91main :: IO ()

40main = hspec

92main = hspec

@@ -42,5 +94,8 @@ main = hspec

42 $ modifyMaxSuccess (const maxTestCount)

94 $ modifyMaxSuccess (const maxTestCount)

43 $ do

95 $ do

44 describe "Construction" $ do

96 describe "Construction" $ do

45− prop "length . fromStreamN n === n" $ randomLengthArray

97+ prop "length . fromStreamN n === n" $ testLength

46− prop "fromStreamN n . toStream === id" $ randomArrayRoundTrip

98+ prop "toStream . fromStreamN n === id" $ testFromToStreamN

99+ prop "arraysOf concats to original" $ testArraysOf

100+ prop "flattenArrays concats to original" $ testFlattenArrays

101+ -- prop "toStream . fromStream === id" $ testFromToStream

test/Prop.hs+8−5

@@ -467,6 +467,9 @@ transformCombineOpsCommon constr desc eq t = do

467 transform (concatMap (const [1..n]))

468 t (S.concatMap (const (S.fromList [1..n])))

469

470+toListFL :: Monad m => FL.Fold m a [a]

471+toListFL = fmap reverse FL.toListRev

472+

470groupSplitOps :: String -> Spec

473groupSplitOps :: String -> Spec

471groupSplitOps desc = do

474groupSplitOps desc = do

472 -- splitting

475 -- splitting

@@ -476,14 +479,14 @@ groupSplitOps desc = do

476 forAll listWithZeroes $ \xs -> do

479 forAll listWithZeroes $ \xs -> do

477 withMaxSuccess maxTestCount $

480 withMaxSuccess maxTestCount $

478 monadicIO $ do

481 monadicIO $ do

479− ys <- S.toList $ FL.splitOn [] FL.toList (S.fromList xs)

482+ ys <- S.toList $ FL.splitOn [] toListFL (S.fromList xs)

480 listEquals (==) (intercalate [] ys) xs

483 listEquals (==) (intercalate [] ys) xs

481

484

482 prop (desc <> " intercalate . splitOn == id (single element separator)") $

485 prop (desc <> " intercalate . splitOn == id (single element separator)") $

483 forAll listWithZeroes $ \xs -> do

486 forAll listWithZeroes $ \xs -> do

484 withMaxSuccess maxTestCount $

487 withMaxSuccess maxTestCount $

485 monadicIO $ do

488 monadicIO $ do

486− ys <- S.toList $ FL.splitOn [0] FL.toList (S.fromList xs)

489+ ys <- S.toList $ FL.splitOn [0] toListFL (S.fromList xs)

487 listEquals (==) (intercalate [0] ys) xs

490 listEquals (==) (intercalate [0] ys) xs

488

491

489 prop (desc <> " concat . splitOn . intercalate == concat (nil separator/possibly empty list)") $

492 prop (desc <> " concat . splitOn . intercalate == concat (nil separator/possibly empty list)") $

@@ -491,7 +494,7 @@ groupSplitOps desc = do

491 withMaxSuccess maxTestCount $

494 withMaxSuccess maxTestCount $

492 monadicIO $ do

495 monadicIO $ do

493 let xs = intercalate [] xss

496 let xs = intercalate [] xss

494− ys <- S.toList $ FL.splitOn [0] FL.toList (S.fromList xs)

497+ ys <- S.toList $ FL.splitOn [0] toListFL (S.fromList xs)

495 listEquals (==) (concat ys) (concat xss)

498 listEquals (==) (concat ys) (concat xss)

496

499

497 prop (desc <> " concat . splitOn . intercalate == concat (non-nil separator/possibly empty list)") $

500 prop (desc <> " concat . splitOn . intercalate == concat (non-nil separator/possibly empty list)") $

@@ -499,7 +502,7 @@ groupSplitOps desc = do

499 withMaxSuccess maxTestCount $

502 withMaxSuccess maxTestCount $

500 monadicIO $ do

503 monadicIO $ do

501 let xs = intercalate [0] xss

504 let xs = intercalate [0] xss

502− ys <- S.toList $ FL.splitOn [0] FL.toList (S.fromList xs)

505+ ys <- S.toList $ FL.splitOn [0] toListFL (S.fromList xs)

503 listEquals (==) (concat ys) (concat xss)

506 listEquals (==) (concat ys) (concat xss)

504

507

505 prop (desc <> " splitOn . intercalate == id (exclusive separator/non-empty list)") $

508 prop (desc <> " splitOn . intercalate == id (exclusive separator/non-empty list)") $

@@ -507,7 +510,7 @@ groupSplitOps desc = do

507 withMaxSuccess maxTestCount $

510 withMaxSuccess maxTestCount $

508 monadicIO $ do

511 monadicIO $ do

509 let xs = intercalate [0] xss

512 let xs = intercalate [0] xss

510− ys <- S.toList $ FL.splitOn [0] FL.toList (S.fromList xs)

513+ ys <- S.toList $ FL.splitOn [0] toListFL (S.fromList xs)

511 listEquals (==) ys xss

514 listEquals (==) ys xss

512

515

513 where

516 where