# Ticket #4280: data-set-performance.dpatch

File data-set-performance.dpatch, 28.6 KB (added by , 9 years ago) |
---|

Line | |
---|---|

1 | 3 patches for repository http://darcs.haskell.org/libraries/containers: |

2 | |

3 | Tue Aug 31 14:40:30 CEST 2010 Johan Tibell <johan.tibell@gmail.com> |

4 | * Added a test suite for Data.Set |

5 | |

6 | Expression coverage: 74% |

7 | |

8 | Tue Aug 31 14:42:25 CEST 2010 Johan Tibell <johan.tibell@gmail.com> |

9 | * Added benchmarks for Data.Set |

10 | |

11 | Tue Aug 31 14:43:52 CEST 2010 Johan Tibell <johan.tibell@gmail.com> |

12 | * Improved performance of Data.Set |

13 | |

14 | Performance improvements are due to manually applying the |

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

16 | |

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

18 | |

19 | New patches: |

20 | |

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

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

23 | Ignore-this: f430dc302c0fcb8b5d62db2272a1d6f7 |

24 | |

25 | Expression coverage: 74% |

26 | ] { |

27 | hunk ./Data/Set.hs 39 |

28 | |

29 | module Data.Set ( |

30 | -- * Set type |

31 | +#if !defined(TESTING) |

32 | Set -- instance Eq,Ord,Show,Read,Data,Typeable |

33 | hunk ./Data/Set.hs 41 |

34 | +#else |

35 | + Set(..) |

36 | +#endif |

37 | |

38 | -- * Operators |

39 | , (\\) |

40 | hunk ./Data/Set.hs 106 |

41 | , showTree |

42 | , showTreeWith |

43 | , valid |

44 | + |

45 | +#if defined(TESTING) |

46 | + -- Internals (for testing) |

47 | + , bin |

48 | + , balanced |

49 | + , join |

50 | + , merge |

51 | +#endif |

52 | ) where |

53 | |

54 | import Prelude hiding (filter,foldr,null,map) |

55 | hunk ./Data/Set.hs 552 |

56 | showsPrec p xs = showParen (p > 10) $ |

57 | showString "fromList " . shows (toList xs) |

58 | |

59 | -{- |

60 | -XXX unused code |

61 | - |

62 | -showSet :: (Show a) => [a] -> ShowS |

63 | -showSet [] |

64 | - = showString "{}" |

65 | -showSet (x:xs) |

66 | - = showChar '{' . shows x . showTail xs |

67 | - where |

68 | - showTail [] = showChar '}' |

69 | - showTail (x':xs') = showChar ',' . shows x' . showTail xs' |

70 | --} |

71 | - |

72 | {-------------------------------------------------------------------- |

73 | Read |

74 | --------------------------------------------------------------------} |

75 | hunk ./Data/Set.hs 608 |

76 | _ -> trim cmplo cmphi l |

77 | _ -> trim cmplo cmphi r |

78 | |

79 | -{- |

80 | -XXX unused code |

81 | - |

82 | -trimMemberLo :: Ord a => a -> (a -> Ordering) -> Set a -> (Bool, Set a) |

83 | -trimMemberLo _ _ Tip = (False,Tip) |

84 | -trimMemberLo lo cmphi t@(Bin _ x l r) |

85 | - = case compare lo x of |

86 | - LT -> case cmphi x of |

87 | - GT -> (member lo t, t) |

88 | - _ -> trimMemberLo lo cmphi l |

89 | - GT -> trimMemberLo lo cmphi r |

90 | - EQ -> (True,trim (compare lo) cmphi r) |

91 | --} |

92 | - |

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

94 | [filterGt x t] filter all values >[x] from tree [t] |

95 | [filterLt x t] filter all values <[x] from tree [t] |

96 | hunk ./Data/Set.hs 1003 |

97 | Bin sz _ l r -> case (realsize l,realsize r) of |

98 | (Just n,Just m) | n+m+1 == sz -> Just sz |

99 | _ -> Nothing |

100 | - |

101 | -{- |

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

103 | - Testing |

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

105 | -testTree :: [Int] -> Set Int |

106 | -testTree xs = fromList xs |

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

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

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

110 | - |

111 | -{-------------------------------------------------------------------- |

112 | - QuickCheck |

113 | ---------------------------------------------------------------------} |

114 | -qcheck prop |

115 | - = check config prop |

116 | - where |

117 | - config = Config |

118 | - { configMaxTest = 500 |

119 | - , configMaxFail = 5000 |

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

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

122 | - } |

123 | - |

124 | - |

125 | -{-------------------------------------------------------------------- |

126 | - Arbitrary, reasonably balanced trees |

127 | ---------------------------------------------------------------------} |

128 | -instance (Enum a) => Arbitrary (Set a) where |

129 | - arbitrary = sized (arbtree 0 maxkey) |

130 | - where maxkey = 10000 |

131 | - |

132 | -arbtree :: (Enum a) => Int -> Int -> Int -> Gen (Set a) |

133 | -arbtree lo hi n |

134 | - | n <= 0 = return Tip |

135 | - | lo >= hi = return Tip |

136 | - | otherwise = do{ i <- choose (lo,hi) |

137 | - ; m <- choose (1,30) |

138 | - ; let (ml,mr) | m==(1::Int)= (1,2) |

139 | - | m==2 = (2,1) |

140 | - | m==3 = (1,1) |

141 | - | otherwise = (2,2) |

142 | - ; l <- arbtree lo (i-1) (n `div` ml) |

143 | - ; r <- arbtree (i+1) hi (n `div` mr) |

144 | - ; return (bin (toEnum i) l r) |

145 | - } |

146 | - |

147 | - |

148 | -{-------------------------------------------------------------------- |

149 | - Valid tree's |

150 | ---------------------------------------------------------------------} |

151 | -forValid :: (Enum a,Show a,Testable b) => (Set a -> b) -> Property |

152 | -forValid f |

153 | - = forAll arbitrary $ \t -> |

154 | --- classify (balanced t) "balanced" $ |

155 | - classify (size t == 0) "empty" $ |

156 | - classify (size t > 0 && size t <= 10) "small" $ |

157 | - classify (size t > 10 && size t <= 64) "medium" $ |

158 | - classify (size t > 64) "large" $ |

159 | - balanced t ==> f t |

160 | - |

161 | -forValidIntTree :: Testable a => (Set Int -> a) -> Property |

162 | -forValidIntTree f |

163 | - = forValid f |

164 | - |

165 | -forValidUnitTree :: Testable a => (Set Int -> a) -> Property |

166 | -forValidUnitTree f |

167 | - = forValid f |

168 | - |

169 | - |

170 | -prop_Valid |

171 | - = forValidUnitTree $ \t -> valid t |

172 | - |

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

174 | - Single, Insert, Delete |

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

176 | -prop_Single :: Int -> Bool |

177 | -prop_Single x |

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

179 | - |

180 | -prop_InsertValid :: Int -> Property |

181 | -prop_InsertValid k |

182 | - = forValidUnitTree $ \t -> valid (insert k t) |

183 | - |

184 | -prop_InsertDelete :: Int -> Set Int -> Property |

185 | -prop_InsertDelete k t |

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

187 | - |

188 | -prop_DeleteValid :: Int -> Property |

189 | -prop_DeleteValid k |

190 | - = forValidUnitTree $ \t -> |

191 | - valid (delete k (insert k t)) |

192 | - |

193 | -{-------------------------------------------------------------------- |

194 | - Balance |

195 | ---------------------------------------------------------------------} |

196 | -prop_Join :: Int -> Property |

197 | -prop_Join x |

198 | - = forValidUnitTree $ \t -> |

199 | - let (l,r) = split x t |

200 | - in valid (join x l r) |

201 | - |

202 | -prop_Merge :: Int -> Property |

203 | -prop_Merge x |

204 | - = forValidUnitTree $ \t -> |

205 | - let (l,r) = split x t |

206 | - in valid (merge l r) |

207 | - |

208 | - |

209 | -{-------------------------------------------------------------------- |

210 | - Union |

211 | ---------------------------------------------------------------------} |

212 | -prop_UnionValid :: Property |

213 | -prop_UnionValid |

214 | - = forValidUnitTree $ \t1 -> |

215 | - forValidUnitTree $ \t2 -> |

216 | - valid (union t1 t2) |

217 | - |

218 | -prop_UnionInsert :: Int -> Set Int -> Bool |

219 | -prop_UnionInsert x t |

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

221 | - |

222 | -prop_UnionAssoc :: Set Int -> Set Int -> Set Int -> Bool |

223 | -prop_UnionAssoc t1 t2 t3 |

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

225 | - |

226 | -prop_UnionComm :: Set Int -> Set Int -> Bool |

227 | -prop_UnionComm t1 t2 |

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

229 | - |

230 | - |

231 | -prop_DiffValid |

232 | - = forValidUnitTree $ \t1 -> |

233 | - forValidUnitTree $ \t2 -> |

234 | - valid (difference t1 t2) |

235 | - |

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

237 | -prop_Diff xs ys |

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

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

240 | - |

241 | -prop_IntValid |

242 | - = forValidUnitTree $ \t1 -> |

243 | - forValidUnitTree $ \t2 -> |

244 | - valid (intersection t1 t2) |

245 | - |

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

247 | -prop_Int xs ys |

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

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

250 | - |

251 | -{-------------------------------------------------------------------- |

252 | - Lists |

253 | ---------------------------------------------------------------------} |

254 | -prop_Ordered |

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

256 | - let xs = [0..n::Int] |

257 | - in fromAscList xs == fromList xs |

258 | - |

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

260 | -prop_List xs |

261 | - = (sort (nub xs) == toList (fromList xs)) |

262 | --} |

263 | addfile ./tests/Set.hs |

264 | hunk ./tests/Set.hs 1 |

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

266 | + |

267 | +-- QuickCheck properties for Data.Set |

268 | +-- > ghc -DTESTING -fforce-recomp -O2 --make -fhpc -i.. Set.hs |

269 | + |

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

271 | +import qualified Data.List as List |

272 | +import Data.Set |

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

274 | +import Test.QuickCheck |

275 | + |

276 | +main :: IO () |

277 | +main = do |

278 | + q $ label "prop_Valid" prop_Valid |

279 | + q $ label "prop_Single" prop_Single |

280 | + q $ label "prop_Single" prop_Single |

281 | + q $ label "prop_InsertValid" prop_InsertValid |

282 | + q $ label "prop_InsertValid" prop_InsertValid |

283 | + q $ label "prop_InsertDelete" prop_InsertDelete |

284 | + q $ label "prop_InsertDelete" prop_InsertDelete |

285 | + q $ label "prop_DeleteValid" prop_DeleteValid |

286 | + q $ label "prop_DeleteValid" prop_DeleteValid |

287 | + q $ label "prop_Join" prop_Join |

288 | + q $ label "prop_Join" prop_Join |

289 | + q $ label "prop_Merge" prop_Merge |

290 | + q $ label "prop_Merge" prop_Merge |

291 | + q $ label "prop_UnionValid" prop_UnionValid |

292 | + q $ label "prop_UnionValid" prop_UnionValid |

293 | + q $ label "prop_UnionInsert" prop_UnionInsert |

294 | + q $ label "prop_UnionInsert" prop_UnionInsert |

295 | + q $ label "prop_UnionAssoc" prop_UnionAssoc |

296 | + q $ label "prop_UnionAssoc" prop_UnionAssoc |

297 | + q $ label "prop_UnionComm" prop_UnionComm |

298 | + q $ label "prop_UnionComm" prop_UnionComm |

299 | + q $ label "prop_DiffValid" prop_DiffValid |

300 | + q $ label "prop_Diff" prop_Diff |

301 | + q $ label "prop_Diff" prop_Diff |

302 | + q $ label "prop_IntValid" prop_IntValid |

303 | + q $ label "prop_Int" prop_Int |

304 | + q $ label "prop_Int" prop_Int |

305 | + q $ label "prop_Ordered" prop_Ordered |

306 | + q $ label "prop_List" prop_List |

307 | + q $ label "prop_List" prop_List |

308 | + where |

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

310 | + q = quickCheckWith args |

311 | + |

312 | +{-------------------------------------------------------------------- |

313 | + QuickCheck |

314 | +--------------------------------------------------------------------} |

315 | + |

316 | +args :: Args |

317 | +args = stdArgs { maxSuccess = 500 |

318 | + , maxDiscard = 500 |

319 | + } |

320 | + |

321 | +{-------------------------------------------------------------------- |

322 | + Arbitrary, reasonably balanced trees |

323 | +--------------------------------------------------------------------} |

324 | +instance (Enum a) => Arbitrary (Set a) where |

325 | + arbitrary = sized (arbtree 0 maxkey) |

326 | + where maxkey = 10000 |

327 | + |

328 | +arbtree :: (Enum a) => Int -> Int -> Int -> Gen (Set a) |

329 | +arbtree lo hi n |

330 | + | n <= 0 = return Tip |

331 | + | lo >= hi = return Tip |

332 | + | otherwise = do i <- choose (lo,hi) |

333 | + m <- choose (1,30) |

334 | + let (ml,mr) | m==(1::Int) = (1,2) |

335 | + | m==2 = (2,1) |

336 | + | m==3 = (1,1) |

337 | + | otherwise = (2,2) |

338 | + l <- arbtree lo (i-1) (n `div` ml) |

339 | + r <- arbtree (i+1) hi (n `div` mr) |

340 | + return (bin (toEnum i) l r) |

341 | + |

342 | +{-------------------------------------------------------------------- |

343 | + Valid tree's |

344 | +--------------------------------------------------------------------} |

345 | +forValid :: (Enum a,Show a,Testable b) => (Set a -> b) -> Property |

346 | +forValid f = forAll arbitrary $ \t -> |

347 | +-- classify (balanced t) "balanced" $ |

348 | + classify (size t == 0) "empty" $ |

349 | + classify (size t > 0 && size t <= 10) "small" $ |

350 | + classify (size t > 10 && size t <= 64) "medium" $ |

351 | + classify (size t > 64) "large" $ |

352 | + balanced t ==> f t |

353 | + |

354 | +forValidUnitTree :: Testable a => (Set Int -> a) -> Property |

355 | +forValidUnitTree f = forValid f |

356 | + |

357 | +prop_Valid :: Property |

358 | +prop_Valid = forValidUnitTree $ \t -> valid t |

359 | + |

360 | +{-------------------------------------------------------------------- |

361 | + Single, Insert, Delete |

362 | +--------------------------------------------------------------------} |

363 | +prop_Single :: Int -> Bool |

364 | +prop_Single x = (insert x empty == singleton x) |

365 | + |

366 | +prop_InsertValid :: Int -> Property |

367 | +prop_InsertValid k = forValidUnitTree $ \t -> valid (insert k t) |

368 | + |

369 | +prop_InsertDelete :: Int -> Set Int -> Property |

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

371 | + |

372 | +prop_DeleteValid :: Int -> Property |

373 | +prop_DeleteValid k = forValidUnitTree $ \t -> valid (delete k (insert k t)) |

374 | + |

375 | +{-------------------------------------------------------------------- |

376 | + Balance |

377 | +--------------------------------------------------------------------} |

378 | +prop_Join :: Int -> Property |

379 | +prop_Join x = forValidUnitTree $ \t -> |

380 | + let (l,r) = split x t |

381 | + in valid (join x l r) |

382 | + |

383 | +prop_Merge :: Int -> Property |

384 | +prop_Merge x = forValidUnitTree $ \t -> |

385 | + let (l,r) = split x t |

386 | + in valid (merge l r) |

387 | + |

388 | +{-------------------------------------------------------------------- |

389 | + Union |

390 | +--------------------------------------------------------------------} |

391 | +prop_UnionValid :: Property |

392 | +prop_UnionValid |

393 | + = forValidUnitTree $ \t1 -> |

394 | + forValidUnitTree $ \t2 -> |

395 | + valid (union t1 t2) |

396 | + |

397 | +prop_UnionInsert :: Int -> Set Int -> Bool |

398 | +prop_UnionInsert x t = union t (singleton x) == insert x t |

399 | + |

400 | +prop_UnionAssoc :: Set Int -> Set Int -> Set Int -> Bool |

401 | +prop_UnionAssoc t1 t2 t3 = union t1 (union t2 t3) == union (union t1 t2) t3 |

402 | + |

403 | +prop_UnionComm :: Set Int -> Set Int -> Bool |

404 | +prop_UnionComm t1 t2 = (union t1 t2 == union t2 t1) |

405 | + |

406 | +prop_DiffValid :: Property |

407 | +prop_DiffValid = forValidUnitTree $ \t1 -> |

408 | + forValidUnitTree $ \t2 -> |

409 | + valid (difference t1 t2) |

410 | + |

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

412 | +prop_Diff xs ys = toAscList (difference (fromList xs) (fromList ys)) |

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

414 | + |

415 | +prop_IntValid :: Property |

416 | +prop_IntValid = forValidUnitTree $ \t1 -> |

417 | + forValidUnitTree $ \t2 -> |

418 | + valid (intersection t1 t2) |

419 | + |

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

421 | +prop_Int xs ys = toAscList (intersection (fromList xs) (fromList ys)) |

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

423 | + |

424 | +{-------------------------------------------------------------------- |

425 | + Lists |

426 | +--------------------------------------------------------------------} |

427 | +prop_Ordered :: Property |

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

429 | + let xs = [0..n::Int] |

430 | + in fromAscList xs == fromList xs |

431 | + |

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

433 | +prop_List xs = (sort (nub xs) == toList (fromList xs)) |

434 | } |

