Skip to content

Commit 4a8b36b

Browse files
ShimuuarShimuuar
committed
Implement fusion test suite
This reimplements most of test as proposed by @nomeata except for slices. There're some questions on how slices should work. Test suite uses memory allocation in order to check that no intemediate vectors are constructed. It requires that GHC compiles code down to nonallocating loops and it could only reliably happen with -O2 Fixes #229
1 parent 90fb740 commit 4a8b36b

6 files changed

Lines changed: 453 additions & 25 deletions

File tree

‎vector/tests-inspect/Inspect.hs‎

Lines changed: 0 additions & 19 deletions
This file was deleted.

‎vector/tests-inspect/Inspect/Alloc.hs‎

Lines changed: 110 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -12,15 +12,18 @@ module Inspect.Alloc where
1212

1313
import Control.Monad.ST
1414
import Data.Int
15+
import Data.Word
16+
import Data.Char
1517
-- import Data.Monoid
1618
import Data.Functor.Identity
19+
import Foreign.Storable (sizeOf)
1720
import Test.Tasty
1821
import Test.Tasty.HUnit
1922
import System.Mem
2023
import Test.Alloc
2124

2225
import qualified Data.Vector.Unboxed as VU
23-
26+
import Inspect.Fusion
2427

2528
tests :: TestTree
2629
tests = testGroup "allocations"
@@ -67,8 +70,97 @@ tests = testGroup "allocations"
6770
-- $ checkAllocations (linear 8)
6871
-- $ (\sz -> VU.generateM sz (\n -> Identity (fromIntegral n :: Int64))) `whnf` size
6972
]
73+
, testGroup "Fusion"
74+
[ testGroup "transformers"
75+
[ allocWHNF "test_map" test_map vectorI
76+
, allocWHNF "test_imap" test_imap vectorI
77+
, allocWHNF "test_mapMaybe" test_mapMaybe vectorI
78+
, allocWHNF "test_cons" test_cons vectorI
79+
, allocWHNF "test_snoc" test_snoc vectorI
80+
-- FIXME: GHC does not fuse intermediate vectors in concatMap
81+
--
82+
-- , allocWHNF "test_concatMap_singleton" test_concatMap_singleton vectorI
83+
-- , allocWHNF "test_concatMap_replicate" test_concatMap_replicate vectorI
84+
, allocWHNF "test_appendL" (test_appendL vectorI) vectorI
85+
, allocWHNF "test_appendR" (test_appendR vectorI) vectorI
86+
, allocWHNF "test_indexed" test_indexed vectorI
87+
]
88+
, testGroup "producers"
89+
[ allocWHNF "test_replicate" test_replicate size
90+
, allocWHNF "test_generate" test_generate size
91+
, allocWHNF "test_iterateN" test_iterateN size
92+
, allocWHNF "test_unfoldr" test_unfoldr size
93+
, allocWHNF "test_unfoldrN" test_unfoldrN size
94+
, allocWHNF "test_enumFromN" test_enumFromN size
95+
, allocWHNF "test_enumFromStepN" test_enumFromStepN size
96+
97+
, allocWHNF "test_enumFromTo[Int]" (test_enumFromTo @Int fromIntegral 0) 100000
98+
, allocWHNF "test_enumFromTo[Int64]" (test_enumFromTo @Int64 fromIntegral 0) 100000
99+
, allocWHNF "test_enumFromTo[Int32]" (test_enumFromTo @Int32 fromIntegral 0) 100000
100+
, allocWHNF "test_enumFromTo[Int16]" (test_enumFromTo @Int16 fromIntegral 0) maxBound
101+
, allocWHNF "test_enumFromTo[Word]" (test_enumFromTo @Word fromIntegral 0) 100000
102+
, allocWHNF "test_enumFromTo[Word64]" (test_enumFromTo @Word64 fromIntegral 0) 100000
103+
, allocWHNF "test_enumFromTo[Word32]" (test_enumFromTo @Word32 fromIntegral 0) 100000
104+
, allocWHNF "test_enumFromTo[Word16]" (test_enumFromTo @Word16 fromIntegral 0) maxBound
105+
, allocWHNF "test_enumFromTo[Float]" (test_enumFromTo @Float round 0) 100000
106+
, allocWHNF "test_enumFromTo[Double]" (test_enumFromTo @Double round 0) 100000
107+
, allocWHNF "test_enumFromTo[Char]" (test_enumFromTo @Char ord (chr 32)) (chr 8000)
108+
-- FIXME: We don't have specializations for enumFromThenTo
109+
--
110+
-- , allocWHNF "test_enumFromThenTo" test_enumFromThenTo size
111+
]
112+
, testGroup "consumers"
113+
[ allocWHNF "test_bang" test_bang vectorI
114+
, allocWHNF "test_safeBang" test_safeBang vectorI
115+
, allocWHNF "test_head" test_head vectorI
116+
, allocWHNF "test_last" test_last vectorI
117+
, allocWHNF "test_unsafeHead" test_unsafeHead vectorI
118+
, allocWHNF "test_unsafeLast" test_unsafeLast vectorI
119+
, allocWHNF "test_indexM" test_indexM vectorI
120+
, allocWHNF "test_headM" test_headM vectorI
121+
, allocWHNF "test_lastM" test_lastM vectorI
122+
, allocWHNF "test_unsafeHeadM" test_unsafeHeadM vectorI
123+
, allocWHNF "test_unsafeLastM" test_unsafeLastM vectorI
124+
]
125+
, testGroup "update"
126+
[ allocVecWHNF "test_upd" (test_upd listUpd) vectorI
127+
, allocVecWHNF "test_update_1" (test_update_1 vectorIdx) vectorI
128+
, allocVecWHNF "test_update_2" (test_update_2 vectorI) vectorI
129+
, allocVecWHNF "test_update__1" (test_update__1 vectorI vectorI) vectorI
130+
, allocVecWHNF "test_update__2" (test_update__2 vectorI vectorI) vectorI
131+
, allocVecWHNF "test_update__3" (test_update__3 vectorI vectorI) vectorI
132+
, allocVecWHNF "test_unsafeUpdate_1" (test_unsafeUpdate_1 vectorIdx) vectorI
133+
, allocVecWHNF "test_unsafeUpdate_2" (test_unsafeUpdate_2 vectorI) vectorI
134+
, allocVecWHNF "test_unsafeUpdate__1" (test_unsafeUpdate__1 vectorI vectorI) vectorI
135+
, allocVecWHNF "test_unsafeUpdate__2" (test_unsafeUpdate__2 vectorI vectorI) vectorI
136+
, allocVecWHNF "test_unsafeUpdate__3" (test_unsafeUpdate__3 vectorI vectorI) vectorI
137+
, allocVecWHNF "test_accumulate_1" (test_accumulate_1 vectorIdx) vectorI
138+
, allocVecWHNF "test_accumulate_2" (test_accumulate_2 vectorI) vectorI
139+
, allocVecWHNF "test_accumulate__1" (test_accumulate__1 vectorI vectorI) vectorI
140+
, allocVecWHNF "test_accumulate__2" (test_accumulate__2 vectorI vectorI) vectorI
141+
, allocVecWHNF "test_accumulate__3" (test_accumulate__3 vectorI vectorI) vectorI
142+
, allocVecWHNF "test_unsafeAccumulate_1" (test_unsafeAccumulate_1 vectorIdx) vectorI
143+
, allocVecWHNF "test_unsafeAccumulate_2" (test_unsafeAccumulate_2 vectorI) vectorI
144+
, allocVecWHNF "test_unsafeAccumulate__1" (test_unsafeAccumulate__1 vectorI vectorI) vectorI
145+
, allocVecWHNF "test_unsafeAccumulate__2" (test_unsafeAccumulate__2 vectorI vectorI) vectorI
146+
, allocVecWHNF "test_unsafeAccumulate__3" (test_unsafeAccumulate__3 vectorI vectorI) vectorI
147+
]
148+
, testGroup "other"
149+
[ allocWHNF "test_concat" test_concat listVectorI
150+
]
151+
]
70152
]
71153

