API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Jul 18th, 2019
85
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 14.57 KB | None | 0 0
raw download clone embed print report
  1. -- ghc -O2 -hide-package containers IntMapFAL.hs && ./IntMapFAL --small | tee IntMapFAL.out
  2.  
  3. {-# LANGUAGE BangPatterns #-}
  4. {-# LANGUAGE RankNTypes #-}
  5.  
  6. import Control.DeepSeq (rnf)
  7. import Control.Exception (evaluate)
  8. import Gauge (bench, bgroup, env, defaultMain, whnf)
  9. import Data.List (foldl')
  10. import qualified Data.IntMap as M
  11. import qualified Data.IntMap.Strict as MS
  12. import Data.Maybe (fromMaybe)
  13. import Prelude hiding (lookup)
  14.  
  15. import GHC.Exts (inline)
  16.  
  17. import Data.IntMap.Internal (IntMap (..), Prefix, Mask, Key, size, link, branchMask, mask, shorter, nomatch, zero)
  18. import qualified Data.IntMap.Internal as I
  19.  
  20. main = do
  21. defaultMain $ [test (s*sz) sk |
  22. sz <- [10^i | i <- [0..5]],
  23. (s, sk) <- if sz == 1 then [(1,1)] else [(1,1), (-1,51791)]]
  24.  
  25. test sz sk =
  26. env (let m = M.fromAscList elems :: M.IntMap Int in evaluate $ rnf [m]) $ \m -> bgroup n
  27. [ bench "fromList" $ whnf M.fromList elems
  28. , bench "fromList1" $ whnf fromList1 elems
  29. , bench "fromAscList" $ whnf M.fromAscList elems
  30. , bench "fromAscList1" $ whnf fromAscList1 elems
  31. , bench "fromAscList1a" $ whnf fromAscList1a elems
  32. , bench "fromAscList1b" $ whnf fromAscList1b elems
  33. , bench "fromDistinctAscList" $ whnf M.fromDistinctAscList elems
  34. , bench "fromDistinctAscList1" $ whnf fromDistinctAscList1 elems
  35. , bench "fromDistinctAscList1a" $ whnf fromDistinctAscList1a elems
  36. , bench "fromDistinctAscList1b" $ whnf fromDistinctAscList1b elems
  37. , bench "fromDistinctAscList1c" $ whnf fromDistinctAscList1c elems
  38. , bench "fromDistinctAscList1d" $ whnf fromDistinctAscList1d elems
  39. , bench "fromDistinctAscList1e" $ whnf fromDistinctAscList1e elems
  40. ]
  41. where
  42. n = "[" ++ show sz ++ "," ++ show sk ++ "]"
  43. elems = zip keys values
  44. keys = map (sk*) (if sz < 0 then [2*sz `div` 3.. -sz `div` 3] else [0..sz])
  45. values = [1..]
  46.  
  47. data Inserted a = Inserted !(IntMap a) ![(Key,a)]
  48.  
  49. fromDistinctAscList1 :: [(Key,a)] -> IntMap a
  50. fromDistinctAscList1 [] = Nil
  51. fromDistinctAscList1 ((kx,vx) : zs0) = addAll kx (Tip kx vx) zs0
  52. where
  53. -- invariant for `addAll` and `addMany`: `kx` is a key in the map `tx`.
  54. addAll !kx !tx []
  55. = tx
  56. addAll !kx !tx ((ky,vy) : zs)
  57. | m <- branchMask kx ky
  58. , Inserted ty zs' <- addMany m ky (Tip ky vy) zs
  59. = addAll kx (link ky ty kx tx) zs'
  60.  
  61. -- addMany adds all elements that have the same prefix as `kx` w.r.t.
  62. -- the branch mask `m` to `tx`.
  63. addMany !m !kx tx []
  64. = Inserted tx []
  65. addMany !m !kx tx zs0@((ky,vy) : zs)
  66. | mask kx m /= mask ky m
  67. = Inserted tx zs0
  68. | Inserted ty zs' <- addMany (branchMask kx ky) ky (Tip ky vy) zs
  69. = addMany m kx (link ky ty kx tx) zs'
  70.  
  71. fromDistinctAscList1a :: [(Key,a)] -> IntMap a
  72. fromDistinctAscList1a [] = Nil
  73. fromDistinctAscList1a ((kx,vx) : zs0) = addAll kx (Tip kx vx) zs0
  74. where
  75. -- invariant for `addAll` and `addMany`: `kx` is a key in the map `tx`.
  76. addAll !kx tx []
  77. = tx
  78. addAll !kx tx ((ky,vy) : zs)
  79. | m <- branchMask kx ky
  80. , Inserted ty zs' <- addMany m ky (Tip ky vy) zs
  81. = addAll kx (link ky ty kx tx) zs'
  82.  
  83. -- addMany adds all elements that have the same prefix as `kx` w.r.t.
  84. -- the branch mask `m` to `tx`.
  85. addMany !m !kx tx []
  86. = Inserted tx []
  87. addMany !m !kx tx zs0@((ky,vy) : zs)
  88. | mask kx m /= mask ky m
  89. = Inserted tx zs0
  90. | m' <- branchMask kx ky
  91. , Inserted ty zs' <- addMany m' ky (Tip ky vy) zs
  92. = addMany m kx (Bin (mask kx m') m' tx ty) zs'
  93.  
  94. fromDistinctAscList1b :: [(Key,a)] -> IntMap a
  95. fromDistinctAscList1b [] = Nil
  96. fromDistinctAscList1b ((kx,vx) : zs1) = addAll' kx vx zs1
  97. where
  98. addAll' !kx vx [] = inline addAll kx (Tip kx vx) []
  99. addAll' !kx vx ((ky,vy) : zs) = inline addAll kx (Tip kx vx) ((ky,vy) : zs)
  100.  
  101. -- invariant for `addAll` and `addMany`: `kx` is a key in the map `tx`.
  102. addAll !kx !tx []
  103. = tx
  104. addAll !kx !tx ((ky,vy) : zs)
  105. | m <- branchMask kx ky
  106. , Inserted ty zs' <- addMany' m ky vy zs
  107. = addAll kx (link ky ty kx tx) zs'
  108.  
  109. addMany' !m !kx vx [] = inline addMany m kx (Tip kx vx) []
  110. addMany' !m !kx vx ((ky,vy) : zs) = inline addMany m kx (Tip kx vx) ((ky,vy) : zs)
  111.  
  112. -- addMany adds all elements that have the same prefix as `kx` w.r.t.
  113. -- the branch mask `m` to `tx`.
  114. addMany !m !kx tx []
  115. = Inserted tx []
  116. addMany !m !kx tx zs0@((ky,vy) : zs)
  117. | mask kx m /= mask ky m
  118. = Inserted tx zs0
  119. | Inserted ty zs' <- addMany' (branchMask kx ky) ky vy zs
  120. = addMany m kx (link ky ty kx tx) zs'
  121.  
  122. fromDistinctAscList1c :: [(Key,a)] -> IntMap a
  123. fromDistinctAscList1c [] = Nil
  124. fromDistinctAscList1c ((kx,vx) : zs1) = inline addAll kx (Tip kx vx) zs1
  125. where
  126. -- invariant for `addAll` and `addMany`: `kx` is a key in the map `tx`.
  127. addAll !kx !tx []
  128. = tx
  129. addAll !kx !tx ((ky,vy) : zs)
  130. | m <- branchMask kx ky
  131. , Inserted ty zs' <- addMany m ky (Tip ky vy) zs
  132. = addAll kx (link ky ty kx tx) zs'
  133.  
  134. -- addMany adds all elements that have the same prefix as `kx` w.r.t.
  135. -- the branch mask `m` to `tx`.
  136. addMany !m !kx tx []
  137. = Inserted tx []
  138. addMany !m !kx tx zs0@((ky,vy) : zs)
  139. | mask kx m /= mask ky m
  140. = Inserted tx zs0
  141. | Inserted ty zs' <- addMany (branchMask kx ky) ky (Tip ky vy) zs
  142. = addMany m kx (link ky ty kx tx) zs'
  143.  
  144. fromDistinctAscList1d :: [(Key,a)] -> IntMap a
  145. fromDistinctAscList1d [] = Nil
  146. fromDistinctAscList1d ((kx,vx) : zs1) = inline addAll kx (Tip kx vx) zs1
  147. where
  148. -- invariant for `addAll` and `addMany`: `kx` is a key in the map `tx`.
  149. addAll !kx !tx []
  150. = tx
  151. addAll !kx !tx ((ky,vy) : zs)
  152. | m <- branchMask kx ky
  153. , Inserted ty zs' <- inline addMany m ky (Tip ky vy) zs
  154. = addAll kx (link ky ty kx tx) zs'
  155.  
  156. -- addMany adds all elements that have the same prefix as `kx` w.r.t.
  157. -- the branch mask `m` to `tx`.
  158. addMany !m !kx tx []
  159. = Inserted tx []
  160. addMany !m !kx tx zs0@((ky,vy) : zs)
  161. | mask kx m /= mask ky m
  162. = Inserted tx zs0
  163. | Inserted ty zs' <- addMany (branchMask kx ky) ky (Tip ky vy) zs
  164. = addMany m kx (link ky ty kx tx) zs'
  165.  
  166. fromDistinctAscList1e :: [(Key,a)] -> IntMap a
  167. fromDistinctAscList1e [] = Nil
  168. fromDistinctAscList1e ((kx,vx) : zs1) = addAll' kx vx zs1
  169. where
  170. addAll' !kx vx [] = Tip kx vx
  171. addAll' !kx vx ((ky,vy) : zs)
  172. | m <- branchMask kx ky
  173. , Inserted ty zs' <- addMany' m ky vy zs
  174. = addAll kx (link ky ty kx (Tip kx vx)) zs'
  175.  
  176. -- invariant for `addAll` and `addMany`: `kx` is a key in the map `tx`.
  177. addAll !kx !tx []
  178. = tx
  179. addAll !kx !tx ((ky,vy) : zs)
  180. | m <- branchMask kx ky
  181. , Inserted ty zs' <- addMany' m ky vy zs
  182. = addAll kx (link ky ty kx tx) zs'
  183.  
  184. addMany' !m !kx vx [] = Inserted (Tip kx vx) []
  185. addMany' !m !kx vx zs0@((ky,vy) : zs)
  186. | mask kx m /= mask ky m
  187. = Inserted (Tip kx vx) zs0
  188. | Inserted ty zs' <- addMany' (branchMask kx ky) ky vy zs
  189. = addMany m kx (link ky ty kx (Tip kx vx)) zs'
  190.  
  191. -- addMany adds all elements that have the same prefix as `kx` w.r.t.
  192. -- the branch mask `m` to `tx`.
  193. addMany !m !kx tx []
  194. = Inserted tx []
  195. addMany !m !kx tx zs0@((ky,vy) : zs)
  196. | mask kx m /= mask ky m
  197. = Inserted tx zs0
  198. | Inserted ty zs' <- addMany' (branchMask kx ky) ky vy zs
  199. = addMany m kx (link ky ty kx tx) zs'
  200.  
  201. fromAscList1 :: [(Key,a)] -> IntMap a
  202. fromAscList1 [] = Nil
  203. fromAscList1 ((kx,vx) : zs0) = addAll' kx vx zs0
  204. where
  205. addAll' !kx vx [] = Tip kx vx
  206. addAll' !kx vx ((ky,vy) : zs)
  207. | kx == ky = addAll' ky vy zs
  208. | otherwise = addAll kx (Tip kx vx) ((ky,vy) : zs)
  209.  
  210. -- invariant for `addAll` and `addMany`: `kx` is a key in the map `tx`.
  211. addAll !kx !tx []
  212. = tx
  213. addAll !kx !tx ((ky,vy) : zs)
  214. | m <- branchMask kx ky
  215. , Inserted ty zs' <- addMany' m ky vy zs
  216. = addAll kx (link ky ty kx tx) zs'
  217.  
  218. addMany' !m !kx vx [] = Inserted (Tip kx vx) []
  219. addMany' !m !kx vx ((ky,vy) : zs)
  220. | kx == ky = addMany' m ky vy zs
  221. | otherwise = addMany m kx (Tip kx vx) ((ky,vy) : zs)
  222.  
  223. -- addMany adds all elements that have the same prefix as `kx` w.r.t.
  224. -- the branch mask `m` to `tx`.
  225. addMany !m !kx tx []
  226. = Inserted tx []
  227. addMany !m !kx tx zs0@((ky,vy) : zs)
  228. | mask kx m /= mask ky m
  229. = Inserted tx zs0
  230. | Inserted ty zs' <- addMany' (branchMask kx ky) ky vy zs
  231. = addMany m kx (link ky ty kx tx) zs'
  232.  
  233. fromAscList1a :: [(Key,a)] -> IntMap a
  234. fromAscList1a [] = Nil
  235. fromAscList1a ((kx,vx) : zs1) = addAll' kx vx zs1
  236. where
  237. -- `addAll'` collects all keys equal to `kx` into a single value,
  238. -- and then proceeds with `addAll`.
  239. addAll' !kx vx [] = Tip kx vx
  240. addAll' !kx vx ((ky,vy) : zs)
  241. | kx == ky
  242. = addAll' ky vy zs
  243. | m <- branchMask kx ky
  244. , Inserted ty zs' <- addMany' m ky vy zs
  245. = addAll kx (link ky ty kx (Tip kx vx)) zs'
  246.  
  247. -- for `addAll` and `addMany`, kx is /a/ key inside the tree `tx`
  248. -- `addAll` consumes the rest of the list, adding to the tree `tx`
  249. addAll !kx !tx []
  250. = tx
  251. addAll !kx !tx ((ky,vy) : zs)
  252. | m <- branchMask kx ky
  253. , Inserted ty zs' <- addMany' m ky vy zs
  254. = addAll kx (link ky ty kx tx) zs'
  255.  
  256. -- `addMany'` is similar to `addAll'`, but proceeds with `addMany'`.
  257. addMany' !m !kx vx [] = Inserted (Tip kx vx) []
  258. addMany' !m !kx vx zs0@((ky,vy) : zs)
  259. | kx == ky
  260. = addMany' m ky vy zs
  261. | mask kx m /= mask ky m
  262. = Inserted (Tip kx vx) zs0
  263. | Inserted ty zs' <- addMany' (branchMask kx ky) ky vy zs
  264. = addMany m kx (link ky ty kx (Tip kx vx)) zs'
  265.  
  266. -- `addAll` adds to `tx` all keys whose prefix w.r.t. `m` agrees with `kx`.
  267. addMany !m !kx tx []
  268. = Inserted tx []
  269. addMany !m !kx tx zs0@((ky,vy) : zs)
  270. | mask kx m /= mask ky m
  271. = Inserted tx zs0
  272. | Inserted ty zs' <- addMany' (branchMask kx ky) ky vy zs
  273. = addMany m kx (link ky ty kx tx) zs'
  274.  
  275. fromAscList1b :: [(Key,a)] -> IntMap a
  276. fromAscList1b [] = Nil
  277. fromAscList1b ((kx,vx) : zs0) = addAll' kx vx zs0
  278. where
  279. addAll' !kx vx [] = Tip kx vx
  280. addAll' !kx vx ((ky,vy) : zs)
  281. | kx == ky = addAll' ky vy zs
  282. | otherwise = inline addAll kx (Tip kx vx) ((ky,vy) : zs)
  283.  
  284. -- invariant for `addAll` and `addMany`: `kx` is a key in the map `tx`.
  285. addAll !kx !tx []
  286. = tx
  287. addAll !kx !tx ((ky,vy) : zs)
  288. | m <- branchMask kx ky
  289. , Inserted ty zs' <- addMany' m ky vy zs
  290. = addAll kx (link ky ty kx tx) zs'
  291.  
  292. addMany' !m !kx vx [] = Inserted (Tip kx vx) []
  293. addMany' !m !kx vx ((ky,vy) : zs)
  294. | kx == ky = addMany' m ky vy zs
  295. | otherwise = inline addMany m kx (Tip kx vx) ((ky,vy) : zs)
  296.  
  297. -- addMany adds all elements that have the same prefix as `kx` w.r.t.
  298. -- the branch mask `m` to `tx`.
  299. addMany !m !kx tx []
  300. = Inserted tx []
  301. addMany !m !kx tx zs0@((ky,vy) : zs)
  302. | mask kx m /= mask ky m
  303. = Inserted tx zs0
  304. | Inserted ty zs' <- addMany' (branchMask kx ky) ky vy zs
  305. = addMany m kx (link ky ty kx tx) zs'
  306.  
  307. fromAscList1c :: [(Key,a)] -> IntMap a
  308. fromAscList1c [] = Nil
  309. fromAscList1c ((kx,vx) : zs1) = addAll' kx vx zs1
  310. where
  311. addAll' !kx vx [] = Tip kx vx
  312. addAll' !kx vx ((ky,vy) : zs)
  313. | kx == ky
  314. = addAll' ky vy zs
  315. | m <- branchMask kx ky
  316. , Inserted ty zs' <- addMany' m ky vy zs
  317. = addAll kx (link ky ty kx (Tip kx vx)) zs'
  318.  
  319. -- invariant for `addAll` and `addMany`: `kx` is a key in the map `tx`.
  320. addAll !kx tx []
  321. = tx
  322. addAll !kx tx ((ky,vy) : zs)
  323. | m <- branchMask kx ky
  324. , Inserted ty zs' <- addMany' m ky vy zs
  325. = addAll kx (link ky ty kx tx) zs'
  326.  
  327. addMany' !m !kx vx [] = Inserted (Tip kx vx) []
  328. addMany' !m !kx vx zs0@((ky,vy) : zs)
  329. | kx == ky
  330. = addMany' m ky vy zs
  331. | mask kx m /= mask ky m
  332. = Inserted (Tip kx vx) zs0
  333. | Inserted ty zs' <- addMany' (branchMask kx ky) ky vy zs
  334. = addMany m kx (link ky ty kx (Tip kx vx)) zs'
  335.  
  336. -- addMany adds all elements that have the same prefix as `kx` w.r.t.
  337. -- the branch mask `m` to `tx`.
  338. addMany !m !kx tx []
  339. = Inserted tx []
  340. addMany !m !kx tx zs0@((ky,vy) : zs)
  341. | mask kx m /= mask ky m
  342. = Inserted tx zs0
  343. | Inserted ty zs' <- addMany' (branchMask kx ky) ky vy zs
  344. = addMany m kx (link ky ty kx tx) zs'
  345.  
  346. ------------------------------------------------------------------------------
  347. -- fromList implementation from #653
  348. ------------------------------------------------------------------------------
  349.  
  350. fromList1 :: [(Key,a)] -> IntMap a
  351. fromList1 = insertAll Nil
  352. {-# NOINLINE fromList1 #-}
  353.  
  354. -- [Note: fromList]
  355. --
  356. -- The obvious way to build a map from a list is just to fold over the list
  357. -- inserting each entry into the accumulator map. The problem is that this
  358. -- rebuilds the path from the root *every single time*. To avoid this, we
  359. -- insert as many elements as we can into the current subtree, backing out
  360. -- one level at a time when necessary.
  361.  
  362. insertAll :: IntMap a -> [(Key, a)] -> IntMap a
  363. insertAll m [] = m
  364. insertAll m ((k,x) : kxs)
  365. | Inserted m' r <- insertSome m k x kxs
  366. = insertAll m' r
  367.  
  368. -- | Insert at least one entry into an 'IntMap' or subtree. If
  369. -- others fit in the same resulting subtree, insert them too.
  370. -- Return the new map and remaining values.
  371. insertSome :: IntMap a -> Key -> a -> [(Key, a)] -> Inserted a
  372. insertSome t@(Bin p m l r) !k x kxs
  373. | nomatch k p m
  374. = insertMany (link k (Tip k x) p t) kxs
  375.  
  376. | zero k m
  377. , Inserted l' kxs' <- insertSome l k x kxs
  378. = insertMany (Bin p m l' r) kxs'
  379.  
  380. | Inserted r' kxs' <- insertSome r k x kxs
  381. = insertMany (Bin p m l r') kxs'
  382.  
  383. insertSome t@(Tip ky _) k x kxs
  384. | k == ky
  385. = insertMany (Tip k x) kxs
  386. | otherwise
  387. = insertMany (link k (Tip k x) ky t) kxs
  388.  
  389. insertSome Nil k x kxs = insertMany (Tip k x) kxs
  390.  
  391. -- | Try to insert some entries into a subtree of an 'IntMap'. If
  392. -- they belong in some other subtree, just don't insert them.
  393. insertMany :: IntMap a -> [(Key, a)] -> Inserted a
  394. insertMany t [] = Inserted t []
  395. insertMany t@(Bin p m _ _) kxs@((k, x) : kxs')
  396. | nomatch k p m
  397. = Inserted t kxs
  398. | otherwise
  399. = insertSome t k x kxs'
  400. insertMany t@(Tip ky _) kxs@((k, x) : kxs')
  401. | k==ky = insertSome t k x kxs'
  402. | otherwise = Inserted t kxs
  403. insertMany Nil kxs = Inserted Nil kxs -- Unused case
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!