435 | [Added benchmarks for Data.Set |

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

437 | Ignore-this: fcacf88761034b8c534d936f0b336cc0 |

438 | ] { |

439 | adddir ./benchmarks |

440 | addfile ./benchmarks/Set.hs |

441 | hunk ./benchmarks/Set.hs 1 |

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

443 | + |

444 | +-- > ghc -DTESTING --make -O2 -fforce-recomp -i.. Set.hs |

445 | +module Main where |

446 | + |

447 | +import Control.DeepSeq |

448 | +import Control.Exception (evaluate) |

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

450 | +import Criterion.Config |

451 | +import Criterion.Main |

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

453 | +import qualified Data.Set as S |

454 | + |

455 | +instance NFData a => NFData (S.Set a) where |

456 | + rnf S.Tip = () |

457 | + rnf (S.Bin _ a l r) = rnf a `seq` rnf l `seq` rnf r |

458 | + |

459 | +main = do |

460 | + let s = S.fromAscList elems :: S.Set Int |

461 | + s2 = S.fromAscList [-1, -2 .. -(2^10)] :: S.Set Int |

462 | + defaultMainWith |

463 | + defaultConfig |

464 | + (liftIO . evaluate $ rnf [s, s2]) |

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

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

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

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

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

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

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

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

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

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

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

476 | + , bench "unions" $ nf S.unions [s, s2] |

477 | + , bench "union" $ nf (S.union s) s2 |

478 | + ] |