154+
allocWHNF :: String -> (a -> b) -> a -> TestTree
155+
{-# INLINE allocWHNF #-}
156+
allocWHNF name f a = testCase name $ checkAllocations constant (f `whnf` a)
157+
158+
allocVecWHNF :: String -> (a -> b) -> a -> TestTree
159+
{-# INLINE allocVecWHNF #-}
160+
allocVecWHNF name f a
161+
= testCase name
162+
$ checkAllocations (linear (sizeOf (undefined::Int))) (f `whnf` a)
163+
72164

73165
pureST :: Int -> ST s Int64
74166
{-# NOINLINE pureST #-}
@@ -87,6 +179,23 @@ vector :: VU.Vector Int64
87179
{-# NOINLINE vector #-}
88180
vector = VU.generate size fromIntegral
89181

182+
vectorI :: VU.Vector Int
183+
{-# NOINLINE vectorI #-}
184+
vectorI = VU.generate size fromIntegral
185+
186+
vectorIdx :: VU.Vector (Int,Int)
187+
{-# NOINLINE vectorIdx #-}
188+
vectorIdx = VU.map (\i -> (i`div`3, i)) vectorI
189+
190+
listVectorI :: [VU.Vector Int]
191+
{-# NOINLINE listVectorI #-}
192+
listVectorI = replicate 8 vectorI
193+
194+
listUpd :: [(Int,Int)]
195+
{-# NOINLINE listUpd #-}
196+
listUpd = [(0,0), (1000,0), (100,0)]
197+
198+
90199
-- | N bytes per element + constant overhead. We also check that bound
91200
-- is tight.
92201
linear :: Int -> Range

0 commit comments

Comments
 (0)