# Ticket #4333: containers-intset.patch

File containers-intset.patch, 28.9 KB (added by milan, 6 years ago) |
---|

Line | |
---|---|

1 | 4 patches for repository auryn:Darcs/containers: |

2 | |

3 | Tue Sep 21 12:28:02 CEST 2010 Milan Straka <fox@ucw.cz> |

4 | * Add a testsuite for Data.IntSet. |

5 | |

6 | Tue Sep 21 12:32:25 CEST 2010 Milan Straka <fox@ucw.cz> |

7 | * Add criterion-based benchmark for IntSet.hs. |

8 | |

9 | The benchmark is nearly identical copy of Set.hs benchmark. |

10 | |

11 | Tue Sep 21 13:58:21 CEST 2010 Milan Straka <fox@ucw.cz> |

12 | * Compile only the benchmark source, not the Data/*.hs. |

13 | |

14 | Thu Sep 23 14:56:04 CEST 2010 Milan Straka <fox@ucw.cz> |

15 | * Worker/wrapper transformation for Data.IntSet. |

16 | |

17 | New patches: |

18 | |

19 | [Add a testsuite for Data.IntSet. |

20 | Milan Straka <fox@ucw.cz>**20100921102802 |

21 | Ignore-this: e55484ee185e71915452bdf2a7b2a2b3 |

22 | ] { |

23 | hunk ./Data/IntSet.hs 42 |

24 | |

25 | module Data.IntSet ( |

26 | -- * Set type |

27 | +#if !defined(TESTING) |

28 | IntSet -- instance Eq,Show |

29 | hunk ./Data/IntSet.hs 44 |

30 | +#else |

31 | + IntSet(..) -- instance Eq,Show |

32 | +#endif |

33 | |

34 | -- * Operators |

35 | , (\\) |

36 | hunk ./Data/IntSet.hs 106 |

37 | -- * Debugging |

38 | , showTree |

39 | , showTreeWith |

40 | + |

41 | +#if defined(TESTING) |

42 | + -- * Internals |

43 | + , match |

44 | +#endif |

45 | ) where |

46 | |

47 | |

48 | hunk ./Data/IntSet.hs 122 |

49 | import Data.Maybe (fromMaybe) |

50 | import Data.Typeable |

51 | |

52 | -{- |

53 | --- just for testing |

54 | -import Test.QuickCheck |

55 | -import List (nub,sort) |

56 | -import qualified List |

57 | -import qualified Data.Set as Set |

58 | --} |

59 | - |

60 | #if __GLASGOW_HASKELL__ |

61 | import Text.Read |

62 | import Data.Data (Data(..), mkNoRepType) |

63 | hunk ./Data/IntSet.hs 993 |

64 | = case xs of |

65 | [] -> z |

66 | (x:xx) -> let z' = f z x in seq z' (foldlStrict f z' xx) |

67 | - |

68 | - |

69 | -{- |

70 | -{-------------------------------------------------------------------- |

71 | - Testing |

72 | ---------------------------------------------------------------------} |

73 | -testTree :: [Int] -> IntSet |

74 | -testTree xs = fromList xs |

75 | -test1 = testTree [1..20] |

76 | -test2 = testTree [30,29..10] |

77 | -test3 = testTree [1,4,6,89,2323,53,43,234,5,79,12,9,24,9,8,423,8,42,4,8,9,3] |

78 | - |

79 | -{-------------------------------------------------------------------- |

80 | - QuickCheck |

81 | ---------------------------------------------------------------------} |

82 | -qcheck prop |

83 | - = check config prop |

84 | - where |

85 | - config = Config |

86 | - { configMaxTest = 500 |

87 | - , configMaxFail = 5000 |

88 | - , configSize = \n -> (div n 2 + 3) |

89 | - , configEvery = \n args -> let s = show n in s ++ [ '\b' | _ <- s ] |

90 | - } |

91 | - |

92 | - |

93 | -{-------------------------------------------------------------------- |

94 | - Arbitrary, reasonably balanced trees |

95 | ---------------------------------------------------------------------} |

96 | -instance Arbitrary IntSet where |

97 | - arbitrary = do{ xs <- arbitrary |

98 | - ; return (fromList xs) |

99 | - } |

100 | - |

101 | - |

102 | -{-------------------------------------------------------------------- |

103 | - Single, Insert, Delete |

104 | ---------------------------------------------------------------------} |

105 | -prop_Single :: Int -> Bool |

106 | -prop_Single x |

107 | - = (insert x empty == singleton x) |

108 | - |

109 | -prop_InsertDelete :: Int -> IntSet -> Property |

110 | -prop_InsertDelete k t |

111 | - = not (member k t) ==> delete k (insert k t) == t |

112 | - |

113 | - |

114 | -{-------------------------------------------------------------------- |

115 | - Union |

116 | ---------------------------------------------------------------------} |

117 | -prop_UnionInsert :: Int -> IntSet -> Bool |

118 | -prop_UnionInsert x t |

119 | - = union t (singleton x) == insert x t |

120 | - |

121 | -prop_UnionAssoc :: IntSet -> IntSet -> IntSet -> Bool |

122 | -prop_UnionAssoc t1 t2 t3 |

123 | - = union t1 (union t2 t3) == union (union t1 t2) t3 |

124 | - |

125 | -prop_UnionComm :: IntSet -> IntSet -> Bool |

126 | -prop_UnionComm t1 t2 |

127 | - = (union t1 t2 == union t2 t1) |

128 | - |

129 | -prop_Diff :: [Int] -> [Int] -> Bool |

130 | -prop_Diff xs ys |

131 | - = toAscList (difference (fromList xs) (fromList ys)) |

132 | - == List.sort ((List.\\) (nub xs) (nub ys)) |

133 | - |

134 | -prop_Int :: [Int] -> [Int] -> Bool |

135 | -prop_Int xs ys |

136 | - = toAscList (intersection (fromList xs) (fromList ys)) |

137 | - == List.sort (nub ((List.intersect) (xs) (ys))) |

138 | - |

139 | -{-------------------------------------------------------------------- |

140 | - Lists |

141 | ---------------------------------------------------------------------} |

142 | -prop_Ordered |

143 | - = forAll (choose (5,100)) $ \n -> |

144 | - let xs = concat [[i-n,i-n]|i<-[0..2*n :: Int]] |

145 | - in fromAscList xs == fromList xs |

146 | - |

147 | -prop_List :: [Int] -> Bool |

148 | -prop_List xs |

149 | - = (sort (nub xs) == toAscList (fromList xs)) |

150 | - |

151 | -{-------------------------------------------------------------------- |

152 | - Bin invariants |

153 | ---------------------------------------------------------------------} |

154 | -powersOf2 :: IntSet |

155 | -powersOf2 = fromList [2^i | i <- [0..63]] |

156 | - |

157 | --- Check the invariant that the mask is a power of 2. |

158 | -prop_MaskPow2 :: IntSet -> Bool |

159 | -prop_MaskPow2 (Bin _ msk left right) = member msk powersOf2 && prop_MaskPow2 left && prop_MaskPow2 right |

160 | -prop_MaskPow2 _ = True |

161 | - |

162 | --- Check that the prefix satisfies its invariant. |

163 | -prop_Prefix :: IntSet -> Bool |

164 | -prop_Prefix s@(Bin prefix msk left right) = all (\elem -> match elem prefix msk) (toList s) && prop_Prefix left && prop_Prefix right |

165 | -prop_Prefix _ = True |

166 | - |

167 | --- Check that the left elements don't have the mask bit set, and the right |

168 | --- ones do. |

169 | -prop_LeftRight :: IntSet -> Bool |

170 | -prop_LeftRight (Bin _ msk left right) = and [x .&. msk == 0 | x <- toList left] && and [x .&. msk == msk | x <- toList right] |

171 | -prop_LeftRight _ = True |

172 | - |

173 | -{-------------------------------------------------------------------- |

174 | - IntSet operations are like Set operations |

175 | ---------------------------------------------------------------------} |

176 | -toSet :: IntSet -> Set.Set Int |

177 | -toSet = Set.fromList . toList |

178 | - |

179 | --- Check that IntSet.isProperSubsetOf is the same as Set.isProperSubsetOf. |

180 | -prop_isProperSubsetOf :: IntSet -> IntSet -> Bool |

181 | -prop_isProperSubsetOf a b = isProperSubsetOf a b == Set.isProperSubsetOf (toSet a) (toSet b) |

182 | - |

183 | --- In the above test, isProperSubsetOf almost always returns False (since a |

184 | --- random set is almost never a subset of another random set). So this second |

185 | --- test checks the True case. |

186 | -prop_isProperSubsetOf2 :: IntSet -> IntSet -> Bool |

187 | -prop_isProperSubsetOf2 a b = isProperSubsetOf a c == (a /= c) where |

188 | - c = union a b |

189 | --} |

190 | addfile ./tests/intset-properties.hs |

191 | hunk ./tests/intset-properties.hs 1 |

192 | +{-# LANGUAGE CPP, ScopedTypeVariables #-} |

193 | + |

194 | +-- QuickCheck properties for Data.IntSet |

195 | +-- > ghc -DTESTING -fforce-recomp -O2 --make -fhpc -i.. intset-properties.hs |

196 | + |

197 | +import Data.Bits ((.&.)) |

198 | +import Data.IntSet |

199 | +import Data.List (nub,sort) |

200 | +import qualified Data.List as List |

201 | +import qualified Data.Set as Set |

202 | +import Prelude hiding (lookup, null, map ,filter) |

203 | +import Test.QuickCheck hiding ((.&.)) |

204 | + |

205 | +main :: IO () |

206 | +main = do |

207 | + q $ label "prop_Single" prop_Single |

208 | + q $ label "prop_InsertDelete" prop_InsertDelete |

209 | + q $ label "prop_UnionInsert" prop_UnionInsert |

210 | + q $ label "prop_UnionAssoc" prop_UnionAssoc |

211 | + q $ label "prop_UnionComm" prop_UnionComm |

212 | + q $ label "prop_Diff" prop_Diff |

213 | + q $ label "prop_Int" prop_Int |

214 | + q $ label "prop_Ordered" prop_Ordered |

215 | + q $ label "prop_List" prop_List |

216 | + q $ label "prop_MaskPow2" prop_MaskPow2 |

217 | + q $ label "prop_Prefix" prop_Prefix |

218 | + q $ label "prop_LeftRight" prop_LeftRight |

219 | + q $ label "prop_isProperSubsetOf" prop_isProperSubsetOf |

220 | + q $ label "prop_isProperSubsetOf2" prop_isProperSubsetOf2 |

221 | + where |

222 | + q :: Testable prop => prop -> IO () |

223 | + q = quickCheckWith args |

224 | +{-------------------------------------------------------------------- |

225 | + QuickCheck |

226 | +--------------------------------------------------------------------} |

227 | + |

228 | +args :: Args |

229 | +args = stdArgs { maxSuccess = 500 |

230 | + , maxDiscard = 500 |

231 | + } |

232 | + |

233 | +{-------------------------------------------------------------------- |

234 | + Arbitrary, reasonably balanced trees |

235 | +--------------------------------------------------------------------} |

236 | +instance Arbitrary IntSet where |

237 | + arbitrary = do{ xs <- arbitrary |

238 | + ; return (fromList xs) |

239 | + } |

240 | + |

241 | + |

242 | +{-------------------------------------------------------------------- |

243 | + Single, Insert, Delete |

244 | +--------------------------------------------------------------------} |

245 | +prop_Single :: Int -> Bool |

246 | +prop_Single x |

247 | + = (insert x empty == singleton x) |

248 | + |

249 | +prop_InsertDelete :: Int -> IntSet -> Property |

250 | +prop_InsertDelete k t |

251 | + = not (member k t) ==> delete k (insert k t) == t |

252 | + |

253 | + |

254 | +{-------------------------------------------------------------------- |

255 | + Union |

256 | +--------------------------------------------------------------------} |

257 | +prop_UnionInsert :: Int -> IntSet -> Bool |

258 | +prop_UnionInsert x t |

259 | + = union t (singleton x) == insert x t |

260 | + |

261 | +prop_UnionAssoc :: IntSet -> IntSet -> IntSet -> Bool |

262 | +prop_UnionAssoc t1 t2 t3 |

263 | + = union t1 (union t2 t3) == union (union t1 t2) t3 |

264 | + |

265 | +prop_UnionComm :: IntSet -> IntSet -> Bool |

266 | +prop_UnionComm t1 t2 |

267 | + = (union t1 t2 == union t2 t1) |

268 | + |

269 | +prop_Diff :: [Int] -> [Int] -> Bool |

270 | +prop_Diff xs ys |

271 | + = toAscList (difference (fromList xs) (fromList ys)) |

272 | + == List.sort ((List.\\) (nub xs) (nub ys)) |

273 | + |

274 | +prop_Int :: [Int] -> [Int] -> Bool |

275 | +prop_Int xs ys |

276 | + = toAscList (intersection (fromList xs) (fromList ys)) |

277 | + == List.sort (nub ((List.intersect) (xs) (ys))) |

278 | + |

279 | +{-------------------------------------------------------------------- |

280 | + Lists |

281 | +--------------------------------------------------------------------} |

282 | +prop_Ordered |

283 | + = forAll (choose (5,100)) $ \n -> |

284 | + let xs = concat [[i-n,i-n]|i<-[0..2*n :: Int]] |

285 | + in fromAscList xs == fromList xs |

286 | + |

287 | +prop_List :: [Int] -> Bool |

288 | +prop_List xs |

289 | + = (sort (nub xs) == toAscList (fromList xs)) |

290 | + |

291 | +{-------------------------------------------------------------------- |

292 | + Bin invariants |

293 | +--------------------------------------------------------------------} |

294 | +powersOf2 :: IntSet |

295 | +powersOf2 = fromList [2^i | i <- [0..63]] |

296 | + |

297 | +-- Check the invariant that the mask is a power of 2. |

298 | +prop_MaskPow2 :: IntSet -> Bool |

299 | +prop_MaskPow2 (Bin _ msk left right) = member msk powersOf2 && prop_MaskPow2 left && prop_MaskPow2 right |

300 | +prop_MaskPow2 _ = True |

301 | + |

302 | +-- Check that the prefix satisfies its invariant. |

303 | +prop_Prefix :: IntSet -> Bool |

304 | +prop_Prefix s@(Bin prefix msk left right) = all (\elem -> match elem prefix msk) (toList s) && prop_Prefix left && prop_Prefix right |

305 | +prop_Prefix _ = True |

306 | + |

307 | +-- Check that the left elements don't have the mask bit set, and the right |

308 | +-- ones do. |

309 | +prop_LeftRight :: IntSet -> Bool |

310 | +prop_LeftRight (Bin _ msk left right) = and [x .&. msk == 0 | x <- toList left] && and [x .&. msk == msk | x <- toList right] |

311 | +prop_LeftRight _ = True |

312 | + |

313 | +{-------------------------------------------------------------------- |

314 | + IntSet operations are like Set operations |

315 | +--------------------------------------------------------------------} |

316 | +toSet :: IntSet -> Set.Set Int |

317 | +toSet = Set.fromList . toList |

318 | + |

319 | +-- Check that IntSet.isProperSubsetOf is the same as Set.isProperSubsetOf. |

320 | +prop_isProperSubsetOf :: IntSet -> IntSet -> Bool |

321 | +prop_isProperSubsetOf a b = isProperSubsetOf a b == Set.isProperSubsetOf (toSet a) (toSet b) |

322 | + |

323 | +-- In the above test, isProperSubsetOf almost always returns False (since a |

324 | +-- random set is almost never a subset of another random set). So this second |

325 | +-- test checks the True case. |

326 | +prop_isProperSubsetOf2 :: IntSet -> IntSet -> Bool |

327 | +prop_isProperSubsetOf2 a b = isProperSubsetOf a c == (a /= c) where |

328 | + c = union a b |

329 | } |

330 | [Add criterion-based benchmark for IntSet.hs. |

331 | Milan Straka <fox@ucw.cz>**20100921103225 |

332 | Ignore-this: 3d31a820830c7382748626bc9a1ba54 |

333 | |

334 | The benchmark is nearly identical copy of Set.hs benchmark. |

335 | ] { |

336 | addfile ./benchmarks/IntSet.hs |

337 | hunk ./benchmarks/IntSet.hs 1 |

338 | +{-# LANGUAGE BangPatterns #-} |

339 | + |

340 | +module Main where |

341 | + |

342 | +import Control.DeepSeq |

343 | +import Control.Exception (evaluate) |

344 | +import Control.Monad.Trans (liftIO) |

345 | +import Criterion.Config |

346 | +import Criterion.Main |

347 | +import Data.List (foldl') |

348 | +import qualified Data.IntSet as S |

349 | + |

350 | +instance NFData S.IntSet where |

351 | + rnf S.Nil = () |

352 | + rnf (S.Tip a) = rnf a |

353 | + rnf (S.Bin p m l r) = rnf p `seq` rnf m `seq` rnf l `seq` rnf r |

354 | + |

355 | +main = do |

356 | + let s = S.fromAscList elems :: S.IntSet |

357 | + s_even = S.fromAscList elems_even :: S.IntSet |

358 | + s_odd = S.fromAscList elems_odd :: S.IntSet |

359 | + defaultMainWith |

360 | + defaultConfig |

361 | + (liftIO . evaluate $ rnf [s, s_even, s_odd]) |

362 | + [ bench "member" $ nf (member elems) s |

363 | + , bench "insert" $ nf (ins elems) S.empty |

364 | + , bench "map" $ nf (S.map (+ 1)) s |

365 | + , bench "filter" $ nf (S.filter ((== 0) . (`mod` 2))) s |

366 | + , bench "partition" $ nf (S.partition ((== 0) . (`mod` 2))) s |

367 | + , bench "fold" $ nf (S.fold (:) []) s |

368 | + , bench "delete" $ nf (del elems) s |

369 | + , bench "findMin" $ nf S.findMin s |

370 | + , bench "findMax" $ nf S.findMax s |

371 | + , bench "deleteMin" $ nf S.deleteMin s |

372 | + , bench "deleteMax" $ nf S.deleteMax s |

373 | + , bench "unions" $ nf S.unions [s_even, s_odd] |

374 | + , bench "union" $ nf (S.union s_even) s_odd |

375 | + , bench "difference" $ nf (S.difference s) s_even |

376 | + , bench "intersection" $ nf (S.intersection s) s_even |

377 | + ] |

378 | + where |

379 | + elems = [1..2^10] |

380 | + elems_even = [2,4..2^10] |

381 | + elems_odd = [1,3..2^10] |

382 | + |

383 | +member :: [Int] -> S.IntSet -> Int |

384 | +member xs s = foldl' (\n x -> if S.member x s then n + 1 else n) 0 xs |

385 | + |

386 | +ins :: [Int] -> S.IntSet -> S.IntSet |

387 | +ins xs s0 = foldl' (\s a -> S.insert a s) s0 xs |

388 | + |

389 | +del :: [Int] -> S.IntSet -> S.IntSet |

390 | +del xs s0 = foldl' (\s k -> S.delete k s) s0 xs |

391 | hunk ./benchmarks/Makefile 5 |

392 | version := $(shell awk '/^version:/{print $$2}' ../$(package).cabal) |

393 | lib := ../dist/build/libHS$(package)-$(version).a |

394 | |

395 | -programs := bench-Map bench-Set bench-IntMap |

396 | +programs := bench-Map bench-Set bench-IntMap bench-IntSet |

397 | all: $(programs) |

398 | run: $(patsubst %, %.csv, $(programs)) |

399 | |

400 | } |

401 | [Compile only the benchmark source, not the Data/*.hs. |

402 | Milan Straka <fox@ucw.cz>**20100921115821 |

403 | Ignore-this: f94d9e3ffe126cd057d23490c973a4e9 |

404 | ] hunk ./benchmarks/Makefile 10 |

405 | run: $(patsubst %, %.csv, $(programs)) |

406 | |

407 | bench-%: %.hs ../Data/%.hs |

408 | - ghc -DTESTING -cpp -O2 -fregs-graph --make -fforce-recomp -i.. -o $@ $^ |

409 | + ghc -DTESTING -cpp -O2 -fregs-graph --make -fforce-recomp -i.. -o $@ $< |

410 | |

411 | bench-%.csv: bench-% |

412 | ./bench-$* -u bench-$*.csv +RTS -K10M |

413 | [Worker/wrapper transformation for Data.IntSet. |

414 | Milan Straka <fox@ucw.cz>**20100923125604 |

415 | Ignore-this: b0228582818f7bfb690d0853022a7809 |

416 | ] { |

417 | hunk ./Data/IntSet.hs 224 |

418 | |

419 | -- | /O(min(n,W))/. Is the value a member of the set? |

420 | member :: Int -> IntSet -> Bool |

421 | -member x t |

422 | - = case t of |

423 | - Bin p m l r |

424 | - | nomatch x p m -> False |

425 | - | zero x m -> member x l |

426 | - | otherwise -> member x r |

427 | - Tip y -> (x==y) |

428 | - Nil -> False |

429 | - |

430 | +member x Nil = x `seq` False |

431 | +member x t = x `seq` go t |

432 | + where go (Bin p m l r) |

433 | + | nomatch x p m = False |

434 | + | zero x m = go l |

435 | + | otherwise = go r |

436 | + go (Tip y) = x == y |

437 | -- | /O(min(n,W))/. Is the element not in the set? |

438 | notMember :: Int -> IntSet -> Bool |

439 | notMember k = not . member k |

440 | hunk ./Data/IntSet.hs 237 |

441 | |

442 | -- 'lookup' is used by 'intersection' for left-biasing |

443 | lookup :: Int -> IntSet -> Maybe Int |

444 | -lookup k t |

445 | - = let nk = natFromInt k in seq nk (lookupN nk t) |

446 | - |

447 | -lookupN :: Nat -> IntSet -> Maybe Int |

448 | -lookupN k t |

449 | - = case t of |

450 | - Bin _ m l r |

451 | - | zeroN k (natFromInt m) -> lookupN k l |

452 | - | otherwise -> lookupN k r |

453 | - Tip kx |

454 | - | (k == natFromInt kx) -> Just kx |

455 | - | otherwise -> Nothing |

456 | - Nil -> Nothing |

457 | +lookup k Nil = k `seq` Nothing |

458 | +lookup k t = k `seq` go t |

459 | + where go (Bin _ m l r) |

460 | + | zero k m = go l |

461 | + | otherwise = go r |

462 | + go (Tip kx) |

463 | + | k == kx = Just kx |

464 | + | otherwise = Nothing |

465 | |

466 | {-------------------------------------------------------------------- |

467 | Construction |

468 | hunk ./Data/IntSet.hs 266 |

469 | -- an element of the set, it is replaced by the new one, ie. 'insert' |

470 | -- is left-biased. |

471 | insert :: Int -> IntSet -> IntSet |

472 | -insert x t |

473 | - = case t of |

474 | - Bin p m l r |

475 | - | nomatch x p m -> join x (Tip x) p t |

476 | - | zero x m -> Bin p m (insert x l) r |

477 | - | otherwise -> Bin p m l (insert x r) |

478 | - Tip y |

479 | - | x==y -> Tip x |

480 | - | otherwise -> join x (Tip x) y t |

481 | - Nil -> Tip x |

482 | +insert x = x `seq` go |

483 | + where go t@(Bin p m l r ) |

484 | + | nomatch x p m = join x (Tip x) p t |

485 | + | zero x m = Bin p m (go l) r |

486 | + | otherwise = Bin p m l (go r) |

487 | + go t@(Tip y) |

488 | + | x==y = Tip x |

489 | + | otherwise = join x (Tip x) y t |

490 | + go Nil = Tip x |

491 | |

492 | -- right-biased insertion, used by 'union' |

493 | insertR :: Int -> IntSet -> IntSet |

494 | hunk ./Data/IntSet.hs 278 |

495 | -insertR x t |

496 | - = case t of |

497 | - Bin p m l r |

498 | - | nomatch x p m -> join x (Tip x) p t |

499 | - | zero x m -> Bin p m (insert x l) r |

500 | - | otherwise -> Bin p m l (insert x r) |

501 | - Tip y |

502 | - | x==y -> t |

503 | - | otherwise -> join x (Tip x) y t |

504 | - Nil -> Tip x |

505 | +insertR x = x `seq` go |

506 | + where go t@(Bin p m l r ) |

507 | + | nomatch x p m = join x (Tip x) p t |

508 | + | zero x m = Bin p m (go l) r |

509 | + | otherwise = Bin p m l (go r) |

510 | + go t@(Tip y) |

511 | + | x==y = t |

512 | + | otherwise = join x (Tip x) y t |

513 | + go Nil = Tip x |

514 | |

515 | -- | /O(min(n,W))/. Delete a value in the set. Returns the |

516 | -- original set when the value was not present. |

517 | hunk ./Data/IntSet.hs 291 |

518 | delete :: Int -> IntSet -> IntSet |

519 | -delete x t |

520 | - = case t of |

521 | - Bin p m l r |

522 | - | nomatch x p m -> t |

523 | - | zero x m -> bin p m (delete x l) r |

524 | - | otherwise -> bin p m l (delete x r) |

525 | - Tip y |

526 | - | x==y -> Nil |

527 | - | otherwise -> t |

528 | - Nil -> Nil |

529 | - |

530 | +delete x = x `seq` go |

531 | + where go t@(Bin p m l r) |

532 | + | nomatch x p m = t |

533 | + | zero x m = bin p m (go l) r |

534 | + | otherwise = bin p m l (go r) |

535 | + go t@(Tip y) |

536 | + | x==y = Nil |

537 | + | otherwise = t |

538 | + go t@Nil = t |

539 | |

540 | {-------------------------------------------------------------------- |

541 | Union |

542 | hunk ./Data/IntSet.hs 903 |

543 | mask i m |

544 | = maskW (natFromInt i) (natFromInt m) |

545 | |

546 | -zeroN :: Nat -> Nat -> Bool |

547 | -zeroN i m = (i .&. m) == 0 |

548 | - |

549 | {-------------------------------------------------------------------- |

550 | Big endian operations |

551 | --------------------------------------------------------------------} |

552 | } |

553 | |

554 | Context: |

555 | |

556 | [Further improve Data.Set balance function. |

557 | Milan Straka <fox@ucw.cz>**20100921091828 |

558 | Ignore-this: f23be37859224e9bbe919a3c0a71fdc6 |

559 | |

560 | As suggested by Kazu Yamamoto, we split balance to balanceL and |

561 | balanceR, which handle only one-sided inbalance, but need fewer |

562 | tests than balance. |

563 | |

564 | As nearly all functions modifying the structure use balance, this |

565 | results in speedup of many functions. On my 32-bit GHC 6.12.1, |

566 | 11% speedup for insert, 12% speedup for delete. |

567 | ] |

568 | [Further improve Data.Map balance function. |

569 | Milan Straka <fox@ucw.cz>**20100921091547 |

570 | Ignore-this: 8abfd027142a5183b2b5282e96ccb414 |

571 | |

572 | As suggested by Kazu Yamamoto, we split balance to balanceL and |

573 | balanceR, which handle only one-sided inbalance, but need fewer |

574 | tests than balance. |

575 | |

576 | As nearly all functions modifying the structure use balance, this |

577 | results in speedup of many functions. On my 32-bit GHC 6.12.1, |

578 | 20% speedup for insert, 7% speedup for delete, 5% speedup for update. |

579 | ] |

580 | [Changing delta to 3 in Data.Set. |

581 | Milan Straka <fox@ucw.cz>**20100921090507 |

582 | Ignore-this: a47d0c542ed9cee99ad6b17c52c977a1 |

583 | |

584 | Only possible values are 3 and 4. The value 3 has much faster inserts, |

585 | value 4 slightly faster deletes, so choosing 3. |

586 | |

587 | Also changed the inequalities to rebalance only when one subtree |

588 | is _strictly_ larger than delta * the other one, to mimic the behaviour |

589 | from the proof (both from the Adams' and from the one to come). |

590 | ] |

591 | [Changing delta to 3 in Data.Map. |

592 | Milan Straka <fox@ucw.cz>**20100921090358 |

593 | Ignore-this: 85f733f836b65b2b1038383ddb92e8e1 |

594 | |

595 | Only possible values are 3 and 4. The value 3 has much faster inserts, |

596 | value 4 slightly faster deletes, so choosing 3. |

597 | |

598 | Also changed the inequalities to rebalance only when one subtree |

599 | is _strictly_ larger than delta * the other one, to mimic the behaviour |

600 | from the proof (both from the Adams' and from the one to come). |

601 | ] |

602 | [Correct Data.Set Arbitrary instance never to return unbalanced trees. |

603 | Milan Straka <fox@ucw.cz>**20100914150442 |

604 | Ignore-this: b5c70fa98a56f225b8eb5faf420677b0 |

605 | |

606 | The previous instance sometimes returned unbalanced trees, |

607 | which broke the tests. |

608 | |

609 | Also the new instance mimics Data.Map instance more closely in the shape |

610 | of the generated trees. |

611 | ] |

612 | [Correct Data.Map Arbitrary instance never to return unbalanced trees. |

613 | Milan Straka <fox@ucw.cz>**20100914145841 |

614 | Ignore-this: 114bbcc63acdb16b77140ea56aeb0a95 |

615 | |

616 | The previous instance sometimes returned unbalanced trees, |

617 | which broke the tests. |

618 | ] |

619 | [Improve Data.Set benchmark. |

620 | Milan Straka <fox@ucw.cz>**20100914142010 |

621 | Ignore-this: 9b878ae3aa5a43ef083abfd7f9b22513 |

622 | |

623 | Add union, difference and intersection to Data.Set benchmark. |

624 | ] |

625 | [Improve benchmark infrastructure and Data.Map benchmark. |

626 | Milan Straka <fox@ucw.cz>**20100914141707 |

627 | Ignore-this: 67e8dafcb4abcb9c726b9b29c7c320fd |

628 | |

629 | Renamed Benchmarks.hs to Map.hs, as it only benchmarks Data.Map. |

630 | Improve the Makefile to work with multiple benchmarks. |

631 | Add union, difference and intersection to Data.Map benchmark. |

632 | ] |

633 | [Improve the performance of Data.Set balance function. |

634 | Milan Straka <fox@ucw.cz>**20100914140417 |

635 | Ignore-this: 577c511c219695b8d483af546c7387e8 |

636 | |

637 | The balance function is now one monolithic function, which allows |

638 | to perform all pattern-matches only once. |

639 | |

640 | Nearly all functions modifying Data.Map use balance. |

641 | The improvements are 12% for insert, 14% for delete (GHC 6.12.1). |

642 | ] |

643 | [Improve the performance of Data.Map balance function. |

644 | Milan Straka <fox@ucw.cz>**20100914140217 |

645 | Ignore-this: 951181e035fcac90674dff3300350a1 |

646 | |

647 | The balance function is now one monolithic function, which allows |

648 | to perform all pattern-matches only once. |

649 | |

650 | Nearly all functions modifying Data.Map use balance. |

651 | The improvements are 7-11% for various insert*, delete*, alter, |

652 | update or intersection functions (GHC 6.12.1). |

653 | ] |

654 | [Improve performance of Data.Set union and difference operations. |

655 | Milan Straka <fox@ucw.cz>**20100914135725 |

656 | Ignore-this: 6dc4a186ea060b9cdb9e783db71ca280 |

657 | |

658 | Use datatype storing evaluated bound instead of high-order functions. |

659 | The improvements are over 25% for both union and difference (GHC 6.12.1). |

660 | ] |

661 | [Improve performance of Data.Map union* and difference* operations. |

662 | Milan Straka <fox@ucw.cz>**20100914134614 |

663 | Ignore-this: 35b23a40ef33e9fa14eb81fdee4b152d |

664 | |

665 | Use datatype storing evaluated bound instead of high-order functions. |

666 | The improvements are 22% for union and 20% for difference (GHC 6.12.1). |

667 | ] |

668 | [Make the Set store the elements evaluated (bang added). |

669 | Milan Straka <fox@ucw.cz>**20100913165132 |

670 | Ignore-this: b3f230db5bf30d93d3fddf2c81c5f3b4 |

671 | ] |

672 | [Improved performance of Data.Set |

673 | Johan Tibell <johan.tibell@gmail.com>**20100831124352 |

674 | Ignore-this: 38a304a0408d29a2956aa9a1fc0ce755 |

675 | |

676 | Performance improvements are due to manually applying the |

677 | worker/wrapper transformation and strictifying the keys. |

678 | |

679 | Average speed-up is 32% on a 2GHz Core 2 Duo on OS X 10.5.8 |

680 | ] |

681 | [Added benchmarks for Data.Set |

682 | Johan Tibell <johan.tibell@gmail.com>**20100831124225 |

683 | Ignore-this: fcacf88761034b8c534d936f0b336cc0 |

684 | ] |

685 | [Added a test suite for Data.Set |

686 | Johan Tibell <johan.tibell@gmail.com>**20100831124030 |

687 | Ignore-this: f430dc302c0fcb8b5d62db2272a1d6f7 |

688 | |

689 | Expression coverage: 74% |

690 | ] |

691 | [fix warnings |

692 | Simon Marlow <marlowsd@gmail.com>**20100831114555 |

693 | Ignore-this: 53df71bc054a779b8ad2dad89c09e02d |

694 | ] |

695 | [Missing MagicHash for IntSet |

696 | Don Stewart <dons@galois.com>**20100831093446 |

697 | Ignore-this: d075f760adb9a2aa0ee04676e38a07cc |

698 | ] |

699 | [Performance improvements for Data.IntMap (worker/wrapper and inlining) |

700 | Don Stewart <dons@galois.com>**20100831093316 |

701 | Ignore-this: 206036448558d270f0eb85ef4cd55368 |

702 | ] |

703 | [Add criterion-based benchmarking for IntMap |

704 | Don Stewart <dons@galois.com>**20100831093240 |

705 | Ignore-this: d7d85b9afb513532cc30f5b51a3f825e |

706 | ] |

707 | [Add comprehensive testsuite for IntMap |

708 | Don Stewart <dons@galois.com>**20100831093202 |

709 | Ignore-this: d455fedbc615e5b63ac488e605550557 |

710 | ] |

711 | [-O2 -fregs-graph is a uniform 10% improvements for IntMap |

712 | Don Stewart <dons@galois.com>**20100831092956 |

713 | Ignore-this: 2372cf4be945fe7939d0af94e32c567f |

714 | ] |

715 | [Missed base case for updateAt worker. Spotted by Jan-Willem Maessen |

716 | Don Stewart <dons@galois.com>**20100829163329 |

717 | Ignore-this: b8daf1c55c163c16f50c3b54cca2dba1 |

718 | ] |

719 | [Major bump (new functions, clarified strictness properties, vastly better performance) |

720 | Don Stewart <dons@galois.com>**20100829122628 |

721 | Ignore-this: 9bfbc58ecaa24a86be37b8c4cb043457 |

722 | ] |

723 | [Add two new functions: foldlWithKey' and insertLookupWithKey' |

724 | Don Stewart <dons@galois.com>**20100829122147 |

725 | Ignore-this: a2f112653ba38737fe1b38609e06c314 |

726 | |

727 | These two functions use strict accumulators, compared to their existing |

728 | counterparts (which are lazy left folds, that appear not to be useful). |

729 | Performance is significantly better. |

730 | |

731 | ] |

732 | [Performance improvements to Data.Map |

733 | Don Stewart <dons@galois.com>**20100829120245 |

734 | Ignore-this: b4830cddfa6d62e4883f4e0f58ac4e57 |

735 | |

736 | Applied several standard transformations to improve the performance of |

737 | code: |

738 | |

739 | * Worker/wrapper of all recursive functions with constant arguments |

740 | * Inlining of all (non-recursive) wrappers |

741 | * Consistent use of strict keys |

742 | |

743 | Average performance improvements across common API (with GHC 6.12.3): |

744 | |

745 | * Linux / x86_64 / 2.6Ghz i7 : 48% |

746 | * Mac OSX 10.5 / x86 / 2 Ghz Xeon : 36% |

747 | |

748 | Graphs and raw data: http://is.gd/eJHIE |

749 | |

750 | This patch is (mostly) orthogonal to the algorithmic changes suggested |

751 | by Milan Straka in his HW 2010 paper: |

752 | |

753 | http://research.microsoft.com/~simonpj/papers/containers/containers.pdf |

754 | |

755 | Those changes could be added separately, for some additional improvments. |

756 | |

757 | Work carried out over 28/29th August, 2010 in Utrecht, NL, by Johan Tibell |

758 | and Don Stewart. |

759 | |

760 | ] |

761 | [Add a criterion-based benchmark suite for Data.Map |

762 | Don Stewart <dons@galois.com>**20100829114611 |

763 | Ignore-this: ec61668f5bcb78bd15b72e2728c01c19 |

764 | |

765 | This adds a criterion-based micro-benchmarking suite for Data.Map. It |

766 | can be used to measure performance improvements for individual top-level |

767 | functions. |

768 | |

769 | Examples here: http://is.gd/eJHIE |

770 | |

771 | ] |

772 | [Add a comprehensive testsuite for Data.Map |

773 | Don Stewart <dons@galois.com>**20100829113545 |

774 | Ignore-this: 891e7fe6bac3523868714ac1ff51c0a3 |

775 | |

776 | This patch adds a joint quickcheck2 / hunit testsuite, with coverage of |

777 | 91% of top level functions (remaining features are mostly in instances). |

778 | |

779 | The coverage data is here: |

780 | |

781 | http://code.haskell.org/~dons/tests/containers/hpc_index.html |

782 | |

783 | No bugs were found. It includes unit tests for known past bugs |

784 | (balancing). |

785 | |

786 | ] |

787 | [Oops, get the #ifdef symbol correct. |

788 | Malcolm.Wallace@me.com**20100902081938] |

789 | [Protect a gratuitous GHC-ism with #ifdefs. |

790 | Malcolm.Wallace@me.com**20100902081217] |

791 | [Set Data.Map's delta to 4; fixes #4242 |

792 | Ian Lynagh <igloo@earth.li>**20100815131954] |

793 | [Add a test for #4242 |

794 | Ian Lynagh <igloo@earth.li>**20100815131856] |

795 | [Add a local type signature |

796 | simonpj@microsoft.com**20100730124447 |

797 | Ignore-this: b581d3f2c80a7a860456d589960f12f2 |

798 | ] |

799 | [Add type signature in local where clause |

800 | simonpj@microsoft.com**20100727151709 |

801 | Ignore-this: 5929c4156500b25b280eb414b508c508 |

802 | ] |

803 | [Fix Data.Sequence's breakr, and add a test for it; fixes trac #4157 |

804 | Ian Lynagh <igloo@earth.li>**20100704140627] |

805 | [Fix proposal #4109: Make Data.Map.insertWith's strictness consistent |

806 | Ian Lynagh <igloo@earth.li>**20100615133055] |

807 | [Tweak layout to work with the alternative layout rule |

808 | Ian Lynagh <igloo@earth.li>**20091129154519] |

809 | [Disable building Data.Sequence (and dependents) for nhc98. |

810 | Malcolm.Wallace@cs.york.ac.uk**20091124025653 |

811 | There is some subtlety of polymorphically recursive datatypes and |

812 | type-class defaulting that nhc98's type system barfs over. |

813 | ] |

814 | [Fix another instance of non-ghc breakage. |

815 | Malcolm.Wallace@cs.york.ac.uk**20091123092637] |

816 | [Add #ifdef around ghc-only (<$) as member of Functor class. |

817 | Malcolm.Wallace@cs.york.ac.uk**20091123085155] |

818 | [Fix broken code in non-GHC branch of an ifdef. |

819 | Malcolm.Wallace@cs.york.ac.uk**20091123084824] |

820 | [doc bugfix: correct description of index argument |

821 | Ross Paterson <ross@soi.city.ac.uk>**20091028105532 |

822 | Ignore-this: 9790e7bf422c4cb528722c03cfa4fed9 |

823 | |

824 | As noted by iaefai on the libraries list. |

825 | |

826 | Please merge to STABLE. |

827 | ] |

828 | [Bump version to 0.3.0.0 |

829 | Ian Lynagh <igloo@earth.li>**20090920141847] |

830 | [update base dependency |

831 | Ross Paterson <ross@soi.city.ac.uk>**20090916073125 |

832 | Ignore-this: ad382ffc6c6a18c15364e6c072f19edb |

833 | |

834 | The package uses mkNoRepType and Data.Functor, which were not in the |

835 | stable branch of base-4. |

836 | ] |

837 | [add fast version of <$ for Seq |

838 | Ross Paterson <ross@soi.city.ac.uk>**20090916072812 |

839 | Ignore-this: 5a39a7d31d39760ed589790b1118d240 |

840 | ] |

841 | [new methods for Data.Sequence (proposal #3271) |

842 | Ross Paterson <ross@soi.city.ac.uk>**20090915173324 |

843 | Ignore-this: cf17bedd709a6ab3448fd718dcdf62e7 |

844 | |

845 | Adds a lot of new methods to Data.Sequence, mostly paralleling those |

846 | in Data.List. Several of these are significantly faster than versions |

847 | implemented with the previous public interface. In particular, replicate |

848 | takes O(log n) time and space instead of O(n). |

849 | (by Louis Wasserman) |

850 | ] |

851 | [Fix "Cabal check" warnings |

852 | Ian Lynagh <igloo@earth.li>**20090811215900] |

853 | [TAG 2009-06-25 |

854 | Ian Lynagh <igloo@earth.li>**20090625160202] |

855 | Patch bundle hash: |

856 | 61be40493531581e7b58a84c449950a35392eeca |