479 | + where |

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

481 | + |

482 | +member :: [Int] -> S.Set Int -> Int |

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

484 | + |

485 | +ins :: [Int] -> S.Set Int -> S.Set Int |

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

487 | + |

488 | +del :: [Int] -> S.Set Int -> S.Set Int |

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

490 | } |

491 | [Improved performance of Data.Set |

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

493 | Ignore-this: 38a304a0408d29a2956aa9a1fc0ce755 |

494 | |

495 | Performance improvements are due to manually applying the |

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

497 | |

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

499 | ] { |

500 | hunk ./Data/Set.hs 23 |

501 | -- trees of /bounded balance/) as described by: |

502 | -- |

503 | -- * Stephen Adams, \"/Efficient sets: a balancing act/\", |

504 | --- Journal of Functional Programming 3(4):553-562, October 1993, |

505 | --- <http://www.swiss.ai.mit.edu/~adams/BB/>. |

506 | +-- Journal of Functional Programming 3(4):553-562, October 1993, |

507 | +-- <http://www.swiss.ai.mit.edu/~adams/BB/>. |

508 | -- |

509 | -- * J. Nievergelt and E.M. Reingold, |

510 | hunk ./Data/Set.hs 27 |

511 | --- \"/Binary search trees of bounded balance/\", |

