Visitar URL original
Merge pull request #577 from haskell/lazy_elemseq_DoNotUnboxLazy · haskell/vector@65f4b3c · GitHub
Skip to content

Commit 65f4b3c

Browse files
ShimuuarShimuuar
authored
Merge pull request #577 from haskell/lazy_elemseq_DoNotUnboxLazy
Make elemseq lazy for DoNotUnboxLazy
2 parents d0f42e0 + 540d636 commit 65f4b3c

2 files changed

Lines changed: 38 additions & 19 deletions

File tree

‎vector/src/Data/Vector/Unboxed/Unsafe.hs‎

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -885,14 +885,12 @@ instance G.Vector Vector (DoNotUnboxLazy a) where
885885
{-# INLINE basicLength #-}
886886
{-# INLINE basicUnsafeSlice #-}
887887
{-# INLINE basicUnsafeIndexM #-}
888-
{-# INLINE elemseq #-}
889888
basicUnsafeFreeze = coerce $ G.basicUnsafeFreeze @B.Vector @a
890889
basicUnsafeThaw = coerce $ G.basicUnsafeThaw @B.Vector @a
891890
basicLength = coerce $ G.basicLength @B.Vector @a
892891
basicUnsafeSlice = coerce $ G.basicUnsafeSlice @B.Vector @a
893892
basicUnsafeIndexM = coerce $ G.basicUnsafeIndexM @B.Vector @a
894893
basicUnsafeCopy = coerce $ G.basicUnsafeCopy @B.Vector @a
895-
elemseq _ = seq
896894

897895
instance Unbox (DoNotUnboxLazy a)
898896

‎vector/tests/Tests/Vector/Unboxed.hs‎

Lines changed: 38 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -1,15 +1,20 @@
1-
{-# LANGUAGE ConstraintKinds #-}
1+
{-# LANGUAGE ConstraintKinds #-}
2+
{-# LANGUAGE DerivingVia #-}
3+
{-# LANGUAGE StandaloneDeriving #-}
24
module Tests.Vector.Unboxed (tests) where
35

46
import Test.Tasty
5-
import qualified Data.Vector.Unboxed
7+
import Test.Tasty.HUnit
8+
import qualified Data.Vector.Unboxed as VU
9+
import qualified Data.Vector.Generic as VG
10+
import qualified Data.Vector.Generic.Mutable as VGM
611
import Tests.Vector.Property
712

813

914

1015
testGeneralUnboxedVector
11-
:: forall a. (CommonContext a Data.Vector.Unboxed.Vector, Data.Vector.Unboxed.Unbox a, Ord a, Data a)
12-
=> Data.Vector.Unboxed.Vector a -> [TestTree]
16+
:: forall a. (CommonContext a VU.Vector, VU.Unbox a, Ord a, Data a)
17+
=> VU.Vector a -> [TestTree]
1318
testGeneralUnboxedVector dummy = concatMap ($ dummy)
1419
[
1520
testSanity
@@ -33,9 +38,9 @@ testBoolUnboxedVector dummy = concatMap ($ dummy)
3338
]
3439

3540
testNumericUnboxedVector
36-
:: forall a. ( CommonContext a Data.Vector.Unboxed.Vector
37-
, Data.Vector.Unboxed.Unbox a, Ord a, Num a, Enum a, Random a, Data a)
38-
=> Data.Vector.Unboxed.Vector a -> [TestTree]
41+
:: forall a. ( CommonContext a VU.Vector
42+
, VU.Unbox a, Ord a, Num a, Enum a, Random a, Data a)
43+
=> VU.Vector a -> [TestTree]
3944
testNumericUnboxedVector dummy = concatMap ($ dummy)
4045
[
4146
testGeneralUnboxedVector
@@ -44,28 +49,44 @@ testNumericUnboxedVector dummy = concatMap ($ dummy)
4449
]
4550

4651
testTupleUnboxedVector
47-
:: forall a. ( CommonContext a Data.Vector.Unboxed.Vector
48-
, Data.Vector.Unboxed.Unbox a, Ord a, Data a) => Data.Vector.Unboxed.Vector a -> [TestTree]
52+
:: forall a. ( CommonContext a VU.Vector
53+
, VU.Unbox a, Ord a, Data a) => VU.Vector a -> [TestTree]
4954
testTupleUnboxedVector dummy = concatMap ($ dummy)
5055
[
5156
testGeneralUnboxedVector
5257
]
5358

59+
60+
newtype Bar = Bar Int
61+
deriving (Eq, Ord, Show)
62+
63+
newtype instance VU.MVector s Bar = MV_Bar (VU.MVector s (VU.DoNotUnboxLazy Bar))
64+
newtype instance VU.Vector Bar = V_Bar (VU.Vector (VU.DoNotUnboxLazy Bar))
65+
deriving via (VU.DoNotUnboxLazy Bar) instance VGM.MVector VU.MVector Bar
66+
deriving via (VU.DoNotUnboxLazy Bar) instance VG.Vector VU.Vector Bar
67+
instance VU.Unbox Bar
68+
69+
testDeriving :: TestTree
70+
testDeriving = testGroup "deriving"
71+
[ testCase "DoNotUnboxLazy is lazy" $ 10 @=? VU.length (VU.replicate 10 (undefined::Bar))
72+
]
73+
5474
tests =
5575
[ testGroup "()" $
56-
testUnitUnboxedVector (undefined :: Data.Vector.Unboxed.Vector ())
76+
testUnitUnboxedVector (undefined :: VU.Vector ())
5777
, testGroup "(Bool)" $
58-
testBoolUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Bool)
78+
testBoolUnboxedVector (undefined :: VU.Vector Bool)
5979
, testGroup "(Int)" $
60-
testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Int)
80+
testNumericUnboxedVector (undefined :: VU.Vector Int)
6181
, testGroup "(Float)" $
62-
testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Float)
82+
testNumericUnboxedVector (undefined :: VU.Vector Float)
6383
, testGroup "(Double)" $
64-
testNumericUnboxedVector (undefined :: Data.Vector.Unboxed.Vector Double)
84+
testNumericUnboxedVector (undefined :: VU.Vector Double)
6585
, testGroup "(Int,Bool)" $
66-
testTupleUnboxedVector (undefined :: Data.Vector.Unboxed.Vector (Int, Bool))
86+
testTupleUnboxedVector (undefined :: VU.Vector (Int, Bool))
6787
, testGroup "(Int,Bool,Int)" $
6888
testTupleUnboxedVector
69-
(undefined :: Data.Vector.Unboxed.Vector (Int, Bool, Int))
70-
, testGroup "unstream" $ testUnstream (undefined :: Data.Vector.Unboxed.Vector Int)
89+
(undefined :: VU.Vector (Int, Bool, Int))
90+
, testGroup "unstream" $ testUnstream (undefined :: VU.Vector Int)
91+
, testDeriving
7192
]

0 commit comments

Comments
 (0)