512 | --- SIAM journal of computing 2(1), March 1973. |

513 | +-- \"/Binary search trees of bounded balance/\", |

514 | +-- SIAM journal of computing 2(1), March 1973. |

515 | -- |

516 | -- Note that the implementation is /left-biased/ -- the elements of a |

517 | -- first argument are always preferred to the second, for example in |

518 | hunk ./Data/Set.hs 63 |

519 | , delete |

520 | |

521 | -- * Combine |

522 | - , union, unions |

523 | + , union |

524 | + , unions |

525 | , difference |

526 | , intersection |

527 | |

528 | hunk ./Data/Set.hs 75 |

529 | , splitMember |

530 | |

531 | -- * Map |

532 | - , map |

533 | - , mapMonotonic |

534 | + , map |

535 | + , mapMonotonic |

536 | |

537 | -- * Fold |

538 | , fold |

539 | hunk ./Data/Set.hs 146 |

540 | -- | /O(n+m)/. See 'difference'. |

541 | (\\) :: Ord a => Set a -> Set a -> Set a |

542 | m1 \\ m2 = difference m1 m2 |

543 | +{-# INLINE (\\) #-} |

544 | |

545 | {-------------------------------------------------------------------- |

546 | Sets are size balanced trees |

547 | hunk ./Data/Set.hs 189 |

548 | --------------------------------------------------------------------} |

549 | -- | /O(1)/. Is this the empty set? |

550 | null :: Set a -> Bool |

551 | -null t |

552 | - = case t of |

553 | - Tip -> True |

554 | - Bin {} -> False |

555 | +null Tip = True |

556 | +null (Bin {}) = False |

557 | +{-# INLINE null #-} |

558 | |

559 | -- | /O(1)/. The number of elements in the set. |

560 | size :: Set a -> Int |

561 | hunk ./Data/Set.hs 195 |

562 | -size t |

563 | - = case t of |

564 | - Tip -> 0 |

565 | - Bin sz _ _ _ -> sz |

566 | +size = go |

567 | + where |

568 | + go Tip = 0 |

569 | + go (Bin sz _ _ _) = sz |

570 | +{-# INLINE size #-} |

571 | |

572 | -- | /O(log n)/. Is the element in the set? |

573 | member :: Ord a => a -> Set a -> Bool |

574 | hunk ./Data/Set.hs 203 |

575 | -member x t |

576 | - = case t of |

577 | - Tip -> False |

578 | - Bin _ y l r |

579 | - -> case compare x y of |

580 | - LT -> member x l |

581 | - GT -> member x r |

582 | - EQ -> True |

583 | - |

584 | +member x = x `seq` go |

585 | + where |

586 | + go Tip = False |

587 | + go (Bin _ y l r) = case compare x y of |

588 | + LT -> go l |

589 | + GT -> go r |

590 | + EQ -> True |

591 | +{-# INLINE member #-} |

592 | + |

593 | -- | /O(log n)/. Is the element not in the set? |

594 | notMember :: Ord a => a -> Set a -> Bool |

595 | hunk ./Data/Set.hs 214 |

596 | -notMember x t = not $ member x t |

597 | +notMember a t = not $ member a t |

598 | +{-# INLINE notMember #-} |

599 | |

600 | {-------------------------------------------------------------------- |

601 | Construction |

602 | hunk ./Data/Set.hs 222 |

603 | --------------------------------------------------------------------} |

604 | -- | /O(1)/. The empty set. |

605 | empty :: Set a |

606 | -empty |

607 | - = Tip |

608 | +empty = Tip |

609 | +{-# INLINE empty #-} |

610 | |

611 | -- | /O(1)/. Create a singleton set. |

612 | singleton :: a -> Set a |

613 | hunk ./Data/Set.hs 227 |

614 | -singleton x |

615 | - = Bin 1 x Tip Tip |

616 | +singleton x = Bin 1 x Tip Tip |

617 | +{-# INLINE singleton #-} |

618 | |

619 | {-------------------------------------------------------------------- |

620 | Insertion, Deletion |

621 | hunk ./Data/Set.hs 237 |

622 | -- If the set already contains an element equal to the given value, |

623 | -- it is replaced with the new value. |

624 | insert :: Ord a => a -> Set a -> Set a |

625 | -insert x t |

626 | - = case t of |

627 | - Tip -> singleton x |

628 | - Bin sz y l r |

629 | - -> case compare x y of |

630 | - LT -> balance y (insert x l) r |

631 | - GT -> balance y l (insert x r) |

632 | - EQ -> Bin sz x l r |

633 | - |

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

635 | + where |

636 | + go Tip = singleton x |

637 | + go (Bin sz y l r) = case compare x y of |

638 | + LT -> balance y (go l) r |

639 | + GT -> balance y l (go r) |

640 | + EQ -> Bin sz x l r |

641 | +{-# INLINE insert #-} |

642 | |

643 | -- | /O(log n)/. Delete an element from a set. |

644 | delete :: Ord a => a -> Set a -> Set a |

645 | hunk ./Data/Set.hs 248 |

646 | -delete x t |

647 | - = case t of |

648 | - Tip -> Tip |

649 | - Bin _ y l r |

650 | - -> case compare x y of |

651 | - LT -> balance y (delete x l) r |

652 | - GT -> balance y l (delete x r) |

653 | - EQ -> glue l r |

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

655 | + where |

656 | + go Tip = Tip |

657 | + go (Bin _ y l r) = case compare x y of |

658 | + LT -> balance y (go l) r |

659 | + GT -> balance y l (go r) |

660 | + EQ -> glue l r |

661 | +{-# INLINE delete #-} |

662 | |

663 | {-------------------------------------------------------------------- |

664 | Subset |

665 | hunk ./Data/Set.hs 308 |

666 | deleteMax (Bin _ x l r) = balance x l (deleteMax r) |

667 | deleteMax Tip = Tip |

668 | |

669 | - |

670 | {-------------------------------------------------------------------- |

671 | Union. |

672 | --------------------------------------------------------------------} |

673 | hunk ./Data/Set.hs 313 |

674 | -- | The union of a list of sets: (@'unions' == 'foldl' 'union' 'empty'@). |

675 | unions :: Ord a => [Set a] -> Set a |

676 | -unions ts |

677 | - = foldlStrict union empty ts |

678 | - |

679 | +unions = foldlStrict union empty |

680 | +{-# INLINE unions #-} |

681 | |

682 | -- | /O(n+m)/. The union of two sets, preferring the first set when |

683 | -- equal elements are encountered. |

684 | hunk ./Data/Set.hs 324 |

685 | union Tip t2 = t2 |

686 | union t1 Tip = t1 |

687 | union t1 t2 = hedgeUnion (const LT) (const GT) t1 t2 |

688 | +{-# INLINE union #-} |

689 | |

690 | hedgeUnion :: Ord a |

691 | => (a -> Ordering) -> (a -> Ordering) -> Set a -> Set a -> Set a |

692 | hunk ./Data/Set.hs 347 |

693 | difference Tip _ = Tip |

694 | difference t1 Tip = t1 |

695 | difference t1 t2 = hedgeDiff (const LT) (const GT) t1 t2 |

696 | +{-# INLINE difference #-} |

697 | |

698 | hedgeDiff :: Ord a |

699 | => (a -> Ordering) -> (a -> Ordering) -> Set a -> Set a -> Set a |

700 | hunk ./Data/Set.hs 397 |

701 | --------------------------------------------------------------------} |

702 | -- | /O(n)/. Filter all elements that satisfy the predicate. |

703 | filter :: Ord a => (a -> Bool) -> Set a -> Set a |

704 | -filter _ Tip = Tip |

705 | -filter p (Bin _ x l r) |

706 | - | p x = join x (filter p l) (filter p r) |

707 | - | otherwise = merge (filter p l) (filter p r) |

708 | +filter p = go |

709 | + where |

710 | + go Tip = Tip |

711 | + go (Bin _ x l r) |

712 | + | p x = join x (go l) (go r) |

713 | + | otherwise = merge (go l) (go r) |

714 | +{-# INLINE filter #-} |

715 | |

716 | -- | /O(n)/. Partition the set into two sets, one with all elements that satisfy |

717 | -- the predicate and one with all elements that don't satisfy the predicate. |

718 | hunk ./Data/Set.hs 409 |

719 | -- See also 'split'. |

720 | partition :: Ord a => (a -> Bool) -> Set a -> (Set a,Set a) |

721 | -partition _ Tip = (Tip,Tip) |

722 | -partition p (Bin _ x l r) |

723 | - | p x = (join x l1 r1,merge l2 r2) |

724 | - | otherwise = (merge l1 r1,join x l2 r2) |

725 | +partition p = go |

726 | where |

727 | hunk ./Data/Set.hs 411 |

728 | - (l1,l2) = partition p l |

729 | - (r1,r2) = partition p r |

730 | + go Tip = (Tip, Tip) |

731 | + go (Bin _ x l r) = case (go l, go r) of |

732 | + ((l1, l2), (r1, r2)) |

733 | + | p x -> (join x l1 r1, merge l2 r2) |

734 | + | otherwise -> (merge l1 r1, join x l2 r2) |

735 | +{-# INLINE partition #-} |

736 | |

737 | {---------------------------------------------------------------------- |

738 | Map |

739 | hunk ./Data/Set.hs 430 |

740 | |

741 | map :: (Ord a, Ord b) => (a->b) -> Set a -> Set b |

742 | map f = fromList . List.map f . toList |

743 | +{-# INLINE map #-} |

744 | |

745 | -- | /O(n)/. The |

746 | -- |

747 | hunk ./Data/Set.hs 443 |

748 | -- > where ls = toList s |

749 | |

750 | mapMonotonic :: (a->b) -> Set a -> Set b |

751 | -mapMonotonic _ Tip = Tip |

752 | -mapMonotonic f (Bin sz x l r) = |

753 | - Bin sz (f x) (mapMonotonic f l) (mapMonotonic f r) |

754 | - |

755 | +mapMonotonic f = go |

756 | + where |

757 | + go Tip = Tip |

758 | + go (Bin sz x l r) = Bin sz (f x) (go l) (go r) |

759 | +{-# INLINE mapMonotonic #-} |

760 | |

761 | {-------------------------------------------------------------------- |

762 | Fold |

763 | hunk ./Data/Set.hs 454 |

764 | --------------------------------------------------------------------} |

765 | -- | /O(n)/. Fold over the elements of a set in an unspecified order. |

766 | fold :: (a -> b -> b) -> b -> Set a -> b |

767 | -fold f z s |

768 | - = foldr f z s |

769 | +fold = foldr |

770 | +{-# INLINE fold #-} |

771 | |

772 | -- | /O(n)/. Post-order fold. |

773 | foldr :: (a -> b -> b) -> b -> Set a -> b |

774 | hunk ./Data/Set.hs 459 |

775 | -foldr _ z Tip = z |

776 | -foldr f z (Bin _ x l r) = foldr f (f x (foldr f z r)) l |

777 | +foldr f = go |

778 | + where |

779 | + go z Tip = z |

780 | + go z (Bin _ x l r) = go (f x (go z r)) l |

781 | +{-# INLINE foldr #-} |

782 | |

783 | {-------------------------------------------------------------------- |

784 | List variations |

785 | hunk ./Data/Set.hs 470 |

786 | --------------------------------------------------------------------} |

787 | -- | /O(n)/. The elements of a set. |

788 | elems :: Set a -> [a] |

789 | -elems s |

790 | - = toList s |

791 | +elems = toList |

792 | +{-# INLINE elems #-} |

793 | |

794 | {-------------------------------------------------------------------- |

795 | Lists |

796 | hunk ./Data/Set.hs 478 |

797 | --------------------------------------------------------------------} |

798 | -- | /O(n)/. Convert the set to a list of elements. |

799 | toList :: Set a -> [a] |

800 | -toList s |

801 | - = toAscList s |

802 | +toList = toAscList |

803 | +{-# INLINE toList #-} |

804 | |

805 | -- | /O(n)/. Convert the set to an ascending list of elements. |

806 | toAscList :: Set a -> [a] |

807 | hunk ./Data/Set.hs 483 |

808 | -toAscList t |

809 | - = foldr (:) [] t |

810 | - |

811 | +toAscList = foldr (:) [] |

812 | +{-# INLINE toAscList #-} |

813 | |

814 | -- | /O(n*log n)/. Create a set from a list of elements. |

815 | fromList :: Ord a => [a] -> Set a |

816 | hunk ./Data/Set.hs 488 |

817 | -fromList xs |

818 | - = foldlStrict ins empty xs |

819 | +fromList = foldlStrict ins empty |

820 | where |

821 | ins t x = insert x t |

822 | hunk ./Data/Set.hs 491 |

823 | +{-# INLINE fromList #-} |

824 | |

825 | {-------------------------------------------------------------------- |

826 | Building trees from ascending/descending lists can be done in linear time. |

827 | hunk ./Data/Set.hs 629 |

828 | LT -> join x (filterGt cmp l) r |

829 | GT -> filterGt cmp r |

830 | EQ -> r |

831 | +{-# INLINE filterGt #-} |

832 | |

833 | filterLt :: (a -> Ordering) -> Set a -> Set a |

834 | filterLt _ Tip = Tip |

835 | hunk ./Data/Set.hs 638 |

836 | LT -> filterLt cmp l |

837 | GT -> join x l (filterLt cmp r) |

838 | EQ -> l |

839 | - |

840 | +{-# INLINE filterLt #-} |

841 | |

842 | {-------------------------------------------------------------------- |

843 | Split |

844 | hunk ./Data/Set.hs 880 |

845 | Utilities |

846 | --------------------------------------------------------------------} |

847 | foldlStrict :: (a -> b -> a) -> a -> [b] -> a |

848 | -foldlStrict f z xs |

849 | - = case xs of |

850 | - [] -> z |

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

852 | - |

853 | +foldlStrict f = go |

854 | + where |

855 | + go z [] = z |

856 | + go z (x:xs) = z `seq` go (f z x) xs |

857 | +{-# INLINE foldlStrict #-} |

858 | |

859 | {-------------------------------------------------------------------- |

860 | Debugging |

861 | } |

862 | |

863 | Context: |

864 | |

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

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

867 | [Add a test for #4242 |

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

869 | [Add a local type signature |

870 | simonpj@microsoft.com**20100730124447 |

871 | Ignore-this: b581d3f2c80a7a860456d589960f12f2 |

872 | ] |

873 | [Add type signature in local where clause |

874 | simonpj@microsoft.com**20100727151709 |

875 | Ignore-this: 5929c4156500b25b280eb414b508c508 |

876 | ] |

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

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

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

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

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

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

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

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

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

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

887 | ] |

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

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

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

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

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

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

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

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

896 | Ignore-this: 9790e7bf422c4cb528722c03cfa4fed9 |

897 | |

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

899 | |

900 | Please merge to STABLE. |

901 | ] |

902 | [Bump version to 0.3.0.0 |

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

904 | [update base dependency |

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

906 | Ignore-this: ad382ffc6c6a18c15364e6c072f19edb |

907 | |

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

909 | stable branch of base-4. |

910 | ] |

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

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

913 | Ignore-this: 5a39a7d31d39760ed589790b1118d240 |

914 | ] |

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

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

917 | Ignore-this: cf17bedd709a6ab3448fd718dcdf62e7 |

918 | |

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

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

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

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

923 | (by Louis Wasserman) |

924 | ] |

925 | [Fix "Cabal check" warnings |

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

927 | [TAG 2009-06-25 |

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

929 | Patch bundle hash: |

930 | b73422ae705452c11a8537f62057117e73c9c6f0 |