# Ticket #3271: new-methods-for-data_sequence.6.dpatch

File new-methods-for-data_sequence.6.dpatch, 48.7 KB (added by , 8 years ago) |
---|

Line | |
---|---|

1 | Fri Aug 21 00:46:25 EDT 2009 wasserman.louis@gmail.com |

2 | * Ticket #3271: New methods for Data.Sequence |

3 | |

4 | New patches: |

5 | |

6 | [Ticket #3271: New methods for Data.Sequence |

7 | wasserman.louis@gmail.com**20090821044625 |

8 | Ignore-this: f92f642d4fd04bd7a03bb5b5c20b39f6 |

9 | ] { |

10 | hunk ./Data/IntMap.hs 185 |

11 | |

12 | #if __GLASGOW_HASKELL__ |

13 | import Text.Read |

14 | -import Data.Data (Data(..), mkNoRepType) |

15 | +import Data.Data (Data(..), mkNorepType) |

16 | #endif |

17 | |

18 | #if __GLASGOW_HASKELL__ >= 503 |

19 | hunk ./Data/IntMap.hs 276 |

20 | gfoldl f z im = z fromList `f` (toList im) |

21 | toConstr _ = error "toConstr" |

22 | gunfold _ _ = error "gunfold" |

23 | - dataTypeOf _ = mkNoRepType "Data.IntMap.IntMap" |

24 | + dataTypeOf _ = mkNorepType "Data.IntMap.IntMap" |

25 | dataCast1 f = gcast1 f |

26 | |

27 | #endif |

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

29 | |

30 | #if __GLASGOW_HASKELL__ |

31 | import Text.Read |

32 | -import Data.Data (Data(..), mkNoRepType) |

33 | +import Data.Data (Data(..), mkNorepType) |

34 | #endif |

35 | |

36 | #if __GLASGOW_HASKELL__ >= 503 |

37 | hunk ./Data/IntSet.hs 200 |

38 | gfoldl f z is = z fromList `f` (toList is) |

39 | toConstr _ = error "toConstr" |

40 | gunfold _ _ = error "gunfold" |

41 | - dataTypeOf _ = mkNoRepType "Data.IntSet.IntSet" |

42 | + dataTypeOf _ = mkNorepType "Data.IntSet.IntSet" |

43 | |

44 | #endif |

45 | |

46 | hunk ./Data/Map.hs 200 |

47 | |

48 | #if __GLASGOW_HASKELL__ |

49 | import Text.Read |

50 | -import Data.Data (Data(..), mkNoRepType, gcast2) |

51 | +import Data.Data (Data(..), mkNorepType, gcast2) |

52 | #endif |

53 | |

54 | {-------------------------------------------------------------------- |

55 | hunk ./Data/Map.hs 248 |

56 | gfoldl f z m = z fromList `f` toList m |

57 | toConstr _ = error "toConstr" |

58 | gunfold _ _ = error "gunfold" |

59 | - dataTypeOf _ = mkNoRepType "Data.Map.Map" |

60 | + dataTypeOf _ = mkNorepType "Data.Map.Map" |

61 | dataCast2 f = gcast2 f |

62 | |

63 | #endif |

64 | hunk ./Data/Sequence.hs 6 |

65 | -- | |

66 | -- Module : Data.Sequence |

67 | -- Copyright : (c) Ross Paterson 2005 |

68 | +-- (c) Louis Wasserman 2009 |

69 | -- License : BSD-style |

70 | -- Maintainer : libraries@haskell.org |

71 | -- Stability : experimental |

72 | hunk ./Data/Sequence.hs 40 |

73 | -- * Construction |

74 | empty, -- :: Seq a |

75 | singleton, -- :: a -> Seq a |

76 | + replicate, -- :: Int -> a -> Seq a |

77 | + replicateA, -- :: Applicative f => Int -> f a -> f (Seq a) |

78 | + replicateM, -- :: Monad m => Int -> m a -> m (Seq a) |

79 | (<|), -- :: a -> Seq a -> Seq a |

80 | (|>), -- :: Seq a -> a -> Seq a |

81 | (><), -- :: Seq a -> Seq a -> Seq a |

82 | hunk ./Data/Sequence.hs 47 |

83 | fromList, -- :: [a] -> Seq a |

84 | + -- ** Sequential construction |

85 | + iterateN, -- :: Int -> (a -> a) -> a -> Seq a |

86 | + unfoldr, -- :: (b -> Maybe (a, b)) -> b -> Seq a |

87 | + unfoldl, -- :: (b -> Maybe (b, a)) -> b -> Seq a |

88 | -- * Deconstruction |

89 | -- | Additional functions for deconstructing sequences are available |

90 | -- via the 'Foldable' instance of 'Seq'. |

91 | hunk ./Data/Sequence.hs 63 |

92 | viewl, -- :: Seq a -> ViewL a |

93 | ViewR(..), |

94 | viewr, -- :: Seq a -> ViewR a |

95 | - -- ** Indexing |

96 | + -- * Scanning |

97 | + scanl, -- :: (a -> b -> a) -> a -> Seq b -> Seq a |

98 | + scanl1, -- :: (a -> a -> a) -> Seq a -> Seq a |

99 | + scanr, -- :: (a -> b -> b) -> b -> Seq a -> Seq b |

100 | + scanr1, -- :: (a -> a -> a) -> Seq a -> Seq a |

101 | + -- * Sublists |

102 | + tails, -- :: Seq a -> Seq (Seq a) |

103 | + inits, -- :: Seq a -> Seq (Seq a) |

104 | + takeWhileL, -- :: (a -> Bool) -> Seq a -> Seq a |

105 | + takeWhileR, -- :: (a -> Bool) -> Seq a -> Seq a |

106 | + dropWhileL, -- :: (a -> Bool) -> Seq a -> Seq a |

107 | + dropWhileR, -- :: (a -> Bool) -> Seq a -> Seq a |

108 | + spanl, -- :: (a -> Bool) -> Seq a -> (Seq a, Seq a) |

109 | + spanr, -- :: (a -> Bool) -> Seq a -> (Seq a, Seq a) |

110 | + breakl, -- :: (a -> Bool) -> Seq a -> (Seq a, Seq a) |

111 | + breakr, -- :: (a -> Bool) -> Seq a -> (Seq a, Seq a) |

112 | + partition, -- :: (a -> Bool) -> Seq a -> (Seq a, Seq a) |

113 | + filter, -- :: (a -> Bool) -> Seq a -> Seq a |

114 | + -- * Sorts |

115 | + sort, -- :: Ord a => Seq a -> Seq a |

116 | + sortBy, -- :: (a -> a -> Ordering) -> Seq a -> Seq a |

117 | + unstableSort, -- :: Ord a => Seq a -> Seq a |

118 | + unstableSortBy, -- :: (a -> a -> Ordering) -> Seq a -> Seq a |

119 | + -- * Indexing |

120 | index, -- :: Seq a -> Int -> a |

121 | adjust, -- :: (a -> a) -> Int -> Seq a -> Seq a |

122 | update, -- :: Int -> a -> Seq a -> Seq a |

123 | hunk ./Data/Sequence.hs 93 |

124 | take, -- :: Int -> Seq a -> Seq a |

125 | drop, -- :: Int -> Seq a -> Seq a |

126 | splitAt, -- :: Int -> Seq a -> (Seq a, Seq a) |

127 | + -- ** Indexing with predicates |

128 | + elemIndexL, -- :: Eq a => a -> Seq a -> Maybe Int |

129 | + elemIndicesL, -- :: Eq a => a -> Seq a -> [Int] |

130 | + elemIndexR, -- :: Eq a => a -> Seq a -> Maybe Ind |

131 | + elemIndicesR,-- :: Eq a => a -> Seq a -> [Int] |

132 | + findIndexL, -- :: (a -> Bool) -> Seq a -> Maybe Int |

133 | + findIndicesL, -- :: (a -> Bool) -> Seq a -> [Int] |

134 | + findIndexR, -- :: (a -> Bool) -> Seq a -> Maybe Int |

135 | + findIndicesR, -- :: (a -> Bool) -> Seq a -> [Int] |

136 | + -- * Folds |

137 | + foldWithIndexL, -- :: (b -> Int -> a -> b) -> b -> Seq a -> b |

138 | + foldWithIndexR, -- :: (Int -> a -> b -> b) -> b -> Seq a -> b |

139 | -- * Transformations |

140 | hunk ./Data/Sequence.hs 106 |

141 | + mapWithIndex, -- :: (Int -> a -> b) -> Seq a -> Seq b |

142 | reverse, -- :: Seq a -> Seq a |

143 | hunk ./Data/Sequence.hs 108 |

144 | + -- ** Zips |

145 | + zip, -- :: Seq a -> Seq b -> Seq (a, b) |

146 | + zipWith, -- :: (a -> b -> c) -> Seq a -> Seq b -> Seq c |

147 | + zip3, -- :: Seq a -> Seq b -> Seq c -> Seq (a, b, c) |

148 | + zipWith3, -- :: (a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d |

149 | + zip4, -- :: Seq a -> Seq b -> Seq c -> Seq d -> Seq (a, b, c, d) |

150 | + zipWith4, -- :: (a -> b -> c -> d -> e) -> Seq a -> Seq b -> Seq c -> Seq d -> Seq e |

151 | #if TESTING |

152 | valid, |

153 | #endif |

154 | hunk ./Data/Sequence.hs 121 |

155 | ) where |

156 | |

157 | import Prelude hiding ( |

158 | - null, length, take, drop, splitAt, foldl, foldl1, foldr, foldr1, |

159 | - reverse) |

160 | -import qualified Data.List (foldl') |

161 | -import Control.Applicative (Applicative(..), (<$>)) |

162 | -import Control.Monad (MonadPlus(..)) |

163 | + null, length, take, drop, splitAt, foldl, foldl1, foldr, foldr1, span, |

164 | + scanl, scanl1, scanr, scanr1, replicate, zip, zipWith, zip3, zipWith3, |

165 | + takeWhile, dropWhile, break, iterate, reverse, filter, mapM, all) |

166 | +import qualified Data.List (foldl', zipWith) |

167 | +import Control.Applicative (Applicative(..), (<$>), WrappedMonad(..), liftA, liftA2, liftA3) |

168 | +import Control.Monad (MonadPlus(..), ap, liftM, liftM2, liftM3, liftM4) |

169 | +import qualified Control.Monad |

170 | import Data.Monoid (Monoid(..)) |

171 | import Data.Foldable |

172 | import Data.Traversable |

173 | hunk ./Data/Sequence.hs 137 |

174 | import Data.Typeable (TyCon, Typeable1(..), mkTyCon, mkTyConApp ) |

175 | |

176 | #ifdef __GLASGOW_HASKELL__ |

177 | +import GHC.Exts (build) |

178 | import Text.Read (Lexeme(Ident), lexP, parens, prec, |

179 | readPrec, readListPrec, readListPrecDefault) |

180 | import Data.Data (Data(..), DataType, Constr, Fixity(..), |

181 | hunk ./Data/Sequence.hs 145 |

182 | #endif |

183 | |

184 | #if TESTING |

185 | -import Control.Monad (liftM, liftM3, liftM4) |

186 | -import Test.QuickCheck |

187 | +import Test.QuickCheck hiding ((><)) |

188 | #endif |

189 | |

190 | infixr 5 `consTree` |

191 | hunk ./Data/Sequence.hs 302 |

192 | traverse f sf |

193 | |

194 | {-# INLINE deep #-} |

195 | -{-# SPECIALIZE deep :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-} |

196 | -{-# SPECIALIZE deep :: Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-} |

197 | +{-# SPECIALIZE INLINE deep :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-} |

198 | +{-# SPECIALIZE INLINE deep :: Digit (Node a) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-} |

199 | deep :: Sized a => Digit a -> FingerTree (Node a) -> Digit a -> FingerTree a |

200 | deep pr m sf = Deep (size pr + size m + size sf) pr m sf |

201 | |

202 | hunk ./Data/Sequence.hs 307 |

203 | +{-# INLINE pullL #-} |

204 | +pullL :: Sized a => Int -> FingerTree (Node a) -> Digit a -> FingerTree a |

205 | +pullL s m sf = case viewLTree m of |

206 | + Nothing2 -> digitToTree' s sf |

207 | + Just2 pr m' -> Deep s (nodeToDigit pr) m' sf |

208 | + |

209 | +{-# INLINE pullR #-} |

210 | +pullR :: Sized a => Int -> Digit a -> FingerTree (Node a) -> FingerTree a |

211 | +pullR s pr m = case viewRTree m of |

212 | + Nothing2 -> digitToTree' s pr |

213 | + Just2 m' sf -> Deep s pr m' (nodeToDigit sf) |

214 | + |

215 | +{-# SPECIALIZE deepL :: Maybe (Digit (Elem a)) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-} |

216 | +{-# SPECIALIZE deepL :: Maybe (Digit (Node a)) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-} |

217 | +deepL :: Sized a => Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a |

218 | +deepL Nothing m sf = pullL (size m + size sf) m sf |

219 | +deepL (Just pr) m sf = deep pr m sf |

220 | + |

221 | +{-# SPECIALIZE deepR :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Maybe (Digit (Elem a)) -> FingerTree (Elem a) #-} |

222 | +{-# SPECIALIZE deepR :: Digit (Node a) -> FingerTree (Node (Node a)) -> Maybe (Digit (Node a)) -> FingerTree (Node a) #-} |

223 | +deepR :: Sized a => Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a |

224 | +deepR pr m Nothing = pullR (size m + size pr) pr m |

225 | +deepR pr m (Just sf) = deep pr m sf |

226 | + |

227 | -- Digits |

228 | |

229 | data Digit a |

230 | hunk ./Data/Sequence.hs 367 |

231 | fmap = fmapDefault |

232 | |

233 | instance Traversable Digit where |

234 | + {-# INLINE traverse #-} |

235 | traverse f (One a) = One <$> f a |

236 | traverse f (Two a b) = Two <$> f a <*> f b |

237 | traverse f (Three a b c) = Three <$> f a <*> f b <*> f c |

238 | hunk ./Data/Sequence.hs 374 |

239 | traverse f (Four a b c d) = Four <$> f a <*> f b <*> f c <*> f d |

240 | |

241 | instance Sized a => Sized (Digit a) where |

242 | - {-# SPECIALIZE instance Sized (Digit (Elem a)) #-} |

243 | - {-# SPECIALIZE instance Sized (Digit (Node a)) #-} |

244 | - size xs = foldl (\ i x -> i + size x) 0 xs |

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

246 | + size = foldl1 (+) . fmap size |

247 | |

248 | {-# SPECIALIZE digitToTree :: Digit (Elem a) -> FingerTree (Elem a) #-} |

249 | {-# SPECIALIZE digitToTree :: Digit (Node a) -> FingerTree (Node a) #-} |

250 | hunk ./Data/Sequence.hs 385 |

251 | digitToTree (Three a b c) = deep (Two a b) Empty (One c) |

252 | digitToTree (Four a b c d) = deep (Two a b) Empty (Two c d) |

253 | |

254 | +-- | Given the size of a digit and the digit itself, efficiently converts it to a FingerTree. |

255 | +digitToTree' :: Int -> Digit a -> FingerTree a |

256 | +digitToTree' n (Four a b c d) = Deep n (Two a b) Empty (Two c d) |

257 | +digitToTree' n (Three a b c) = Deep n (Two a b) Empty (One c) |

258 | +digitToTree' n (Two a b) = Deep n (One a) Empty (One b) |

259 | +digitToTree' n (One a) = n `seq` Single a |

260 | + |

261 | + |

262 | + |

263 | -- Nodes |

264 | |

265 | data Node a |

266 | hunk ./Data/Sequence.hs 411 |

267 | foldl f z (Node3 _ a b c) = ((z `f` a) `f` b) `f` c |

268 | |

269 | instance Functor Node where |

270 | + {-# INLINE fmap #-} |

271 | fmap = fmapDefault |

272 | |

273 | instance Traversable Node where |

274 | hunk ./Data/Sequence.hs 415 |

275 | + {-# INLINE traverse #-} |

276 | traverse f (Node2 v a b) = Node2 v <$> f a <*> f b |

277 | traverse f (Node3 v a b c) = Node3 v <$> f a <*> f b <*> f c |

278 | |

279 | hunk ./Data/Sequence.hs 461 |

280 | showsPrec p (Elem x) = showsPrec p x |

281 | #endif |

282 | |

283 | +------------------------------------------------------- |

284 | +-- Applicative construction |

285 | +------------------------------------------------------- |

286 | + |

287 | +newtype Id a = Id {runId :: a} |

288 | + |

289 | +instance Functor Id where |

290 | + fmap f (Id x) = Id (f x) |

291 | + |

292 | +instance Monad Id where |

293 | + return = Id |

294 | + m >>= k = k (runId m) |

295 | + |

296 | +instance Applicative Id where |

297 | + pure = return |

298 | + (<*>) = ap |

299 | + |

300 | +-- | This is essentially a clone of Control.Monad.State.Strict. |

301 | +newtype State s a = State {runState :: s -> (s, a)} |

302 | + |

303 | +instance Functor (State s) where |

304 | + fmap = liftA |

305 | + |

306 | +instance Monad (State s) where |

307 | + {-# INLINE return #-} |

308 | + {-# INLINE (>>=) #-} |

309 | + return x = State $ \ s -> (s, x) |

310 | + m >>= k = State $ \ s -> case runState m s of |

311 | + (s', x) -> runState (k x) s' |

312 | + |

313 | +instance Applicative (State s) where |

314 | + pure = return |

315 | + (<*>) = ap |

316 | + |

317 | +execState :: State s a -> s -> a |

318 | +execState m x = snd (runState m x) |

319 | + |

320 | +-- | A helper method: a strict version of mapAccumL. |

321 | +mapAccumL' :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c) |

322 | +mapAccumL' f s t = runState (traverse (State . flip f) t) s |

323 | + |

324 | +-- | 'applicativeTree' takes an Applicative-wrapped construction of a piece of a FingerTree, assumed |

325 | +-- to always have the same size (which is put in the second argument), and replicates it as many times |

326 | +-- as specified. This is a generalization of 'replicateA', which itself is a generalization of many |

327 | +-- Data.Sequence methods. |

328 | +{-# SPECIALIZE applicativeTree :: Int -> Int -> State s a -> State s (FingerTree a) #-} |

329 | +{-# SPECIALIZE applicativeTree :: Int -> Int -> Id a -> Id (FingerTree a) #-} |

330 | + -- Special note: the Id specialization automatically does node sharing, reducing memory usage of the |

331 | + -- resulting tree to /O(log n)/. |

332 | +applicativeTree :: Applicative f => Int -> Int -> f a -> f (FingerTree a) |

333 | +applicativeTree n mSize m = mSize `seq` case n of |

334 | + 0 -> pure Empty |

335 | + 1 -> liftA Single m |

336 | + 2 -> deepA one empty one |

337 | + 3 -> deepA two empty one |

338 | + 4 -> deepA two empty two |

339 | + 5 -> deepA three empty two |

340 | + 6 -> deepA three empty three |

341 | + 7 -> deepA four empty three |

342 | + 8 -> deepA four empty four |

343 | + _ -> let (q, r) = n `quotRem` 3 in q `seq` case r of |

344 | + 0 -> deepA three (applicativeTree (q - 2) mSize' n3) three |

345 | + 1 -> deepA four (applicativeTree (q - 2) mSize' n3) three |

346 | + _ -> deepA four (applicativeTree (q - 2) mSize' n3) four |

347 | + where one = liftA One m |

348 | + two = liftA2 Two m m |

349 | + three = liftA3 Three m m m |

350 | + four = liftA3 Four m m m <*> m |

351 | + deepA = liftA3 (Deep (n * mSize)) |

352 | + mSize' = 3 * mSize |

353 | + n3 = liftA3 (Node3 mSize') m m m |

354 | + empty = pure Empty |

355 | + |

356 | ------------------------------------------------------------------------ |

357 | -- Construction |

358 | ------------------------------------------------------------------------ |

359 | hunk ./Data/Sequence.hs 546 |

360 | singleton :: a -> Seq a |

361 | singleton x = Seq (Single (Elem x)) |

362 | |

363 | +-- | /O(log n)/. @replicate n x@ is a sequence of length @n@ with @x@ the value of every element. |

364 | +replicate :: Int -> a -> Seq a |

365 | +replicate n x |

366 | + | n < 0 = error "replicate takes a nonnegative integer argument" |

367 | + | otherwise = runId (replicateA n (Id x)) |

368 | + |

369 | +-- | 'replicateA' is an 'Applicative' version of 'replicate', and makes /O(log n)/ calls to '<*>' and 'pure'. @'replicateA' n x@ is equivalent to @'sequenceA' ('replicate' n x)@. |

370 | +replicateA :: Applicative f => Int -> f a -> f (Seq a) |

371 | +replicateA n x |

372 | + | n < 0 = error "replicateA takes a nonnegative integer argument" |

373 | + | otherwise = Seq <$> applicativeTree n 1 (Elem <$> x) |

374 | + |

375 | +-- | 'replicateM' is a generalization of 'Control.Monad.replicateM'. |

376 | +replicateM :: Monad m => Int -> m a -> m (Seq a) |

377 | +replicateM n x |

378 | + | n < 0 = error "replicateM takes a nonnegative integer argument" |

379 | + | otherwise = unwrapMonad (replicateA n (WrapMonad x)) |

380 | + |

381 | -- | /O(1)/. Add an element to the left end of a sequence. |

382 | -- Mnemonic: a triangle with the single element at the pointy end. |

383 | (<|) :: a -> Seq a -> Seq a |

384 | hunk ./Data/Sequence.hs 838 |

385 | addDigits4 m1 (Four a b c d) e f g h (Four i j k l) m2 = |

386 | appendTree4 m1 (node3 a b c) (node3 d e f) (node3 g h i) (node3 j k l) m2 |

387 | |

388 | +-- | Builds a sequence from a seed value. Takes time linear in the number of generated elements. /WARNING: If the number of generated elements is infinite, this method will not terminate./ |

389 | +unfoldr :: (b -> Maybe (a, b)) -> b -> Seq a |

390 | +unfoldr f b = unfoldr' empty b where |

391 | + -- uses tail recursion rather than, for instance, the List implementation. |

392 | + unfoldr' as b = maybe as (\ (a, b') -> unfoldr' (as |> a) b') (f b) |

393 | + |

394 | +-- | @'unfoldl' f x@ is equivalent to @'reverse' ('unfoldr' f x)@. |

395 | +unfoldl :: (b -> Maybe (b, a)) -> b -> Seq a |

396 | +unfoldl f b = unfoldl' empty b where |

397 | + unfoldl' as b = maybe as (\ (b', a) -> unfoldl' (a <| as) b') (f b) |

398 | + |

399 | +-- | /O(n)/. Constructs a sequence by repeated application of a function to a seed value. |

400 | +-- |

401 | +-- > iterateN n f x = fromList (Prelude.take n (Prelude.iterate f x)) |

402 | +iterateN :: Int -> (a -> a) -> a -> Seq a |

403 | +iterateN n f x |

404 | + | n < 0 = error "iterateN takes a nonnegative integer argument" |

405 | + | otherwise = replicateA n (State (\ x -> (f x, x))) `execState` x |

406 | + |

407 | ------------------------------------------------------------------------ |

408 | -- Deconstruction |

409 | ------------------------------------------------------------------------ |

410 | hunk ./Data/Sequence.hs 922 |

411 | viewLTree :: Sized a => FingerTree a -> Maybe2 a (FingerTree a) |

412 | viewLTree Empty = Nothing2 |

413 | viewLTree (Single a) = Just2 a Empty |

414 | -viewLTree (Deep s (One a) m sf) = Just2 a (case viewLTree m of |

415 | - Nothing2 -> digitToTree sf |

416 | - Just2 b m' -> Deep (s - size a) (nodeToDigit b) m' sf) |

417 | +viewLTree (Deep s (One a) m sf) = Just2 a (pullL (s - size a) m sf) |

418 | viewLTree (Deep s (Two a b) m sf) = |

419 | Just2 a (Deep (s - size a) (One b) m sf) |

420 | viewLTree (Deep s (Three a b c) m sf) = |

421 | hunk ./Data/Sequence.hs 959 |

422 | foldr f z (xs :> x) = foldr f (f x z) xs |

423 | |

424 | foldl _ z EmptyR = z |

425 | - foldl f z (xs :> x) = f (foldl f z xs) x |

426 | + foldl f z (xs :> x) = foldl f z xs `f` x |

427 | |

428 | foldr1 _ EmptyR = error "foldr1: empty view" |

429 | foldr1 f (xs :> x) = foldr f x xs |

430 | hunk ./Data/Sequence.hs 979 |

431 | viewRTree :: Sized a => FingerTree a -> Maybe2 (FingerTree a) a |

432 | viewRTree Empty = Nothing2 |

433 | viewRTree (Single z) = Just2 Empty z |

434 | -viewRTree (Deep s pr m (One z)) = Just2 (case viewRTree m of |

435 | - Nothing2 -> digitToTree pr |

436 | - Just2 m' y -> Deep (s - size z) pr m' (nodeToDigit y)) z |

437 | +viewRTree (Deep s pr m (One z)) = Just2 (pullR (s - size z) pr m) z |

438 | viewRTree (Deep s pr m (Two y z)) = |

439 | Just2 (Deep (s - size z) pr m (One y)) z |

440 | viewRTree (Deep s pr m (Three x y z)) = |

441 | hunk ./Data/Sequence.hs 987 |

442 | viewRTree (Deep s pr m (Four w x y z)) = |

443 | Just2 (Deep (s - size z) pr m (Three w x y)) z |

444 | |

445 | +------------------------------------------------------------------------ |

446 | +-- Scans |

447 | +-- |

448 | +-- These are not particularly complex applications of the Traversable |

449 | +-- functor, though making the correspondence with Data.List exact |

450 | +-- requires the use of (<|) and (|>). |

451 | +-- |

452 | +-- Note that save for the single (<|) or (|>), we maintain the original |

453 | +-- structure of the Seq, not having to do any restructuring of our own. |

454 | +-- |

455 | +-- wasserman.louis@gmail.com, 5/23/09 |

456 | +------------------------------------------------------------------------ |

457 | + |

458 | +-- | 'scanl' is similar to 'foldl', but returns a sequence of reduced values from the left: |

459 | +-- |

460 | +-- > scanl f z (fromList [x1, x2, ...]) = fromList [z, z `f` x1, (z `f` x1) `f` x2, ...] |

461 | +scanl :: (a -> b -> a) -> a -> Seq b -> Seq a |

462 | +scanl f z0 xs = z0 <| snd (mapAccumL (\ x z -> let x' = f x z in (x', x')) z0 xs) |

463 | + |

464 | +-- | 'scanl1' is a variant of 'scanl' that has no starting value argument: |

465 | +-- |

466 | +-- > scanl1 f (fromList [x1, x2, ...]) = fromList [x1, x1 `f` x2, ...] |

467 | +scanl1 :: (a -> a -> a) -> Seq a -> Seq a |

468 | +scanl1 f xs = case viewl xs of |

469 | + EmptyL -> error "scanl1 takes a nonempty sequence as an argument" |

470 | + x :< xs' -> scanl f x xs' |

471 | + |

472 | +-- | 'scanr' is the right-to-left dual of 'scanl'. |

473 | +scanr :: (a -> b -> b) -> b -> Seq a -> Seq b |

474 | +scanr f z0 xs = snd (mapAccumR (\ z x -> let z' = f x z in (z', z')) z0 xs) |> z0 |

475 | + |

476 | +-- | 'scanr1' is a variant of 'scanr' that has no starting value argument. |

477 | +scanr1 :: (a -> a -> a) -> Seq a -> Seq a |

478 | +scanr1 f xs = case viewr xs of |

479 | + EmptyR -> error "scanr1 takes a nonempty sequence as an argument" |

480 | + xs' :> x -> scanr f x xs' |

481 | + |

482 | -- Indexing |

483 | |

484 | -- | /O(log(min(i,n-i)))/. The element at the specified position, |

485 | hunk ./Data/Sequence.hs 1152 |

486 | sab = sa + size b |

487 | sabc = sab + size c |

488 | |

489 | +-- | A generalization of 'fmap', 'mapWithIndex' takes a mapping function that also depends on the element's |

490 | +-- index, and applies it to every element in the sequence. |

491 | +mapWithIndex :: (Int -> a -> b) -> Seq a -> Seq b |

492 | +mapWithIndex f xs = snd (mapAccumL' (\ i x -> (i + 1, f i x)) 0 xs) |

493 | + |

494 | -- Splitting |

495 | |

496 | -- | /O(log(min(i,n-i)))/. The first @i@ elements of a sequence. |

497 | hunk ./Data/Sequence.hs 1167 |

498 | take i = fst . splitAt i |

499 | |

500 | -- | /O(log(min(i,n-i)))/. Elements of a sequence after the first @i@. |

501 | --- If @i@ is negative, @'take' i s@ yields the whole sequence. |

502 | +-- If @i@ is negative, @'drop' i s@ yields the whole sequence. |

503 | -- If the sequence contains fewer than @i@ elements, the empty sequence |

504 | -- is returned. |

505 | drop :: Int -> Seq a -> Seq a |

506 | hunk ./Data/Sequence.hs 1202 |

507 | Split l x r -> Split (maybe Empty digitToTree l) x (deepL r m sf) |

508 | | i < spm = case splitTree im m of |

509 | Split ml xs mr -> case splitNode (im - size ml) xs of |

510 | - Split l x r -> Split (deepR pr ml l) x (deepL r mr sf) |

511 | + Split l x r -> Split (deepR pr ml l) x (deepL r mr sf) |

512 | | otherwise = case splitDigit (i - spm) sf of |

513 | hunk ./Data/Sequence.hs 1204 |

514 | - Split l x r -> Split (deepR pr m l) x (maybe Empty digitToTree r) |

515 | + Split l x r -> Split (deepR pr m l) x (maybe Empty digitToTree r) |

516 | where spr = size pr |

517 | spm = spr + size m |

518 | im = i - spr |

519 | hunk ./Data/Sequence.hs 1209 |

520 | |

521 | -{-# SPECIALIZE deepL :: Maybe (Digit (Elem a)) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-} |

522 | -{-# SPECIALIZE deepL :: Maybe (Digit (Node a)) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-} |

523 | -deepL :: Sized a => Maybe (Digit a) -> FingerTree (Node a) -> Digit a -> FingerTree a |

524 | -deepL Nothing m sf = case viewLTree m of |

525 | - Nothing2 -> digitToTree sf |

526 | - Just2 a m' -> Deep (size m + size sf) (nodeToDigit a) m' sf |

527 | -deepL (Just pr) m sf = deep pr m sf |

528 | - |

529 | -{-# SPECIALIZE deepR :: Digit (Elem a) -> FingerTree (Node (Elem a)) -> Maybe (Digit (Elem a)) -> FingerTree (Elem a) #-} |

530 | -{-# SPECIALIZE deepR :: Digit (Node a) -> FingerTree (Node (Node a)) -> Maybe (Digit (Node a)) -> FingerTree (Node a) #-} |

531 | -deepR :: Sized a => Digit a -> FingerTree (Node a) -> Maybe (Digit a) -> FingerTree a |

532 | -deepR pr m Nothing = case viewRTree m of |

533 | - Nothing2 -> digitToTree pr |

534 | - Just2 m' a -> Deep (size pr + size m) pr m' (nodeToDigit a) |

535 | -deepR pr m (Just sf) = deep pr m sf |

536 | - |

537 | {-# SPECIALIZE splitNode :: Int -> Node (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-} |

538 | {-# SPECIALIZE splitNode :: Int -> Node (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-} |

539 | splitNode :: Sized a => Int -> Node a -> Split (Maybe (Digit a)) a |

540 | hunk ./Data/Sequence.hs 1245 |

541 | where sa = size a |

542 | sab = sa + size b |

543 | sabc = sab + size c |

544 | + |

545 | +-- | /O(n)/. Returns a sequence of all suffixes of this sequence, longest first. For example, |

546 | +-- |

547 | +-- > tails (fromList "abc") = fromList [fromList "abc", fromList "bc", fromList "c", fromList ""] |

548 | +-- |

549 | +-- Evaluating the /i/th suffix takes /O(log(min(i, n-i)))/, but evaluating every suffix in the sequence |

550 | +-- takes /O(n)/ due to sharing. |

551 | +tails :: Seq a -> Seq (Seq a) |

552 | +tails (Seq xs) = Seq (tailsTree (Elem . Seq) xs) |> empty |

553 | + |

554 | +-- | /O(n)/. Returns a sequence of all prefixes of this sequence, shortest first. For example, |

555 | +-- |

556 | +-- > inits (fromList "abc") = fromList [fromList "", fromList "a", fromList "ab", fromList "abc"] |

557 | +-- |

558 | +-- Evaluating the /i/th prefix takes /O(log(min(i, n-i)))/, but evaluating every prefix in the sequence |

559 | +-- takes /O(n)/ due to sharing. |

560 | +inits :: Seq a -> Seq (Seq a) |

561 | +inits (Seq xs) = empty <| Seq (initsTree (Elem . Seq) xs) |

562 | + |

563 | +-- This implementation of tails (and, analogously, inits) has the following algorithmic advantages: |

564 | +-- Evaluating each tail in the sequence takes linear total time, which is better than we could say for |

565 | +-- @fromList [drop n xs | n <- [0..length xs]]@. |

566 | +-- Evaluating any individual tail takes logarithmic time, which is better than we can say for either |

567 | +-- @scanr (<|) empty xs@ or @iterateN (length xs + 1) (\ xs -> let _ :< xs' = viewl xs in xs') xs@. |

568 | +-- |

569 | +-- Moreover, if we actually look at every tail in the sequence, the following benchmarks demonstrate that |

570 | +-- this implementation is modestly faster than any of the above: |

571 | +-- |

572 | +-- Times (ms) |

573 | +-- min mean +/-sd median max |

574 | +-- Seq.tails: 21.986 24.961 10.169 22.417 86.485 |

575 | +-- scanr: 85.392 87.942 2.488 87.425 100.217 |

576 | +-- iterateN: 29.952 31.245 1.574 30.412 37.268 |

577 | +-- |

578 | +-- The algorithm for tails (and, analogously, inits) is as follows: |

579 | +-- |

580 | +-- A Node in the FingerTree of tails is constructed by evaluating the corresponding tail of the FingerTree |

581 | +-- of Nodes, considering the first Node in this tail, and constructing a Node in which each tail of this |

582 | +-- Node is made to be the prefix of the remaining tree. This ends up working quite elegantly, as the remainder of |

583 | +-- the tail of the FingerTree of Nodes becomes the middle of a new tail, the suffix of the Node is the |

584 | +-- prefix, and the suffix of the original tree is retained. |

585 | +-- |

586 | +-- In particular, evaluating the /i/th tail involves making as many partial evaluations as the Node depth of |

587 | +-- the /i/th element. In addition, when we evaluate the /i/th tail, and we also evaluate the /j/th tail, |

588 | +-- and /m/ Nodes are on the path to both /i/ and /j/, each of those /m/ evaluations are shared between |

589 | +-- the computation of the /i/th and /j/th tails. |

590 | +-- |

591 | +-- wasserman.louis@gmail.com, 7/16/09 |

592 | + |

593 | +tailsDigit :: Digit a -> Digit (Digit a) |

594 | +tailsDigit (One a) = One (One a) |

595 | +tailsDigit (Two a b) = Two (Two a b) (One b) |

596 | +tailsDigit (Three a b c) = Three (Three a b c) (Two b c) (One c) |

597 | +tailsDigit (Four a b c d) = Four (Four a b c d) (Three b c d) (Two c d) (One d) |

598 | + |

599 | +initsDigit :: Digit a -> Digit (Digit a) |

600 | +initsDigit (One a) = One (One a) |

601 | +initsDigit (Two a b) = Two (One a) (Two a b) |

602 | +initsDigit (Three a b c) = Three (One a) (Two a b) (Three a b c) |

603 | +initsDigit (Four a b c d) = Four (One a) (Two a b) (Three a b c) (Four a b c d) |

604 | + |

605 | +tailsNode :: Node a -> Node (Digit a) |

606 | +tailsNode (Node2 s a b) = Node2 s (Two a b) (One b) |

607 | +tailsNode (Node3 s a b c) = Node3 s (Three a b c) (Two b c) (One c) |

608 | + |

609 | +initsNode :: Node a -> Node (Digit a) |

610 | +initsNode (Node2 s a b) = Node2 s (One a) (Two a b) |

611 | +initsNode (Node3 s a b c) = Node3 s (One a) (Two a b) (Three a b c) |

612 | + |

613 | +{-# SPECIALIZE tailsTree :: (FingerTree (Elem a) -> Elem b) -> FingerTree (Elem a) -> FingerTree (Elem b) #-} |

614 | +{-# SPECIALIZE tailsTree :: (FingerTree (Node a) -> Node b) -> FingerTree (Node a) -> FingerTree (Node b) #-} |

615 | +-- | Given a function to apply to tails of a tree, applies that function to every tail of the specified tree. |

616 | +tailsTree :: (Sized a, Sized b) => (FingerTree a -> b) -> FingerTree a -> FingerTree b |

617 | +tailsTree _ Empty = Empty |

618 | +tailsTree f (Single x) = Single (f (Single x)) |

619 | +tailsTree f (Deep n pr m sf) = |

620 | + Deep n (fmap (\ pr' -> f (deep pr' m sf)) (tailsDigit pr)) |

621 | + (tailsTree f' m) |

622 | + (fmap (f . digitToTree) (tailsDigit sf)) |

623 | + where f' ms = let Just2 node m' = viewLTree ms in |

624 | + fmap (\ pr' -> f (deep pr' m' sf)) (tailsNode node) |

625 | + |

626 | +{-# SPECIALIZE initsTree :: (FingerTree (Elem a) -> Elem b) -> FingerTree (Elem a) -> FingerTree (Elem b) #-} |

627 | +{-# SPECIALIZE initsTree :: (FingerTree (Node a) -> Node b) -> FingerTree (Node a) -> FingerTree (Node b) #-} |

628 | +-- | Given a function to apply to inits of a tree, applies that function to every init of the specified tree. |

629 | +initsTree :: (Sized a, Sized b) => (FingerTree a -> b) -> FingerTree a -> FingerTree b |

630 | +initsTree _ Empty = Empty |

631 | +initsTree f (Single x) = Single (f (Single x)) |

632 | +initsTree f (Deep n pr m sf) = |

633 | + Deep n (fmap (f . digitToTree) (initsDigit pr)) |

634 | + (initsTree f' m) |

635 | + (fmap (f . deep pr m) (initsDigit sf)) |

636 | + where f' ms = let Just2 m' node = viewRTree ms in |

637 | + fmap (\ sf' -> f (deep pr m' sf')) (initsNode node) |

638 | |

639 | hunk ./Data/Sequence.hs 1340 |

640 | +{-# INLINE foldWithIndexL #-} |

641 | +-- | 'foldWithIndexL' is a version of 'foldl' that also provides access to the index of each element. |

642 | +foldWithIndexL :: (b -> Int -> a -> b) -> b -> Seq a -> b |

643 | +foldWithIndexL f z xs = foldl (\ g x i -> i `seq` f (g (i - 1)) i x) (const z) xs (length xs - 1) |

644 | + |

645 | +{-# INLINE foldWithIndexR #-} |

646 | +-- | 'foldWithIndexR' is a version of 'foldr' that also provides access to the index of each element. |

647 | +foldWithIndexR :: (Int -> a -> b -> b) -> b -> Seq a -> b |

648 | +foldWithIndexR f z xs = foldr (\ x g i -> i `seq` f i x (g (i+1))) (const z) xs 0 |

649 | + |

650 | +{-# INLINE [1] foldIndicesR #-} |

651 | +-- | foldIndicesR folds in every satisfying value, from right to left. |

652 | +foldIndicesR :: (a -> Bool) -> Seq a -> (Int -> b -> b) -> b -> b |

653 | +foldIndicesR p xs f z0 = |

654 | + foldl (\ z x n -> n `seq` if p x then f n (z (n-1)) else z (n-1)) |

655 | + (const z0) xs (length xs - 1) |

656 | + |

657 | +{-# INLINE listToMaybe' #-} |

658 | +-- 'listToMaybe\'' is a good consumer version of 'listToMaybe'. |

659 | +listToMaybe' :: [a] -> Maybe a |

660 | +listToMaybe' = foldr (\ x _ -> Just x) Nothing |

661 | + |

662 | +-- | /O(i)/ where /i/ is the prefix length. 'takeWhileL', applied to a predicate @p@ and a sequence @xs@, returns the |

663 | +-- longest prefix (possibly empty) of @xs@ of elements that satisfy @p@. |

664 | +takeWhileL :: (a -> Bool) -> Seq a -> Seq a |

665 | +takeWhileL p = fst . spanl p |

666 | + |

667 | +-- | /O(i)/ where /i/ is the suffix length. 'takeWhileR', applied to a predicate @p@ and a sequence @xs@, returns |

668 | +-- the longest suffix (possibly empty) of @xs@ of elements that satisfy @p@. |

669 | +-- |

670 | +-- @'takeWhileR' p xs@ is equivalent to @'reverse' ('takeWhileL' p ('reverse' xs))@. |

671 | +takeWhileR :: (a -> Bool) -> Seq a -> Seq a |

672 | +takeWhileR p = fst . spanr p |

673 | + |

674 | +-- | /O(i)/ where /i/ is the prefix length. @'dropWhileL' p xs@ returns the suffix remaining after @'takeWhileL' p xs@. |

675 | +dropWhileL :: (a -> Bool) -> Seq a -> Seq a |

676 | +dropWhileL p = snd . spanl p |

677 | + |

678 | +-- | /O(i)/ where /i/ is the suffix length. @'dropWhileR' p xs@ returns the prefix remaining after @'takeWhileR' p xs@. |

679 | +-- |

680 | +-- @'dropWhileR' p xs@ is equivalent to @'reverse' ('dropWhileL' p ('reverse' xs))@. |

681 | +dropWhileR :: (a -> Bool) -> Seq a -> Seq a |

682 | +dropWhileR p = snd . spanr p |

683 | + |

684 | +-- | /O(i)/ where /i/ is the prefix length. 'spanl', applied to a predicate @p@ and a sequence @xs@, returns a tuple |

685 | +-- whose first element is the longest prefix (possibly empty) of @xs@ of elements that satisfy @p@ and the second |

686 | +-- element is the remainder of the sequence. |

687 | +spanl :: (a -> Bool) -> Seq a -> (Seq a, Seq a) |

688 | +spanl p = breakl (not . p) |

689 | + |

690 | +-- | /O(i)/ where /i/ is the suffix length. 'spanr', applied to a predicate @p@ and a sequence @xs@, returns a tuple |

691 | +-- whose /first/ element is the longest /suffix/ (possibly empty) of @xs@ of elements that satisfy @p@ and the second |

692 | +-- element is the remainder of the sequence. |

693 | +spanr :: (a -> Bool) -> Seq a -> (Seq a, Seq a) |

694 | +spanr p = breakr (not . p) |

695 | + |

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

697 | +-- | /O(i)/ where /i/ is the breakpoint index. 'breakl', applied to a predicate @p@ and a sequence @xs@, returns a tuple |

698 | +-- whose first element is the longest prefix (possibly empty) of @xs@ of elements that /do not satisfy/ @p@ and the |

699 | +-- second element is the remainder of the sequence. |

700 | +-- |

701 | +-- @'breakl' p@ is equivalent to @'spanl' (not . p)@. |

702 | +breakl :: (a -> Bool) -> Seq a -> (Seq a, Seq a) |

703 | +breakl p xs = foldr (\ i _ -> splitAt i xs) (xs, empty) (findIndicesL p xs) |

704 | + |

705 | +{-# INLINE breakr #-} |

706 | +-- | @'breakr' p@ is equivalent to @'spanr' (not . p)@. |

707 | +breakr :: (a -> Bool) -> Seq a -> (Seq a, Seq a) |

708 | +breakr p xs = foldr (\ i _ -> flipPair (splitAt i xs)) (xs, empty) (findIndicesR p xs) where |

709 | + flipPair (x, y) = (y, x) |

710 | + |

711 | +-- | /O(n)/. The 'partition' function takes a predicate @p@ and a sequence @xs@ and returns sequences of those |

712 | +-- elements which do and do not satisfy the predicate. |

713 | +partition :: (a -> Bool) -> Seq a -> (Seq a, Seq a) |

714 | +partition p = foldl part (empty, empty) where |

715 | + part (xs, ys) x |

716 | + | p x = (xs |> x, ys) |

717 | + | otherwise = (xs, ys |> x) |

718 | + |

719 | +-- | /O(n)/. The 'filter' function takes a predicate @p@ and a sequence @xs@ and returns a sequence of those |

720 | +-- elements which satisfy the predicate. |

721 | +filter :: (a -> Bool) -> Seq a -> Seq a |

722 | +filter p = foldl (\ xs x -> if p x then xs |> x else xs) empty |

723 | + |

724 | +-- Indexing sequences |

725 | + |

726 | +-- | 'elemIndexL' finds the first index of the specified element, if it is present. |

727 | +elemIndexL :: Eq a => a -> Seq a -> Maybe Int |

728 | +elemIndexL x = findIndexL (x ==) |

729 | + |

730 | +-- | 'elemIndexR' finds the last index of the specified element, if it is present. |

731 | +elemIndexR :: Eq a => a -> Seq a -> Maybe Int |

732 | +elemIndexR x = findIndexR (x ==) |

733 | + |

734 | +-- | 'elemIndicesL' finds the indices of the specified element, in ascending order. |

735 | +elemIndicesL :: Eq a => a -> Seq a -> [Int] |

736 | +elemIndicesL x = findIndicesL (x ==) |

737 | + |

738 | +-- | 'elemIndicesR' finds the indices of the specified element, in descending order. |

739 | +elemIndicesR :: Eq a => a -> Seq a -> [Int] |

740 | +elemIndicesR x = findIndicesR (x ==) |

741 | + |

742 | +-- | @'findIndexL' p xs@ finds the index of the first element that satisfies @p@, if any exist. |

743 | +findIndexL :: (a -> Bool) -> Seq a -> Maybe Int |

744 | +findIndexL p = listToMaybe' . findIndicesL p |

745 | + |

746 | +-- | @'findIndexR' p xs@ finds the index of the last element that satisfies @p@, if any exist. |

747 | +findIndexR :: (a -> Bool) -> Seq a -> Maybe Int |

748 | +findIndexR p = listToMaybe' . findIndicesR p |

749 | + |

750 | +{-# INLINE findIndicesL #-} |

751 | +-- | @'findIndicesL' p@ finds all indices of elements that satisfy @p@, in ascending order. |

752 | +findIndicesL :: (a -> Bool) -> Seq a -> [Int] |

753 | +#if __GLASGOW_HASKELL__ |

754 | +findIndicesL p xs = build (\ c n -> let g i x z = if p x then i `c` z else z in |

755 | + foldWithIndexR g n xs) |

756 | +#else |

757 | +findIndicesL p xs = foldWithIndexR g [] xs where |

758 | + g i x is = if p x then i:is else is |

759 | +#endif |

760 | + |

761 | +{-# INLINE findIndicesR #-} |

762 | +-- | @'findIndicesR' p@ finds all indices of elements that satisfy @p@, in descending order. |

763 | +findIndicesR :: (a -> Bool) -> Seq a -> [Int] |

764 | +#if __GLASGOW_HASKELL__ |

765 | +findIndicesR p xs = build (\ c n -> let g z i x = if p x then i `c` z else z in |

766 | + foldWithIndexL g n xs) |

767 | +#else |

768 | +findIndicesR p xs = foldWithIndexL g [] xs where |

769 | + g is i x = if p x then i:is else is |

770 | +#endif |

771 | + |

772 | ------------------------------------------------------------------------ |

773 | -- Lists |

774 | ------------------------------------------------------------------------ |

775 | hunk ./Data/Sequence.hs 1498 |

776 | (reverseTree (reverseNode f) m) |

777 | (reverseDigit f pr) |

778 | |

779 | +{-# INLINE reverseDigit #-} |

780 | reverseDigit :: (a -> a) -> Digit a -> Digit a |

781 | reverseDigit f (One a) = One (f a) |

782 | reverseDigit f (Two a b) = Two (f b) (f a) |

783 | hunk ./Data/Sequence.hs 1509 |

784 | reverseNode f (Node2 s a b) = Node2 s (f b) (f a) |

785 | reverseNode f (Node3 s a b c) = Node3 s (f c) (f b) (f a) |

786 | |

787 | +------------------------------------------------------------------------ |

788 | +-- Zipping |

789 | +------------------------------------------------------------------------ |

790 | + |

791 | +-- | /O(n)/. 'zip' takes two sequences and returns a sequence of corresponding pairs. |

792 | +-- If one input is short, excess elements of the longer sequence are discarded. |

793 | +zip :: Seq a -> Seq b -> Seq (a, b) |

794 | +zip = zipWith (,) |

795 | + |

796 | +-- | /O(n)/. 'zipWith' generalizes 'zip' by zipping with the function given as the first argument, |

797 | +-- instead of a tupling function. For example, @zipWith (+)@ is applied to two sequences to take |

798 | +-- the sequence of corresponding sums. |

799 | +zipWith :: (a -> b -> c) -> Seq a -> Seq b -> Seq c |

800 | +zipWith f xs ys |

801 | + | length xs <= length ys = zipWith' f xs ys |

802 | + | otherwise = zipWith' (flip f) ys xs |

803 | + where zipWith' f xs ys = snd (mapAccumL ((\ (y :< ys) x -> (ys, f x y)) . viewl) ys xs) |

804 | + |

805 | +zip3 :: Seq a -> Seq b -> Seq c -> Seq (a,b,c) |

806 | +zip3 = zipWith3 (,,) |

807 | + |

808 | +zipWith3 :: (a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d |

809 | +zipWith3 f s1 s2 s3 = zipWith ($) (zipWith f s1 s2) s3 |

810 | + |

811 | +zip4 :: Seq a -> Seq b -> Seq c -> Seq d -> Seq (a,b,c,d) |

812 | +zip4 = zipWith4 (,,,) |

813 | + |

814 | +zipWith4 :: (a -> b -> c -> d -> e) -> Seq a -> Seq b -> Seq c -> Seq d -> Seq e |

815 | +zipWith4 f s1 s2 s3 s4 = zipWith ($) (zipWith ($) (zipWith f s1 s2) s3) s4 |

816 | + |

817 | +------------------------------------------------------------------------ |

818 | +-- Sorting |

819 | +-- |

820 | +-- sort and sortBy are implemented by simple deforestations of |

821 | +-- \ xs -> fromList2 (length xs) . Data.List.sortBy cmp . toList |

822 | +-- which does not get deforested automatically, it would appear. |

823 | +-- |

824 | +-- Unstable sorting is performed by a heap sort implementation based on pairing heaps. Because the |

825 | +-- internal structure of sequences is quite varied, it is difficult to get blocks of elements of |

826 | +-- roughly the same length, which would improve merge sort performance. Pairing heaps, on the other |

827 | +-- hand, are relatively resistant to the effects of merging heaps of wildly different sizes, as |

828 | +-- guaranteed by its amortized constant-time merge operation. Moreover, extensive use of SpecConstr |

829 | +-- transformations can be done on pairing heaps, especially when we're only constructing them |

830 | +-- to immediately be unrolled. |

831 | +-- |

832 | +-- On purely random sequences of length 50000, with no RTS options, I get the following statistics, |

833 | +-- in which heapsort is about 42.5% faster: (all comparisons done with -O2) |

834 | +-- |

835 | +-- Times (ms) min mean +/-sd median max |

836 | +-- to/from list: 103.802 108.572 7.487 106.436 143.339 |

837 | +-- unstable heapsort: 60.686 62.968 4.275 61.187 79.151 |

838 | +-- |

839 | +-- Heapsort, it would seem, is less of a memory hog than Data.List.sortBy. The gap is narrowed |

840 | +-- when more memory is available, but heapsort still wins, 15% faster, with +RTS -H128m: |

841 | +-- |

842 | +-- Times (ms) min mean +/-sd median max |

843 | +-- to/from list: 42.692 45.074 2.596 44.600 56.601 |

844 | +-- unstable heapsort: 37.100 38.344 3.043 37.715 55.526 |

845 | +-- |

846 | +-- In addition, on strictly increasing sequences the gap is even wider than normal; heapsort is |

847 | +-- 68.5% faster with no RTS options: |

848 | +-- Times (ms) min mean +/-sd median max |

849 | +-- to/from list: 52.236 53.574 1.987 53.034 62.098 |

850 | +-- unstable heapsort: 16.433 16.919 0.931 16.681 21.622 |

851 | +-- |

852 | +-- This may be attributed to the elegant nature of the pairing heap. |

853 | +-- |

854 | +-- wasserman.louis@gmail.com, 7/20/09 |

855 | +------------------------------------------------------------------------ |

856 | + |

857 | +-- | /O(n log n)/. 'sort' sorts the specified 'Seq' by the natural ordering of its elements. The sort is stable. |

858 | +-- If a stable sort is not required, 'unstableSort' can be considerably faster, and in particular uses less memory. |

859 | +sort :: Ord a => Seq a -> Seq a |

860 | +sort = sortBy compare |

861 | + |

862 | +-- | /O(n log n)/. 'sortBy' sorts the specified 'Seq' according to the specified comparator. The sort is stable. |

863 | +-- If a stable sort is not required, 'unstableSortBy' can be considerably faster, and in particular uses less memory. |

864 | +sortBy :: (a -> a -> Ordering) -> Seq a -> Seq a |

865 | +-- fromList . Data.List.sortBy cmp . toList doesn't actually deforest well, so I did so manually and got a moderate |

866 | +-- performance boost. |

867 | +sortBy cmp xs = case foldr (\ x -> ([x]:)) [] xs of |

868 | + [] -> empty |

869 | + ys:yss -> fromList2 (length xs) (merger0 ys yss) |

870 | + where xs@(x:xs1) <> ys@(y:ys1) = case cmp x y of |

871 | + GT -> y:(xs <> ys1) |

872 | + _ -> x:(xs1 <> ys) |

873 | + [] <> ys = ys |

874 | + xs <> [] = xs |

875 | + merger (xs1:xs2:xss) = (xs1 <> xs2) : merger xss |

876 | + merger xss = xss |

877 | + merger0 xs1 (xs2:xss) = merger0 (xs1 <> xs2) (merger xss) |

878 | + merger0 xs [] = xs |

879 | + |

880 | +-- | /O(n log n)/. 'unstableSort' sorts the specified 'Seq' by the natural ordering of its elements, but the sort is not stable. |

881 | +-- This algorithm is frequently faster and uses less memory than 'sort', and performs extremely well -- frequently twice as fast as |

882 | +-- 'sort' -- when the sequence is already nearly sorted. |

883 | +unstableSort :: Ord a => Seq a -> Seq a |

884 | +unstableSort = unstableSortBy compare |

885 | + |

886 | +-- | /O(n log n)/. A generalization of 'unstableSort', 'unstableSortBy' takes an arbitrary comparator and sorts the specified sequence. |

887 | +-- The sort is not stable. This algorithm is frequently faster and uses less memory than 'sortBy', and performs extremely well -- |

888 | +-- frequently twice as fast as 'sortBy' -- when the sequence is already nearly sorted. |

889 | +unstableSortBy :: (a -> a -> Ordering) -> Seq a -> Seq a |

890 | +unstableSortBy cmp (Seq xs) = fromList2 (size xs) $ maybe [] (unrollPQ cmp) $ toPQ cmp (\ (Elem x) -> PQueue x Nil) xs |

891 | + |

892 | +fromList2 :: Int -> [a] -> Seq a |

893 | +-- fromList2, given a list and its length, constructs a completely balanced Seq whose elements are that list |

894 | +-- using the applicativeTree generalization. |

895 | +fromList2 n = execState (replicateA n (State (\ (x:xs) -> (xs, x)))) |

896 | + |

897 | +-- | A 'PQueue' is a simple pairing heap. |

898 | +data PQueue e = PQueue e (PQL e) |

899 | +data PQL e = Nil | {-# UNPACK #-} !(PQueue e) :& PQL e |

900 | + |

901 | +infixr 8 :& |

902 | + |

903 | +#if TESTING |

904 | + |

905 | +instance Functor PQueue where |

906 | + fmap f (PQueue x ts) = PQueue (f x) (fmap f ts) |

907 | + |

908 | +instance Functor PQL where |

909 | + fmap f (q :& qs) = fmap f q :& fmap f qs |

910 | + fmap _ Nil = Nil |

911 | + |

912 | +instance Show e => Show (PQueue e) where |

913 | + show = unlines . draw . fmap show |

914 | + |

915 | +-- borrowed wholesale from Data.Tree, as Data.Tree actually depends on Data.Sequence |

916 | +draw :: PQueue String -> [String] |

917 | +draw (PQueue x ts0) = x : drawSubTrees ts0 |

918 | + where drawSubTrees Nil = [] |

919 | + drawSubTrees (t :& Nil) = |

920 | + "|" : shift "`- " " " (draw t) |

921 | + drawSubTrees (t :& ts) = |

922 | + "|" : shift "+- " "| " (draw t) ++ drawSubTrees ts |

923 | + |

924 | + shift first other = Data.List.zipWith (++) (first : repeat other) |

925 | +#endif |

926 | + |

927 | +-- | 'unrollPQ', given a comparator function, unrolls a 'PQueue' into a sorted list. |

928 | +unrollPQ :: (e -> e -> Ordering) -> PQueue e -> [e] |

929 | +unrollPQ cmp = unrollPQ' where |

930 | + {-# INLINE unrollPQ' #-} |

931 | + unrollPQ' (PQueue x ts) = x:mergePQs0 ts |

932 | + (<>) = mergePQ cmp |

933 | + mergePQs0 Nil = [] |

934 | + mergePQs0 (t :& Nil) = unrollPQ' t |

935 | + mergePQs0 (t1 :& t2 :& ts) = mergePQs (t1 <> t2) ts |

936 | + mergePQs t ts = t `seq` case ts of |

937 | + Nil -> unrollPQ' t |

938 | + t1 :& Nil -> unrollPQ' (t <> t1) |

939 | + t1 :& t2 :& ts -> mergePQs (t <> (t1 <> t2)) ts |

940 | + |

941 | +-- | 'toPQ', given an ordering function and a mechanism for queueifying elements, converts a 'FingerTree' to a 'PQueue'. |

942 | +toPQ :: (e -> e -> Ordering) -> (a -> PQueue e) -> FingerTree a -> Maybe (PQueue e) |

943 | +toPQ _ _ Empty = Nothing |

944 | +toPQ _ f (Single x) = Just (f x) |

945 | +toPQ cmp f (Deep _ pr m sf) = Just (maybe (pr' <> sf') ((pr' <> sf') <>) (toPQ cmp fNode m)) where |

946 | + fDigit d = case fmap f d of |

947 | + One a -> a |

948 | + Two a b -> a <> b |

949 | + Three a b c -> a <> b <> c |

950 | + Four a b c d -> (a <> b) <> (c <> d) |

951 | + (<>) = mergePQ cmp |

952 | + fNode = fDigit . nodeToDigit |

953 | + pr' = fDigit pr |

954 | + sf' = fDigit sf |

955 | + |

956 | +-- | 'mergePQ' merges two 'PQueue's. |

957 | +mergePQ :: (a -> a -> Ordering) -> PQueue a -> PQueue a -> PQueue a |

958 | +mergePQ cmp q1@(PQueue x1 ts1) q2@(PQueue x2 ts2) |

959 | + | cmp x1 x2 == GT = PQueue x2 (q1 :& ts2) |

960 | + | otherwise = PQueue x1 (q2 :& ts1) |

961 | + |

962 | #if TESTING |

963 | |

964 | ------------------------------------------------------------------------ |

965 | hunk ./Data/Sequence.hs 1692 |

966 | |

967 | instance Arbitrary a => Arbitrary (Seq a) where |

968 | arbitrary = liftM Seq arbitrary |

969 | - coarbitrary (Seq x) = coarbitrary x |

970 | + shrink (Seq x) = map Seq (shrink x) |

971 | |

972 | instance Arbitrary a => Arbitrary (Elem a) where |

973 | arbitrary = liftM Elem arbitrary |

974 | hunk ./Data/Sequence.hs 1696 |

975 | - coarbitrary (Elem x) = coarbitrary x |

976 | |

977 | instance (Arbitrary a, Sized a) => Arbitrary (FingerTree a) where |

978 | arbitrary = sized arb |

979 | hunk ./Data/Sequence.hs 1704 |

980 | arb 1 = liftM Single arbitrary |

981 | arb n = liftM3 deep arbitrary (arb (n `div` 2)) arbitrary |

982 | |

983 | - coarbitrary Empty = variant 0 |

984 | - coarbitrary (Single x) = variant 1 . coarbitrary x |

985 | - coarbitrary (Deep _ pr m sf) = |

986 | - variant 2 . coarbitrary pr . coarbitrary m . coarbitrary sf |

987 | + shrink (Deep _ (One a) Empty (One b)) = [Single a, Single b] |

988 | + shrink (Deep _ pr m sf) = [deep pr' m sf | pr' <- shrink pr] ++ [deep pr m' sf | m' <- shrink m] ++ [deep pr m sf' | sf' <- shrink sf] |

989 | + shrink (Single x) = map Single (shrink x) |

990 | + shrink Empty = [] |

991 | |

992 | instance (Arbitrary a, Sized a) => Arbitrary (Node a) where |

993 | arbitrary = oneof [ |

994 | hunk ./Data/Sequence.hs 1714 |

995 | liftM2 node2 arbitrary arbitrary, |

996 | liftM3 node3 arbitrary arbitrary arbitrary] |

997 | |

998 | - coarbitrary (Node2 _ a b) = variant 0 . coarbitrary a . coarbitrary b |

999 | - coarbitrary (Node3 _ a b c) = |

1000 | - variant 1 . coarbitrary a . coarbitrary b . coarbitrary c |

1001 | + shrink (Node2 _ a b) = [node2 a' b | a' <- shrink a] ++ [node2 a b' | b' <- shrink b] |

1002 | + shrink (Node3 _ a b c) = [node2 a b, node2 a c, node2 b c] ++ |

1003 | + [node3 a' b c | a' <- shrink a] ++ [node3 a b' c | b' <- shrink b] ++ [node3 a b c' | c' <- shrink c] |

1004 | |

1005 | instance Arbitrary a => Arbitrary (Digit a) where |

1006 | arbitrary = oneof [ |

1007 | hunk ./Data/Sequence.hs 1724 |

1008 | liftM2 Two arbitrary arbitrary, |

1009 | liftM3 Three arbitrary arbitrary arbitrary, |

1010 | liftM4 Four arbitrary arbitrary arbitrary arbitrary] |

1011 | - |

1012 | - coarbitrary (One a) = variant 0 . coarbitrary a |

1013 | - coarbitrary (Two a b) = variant 1 . coarbitrary a . coarbitrary b |

1014 | - coarbitrary (Three a b c) = |

1015 | - variant 2 . coarbitrary a . coarbitrary b . coarbitrary c |

1016 | - coarbitrary (Four a b c d) = |

1017 | - variant 3 . coarbitrary a . coarbitrary b . coarbitrary c . coarbitrary d |

1018 | + |

1019 | + shrink (One a) = map One (shrink a) |

1020 | + shrink (Two a b) = [One a, One b] |

1021 | + shrink (Three a b c) = [Two a b, Two a c, Two b c] |

1022 | + shrink (Four a b c d) = [Three a b c, Three a b d, Three a c d, Three b c d] |

1023 | |

1024 | ------------------------------------------------------------------------ |

1025 | -- Valid trees |

1026 | hunk ./Data/Sequence.hs 1750 |

1027 | s == size pr + size m + size sf && valid pr && valid m && valid sf |

1028 | |

1029 | instance (Sized a, Valid a) => Valid (Node a) where |

1030 | - valid (Node2 s a b) = s == size a + size b && valid a && valid b |

1031 | - valid (Node3 s a b c) = |

1032 | - s == size a + size b + size c && valid a && valid b && valid c |

1033 | + valid node = (size node == foldl1 (+) (fmap size node)) && (all valid node) |

1034 | |

1035 | instance Valid a => Valid (Digit a) where |

1036 | hunk ./Data/Sequence.hs 1753 |

1037 | - valid (One a) = valid a |

1038 | - valid (Two a b) = valid a && valid b |

1039 | - valid (Three a b c) = valid a && valid b && valid c |

1040 | - valid (Four a b c d) = valid a && valid b && valid c && valid d |

1041 | + valid = all valid |

1042 | |

1043 | #endif |

1044 | hunk ./Data/Set.hs 122 |

1045 | |

1046 | #if __GLASGOW_HASKELL__ |

1047 | import Text.Read |

1048 | -import Data.Data (Data(..), mkNoRepType, gcast1) |

1049 | +import Data.Data (Data(..), mkNorepType, gcast1) |

1050 | #endif |

1051 | |

1052 | {-------------------------------------------------------------------- |

1053 | hunk ./Data/Set.hs 165 |

1054 | gfoldl f z set = z fromList `f` (toList set) |

1055 | toConstr _ = error "toConstr" |

1056 | gunfold _ _ = error "gunfold" |

1057 | - dataTypeOf _ = mkNoRepType "Data.Set.Set" |

1058 | + dataTypeOf _ = mkNorepType "Data.Set.Set" |

1059 | dataCast1 f = gcast1 f |

1060 | |

1061 | #endif |

1062 | hunk ./containers.cabal 23 |

1063 | location: http://darcs.haskell.org/packages/containers/ |

1064 | |

1065 | Library { |

1066 | - build-depends: base, array |

1067 | + build-depends: base >= 4.0.0.0, array |

1068 | exposed-modules: |

1069 | Data.Graph |

1070 | Data.IntMap |

1071 | } |

1072 | |

1073 | Context: |

1074 | |

1075 | [Use left/right rather than old/new to describe the arguments to unionWithKey |

1076 | Ian Lynagh <igloo@earth.li>**20090208192132 |

1077 | Fixes trac #3002. |

1078 | ] |

1079 | [help nhc98 by making import decl more explicit |

1080 | Malcolm.Wallace@cs.york.ac.uk**20090203142144] |

1081 | [Add instance Data.Traversable for IntMap |

1082 | Matti Niemenmaa <matti.niemenmaa+darcs@iki.fi>**20090116190353 |

1083 | Ignore-this: df88a286935926aecec3f8a5dd291699 |

1084 | ] |

1085 | [Require Cabal version >= 1.6 |

1086 | Ian Lynagh <igloo@earth.li>**20090122011256] |

1087 | [Add "bug-reports" and "source-repository" info to the Cabal file |

1088 | Ian Lynagh <igloo@earth.li>**20090121182106] |

1089 | [Fix warnings in containers |

1090 | Ian Lynagh <igloo@earth.li>**20090116200251] |

1091 | [optimize IntMap/IntSet findMin/findMax |

1092 | sedillard@gmail.com**20081002152055] |

1093 | [O(n) fromAscList IntSet / IntMap |

1094 | sedillard@gmail.com**20080521195941 |

1095 | |

1096 | Added algorithm by Scott Dillard and Bertram Felgenhauer to build IntSets and |

1097 | IntMaps from sorted input in linear time. Also changed quickcheck prop_Ordered |

1098 | (no longer a tautology!) to include negative and duplicate keys. |

1099 | |

1100 | ] |

1101 | [correct type for IntMap.intersectionWith[Key] |

1102 | sedillard@gmail.com**20081002144828] |

1103 | [Export mapAccumRWithKey from Map and IntMap (Trac #2769) |

1104 | matti.niemenmaa+darcs@iki.fi**20081210160205] |

1105 | [Bump the version number to 0.2.0.1, to work-around cabal-install problems |

1106 | Ian Lynagh <igloo@earth.li>**20081212201829] |

1107 | [Fix #2760: change mkNorepType to mkNoRepType |

1108 | 'Jose Pedro Magalhaes <jpm@cs.uu.nl>'**20081202083424] |

1109 | [Doc fix, from hackage trac #378 |

1110 | Ian Lynagh <igloo@earth.li>**20081024143949] |

1111 | [import Data.Data instead of Data.Generics.*, eliminating the dependency on syb |

1112 | Ross Paterson <ross@soi.city.ac.uk>**20081005002559] |

1113 | [fixed typo in highestBitMask |

1114 | sedillard@gmail.com**20081002215438] |

1115 | [export Data.Map.toDescList, foldlWithKey, and foldrWithKey (trac ticket 2580) |

1116 | qdunkan@gmail.com**20080922213200 |

1117 | |

1118 | toDescList was previously implemented, but not exported. |

1119 | |

1120 | foldlWithKey was previously implemented, but not exported. It can be used to |

1121 | implement toDescList. |

1122 | |

1123 | foldrWithKey is already exported as foldWithKey, but foldrWithKey is explicitly |

1124 | the mirror of foldlWithKey, and foldWithKey kept for compatibility. |

1125 | ] |

1126 | [Bump version number to 0.2.0.0 |

1127 | Ian Lynagh <igloo@earth.li>**20080920160016] |

1128 | [TAG 6.10 branch has been forked |

1129 | Ian Lynagh <igloo@earth.li>**20080919123438] |

1130 | [Fixed typo in updateMinWithKey / updateMaxWithKey |

1131 | sedillard@gmail.com**20080704054350] |

1132 | [follow library changes |

1133 | Ian Lynagh <igloo@earth.li>**20080903223610] |

1134 | [add include/Typeable.h to extra-source-files |

1135 | Ross Paterson <ross@soi.city.ac.uk>**20080831181402] |

1136 | [fix cabal build-depends for nhc98 |

1137 | Malcolm.Wallace@cs.york.ac.uk**20080828104248] |

1138 | [Add a dep on syb |

1139 | Ian Lynagh <igloo@earth.li>**20080825214314] |

1140 | [add category field |

1141 | Ross Paterson <ross@soi.city.ac.uk>**20080824003013] |

1142 | [we depend on st, now split off from base |

1143 | Ian Lynagh <igloo@earth.li>**20080823223053] |

1144 | [specialize functions that fail in a Monad to Maybe (proposal #2309) |

1145 | Ross Paterson <ross@soi.city.ac.uk>**20080722154812 |

1146 | |

1147 | Specialize functions signatures like |

1148 | |

1149 | lookup :: (Monad m, Ord k) => k -> Map k a -> m a |

1150 | to |

1151 | lookup :: (Ord k) => k -> Map k a -> Maybe a |

1152 | |

1153 | for simplicity and safety. No information is lost, as each of these |

1154 | functions had only one use of fail, which is now changed to Nothing. |

1155 | ] |

1156 | [tighter description of split (addresses #2447) |

1157 | Ross Paterson <ross@soi.city.ac.uk>**20080717064838] |

1158 | [Make warning-clean with GHC again |

1159 | Ian Lynagh <igloo@earth.li>**20080623232023 |

1160 | With any luck we have now converged on a solution that works everywhere! |

1161 | ] |

1162 | [Undo more Data.Typeable-related breakage for non-ghc. |

1163 | Malcolm.Wallace@cs.york.ac.uk**20080623092757] |

1164 | [Placate GHC with explicit import lists |

1165 | Ian Lynagh <igloo@earth.li>**20080620183926] |

1166 | [undo breakage caused by -Wall cleaning |

1167 | Malcolm.Wallace@cs.york.ac.uk**20080620093922 |

1168 | The import of Data.Typeable is still required, at least for non-GHC. |

1169 | ] |

1170 | [Make the package -Wall clean |

1171 | Ian Lynagh <igloo@earth.li>**20080618233627] |

1172 | [List particular extensions rather than -fglasgow-exts |

1173 | Ian Lynagh <igloo@earth.li>**20080616232035] |

1174 | [Avoid using deprecated flags |

1175 | Ian Lynagh <igloo@earth.li>**20080616145241] |

1176 | [TAG 2008-05-28 |

1177 | Ian Lynagh <igloo@earth.li>**20080528004309] |

1178 | Patch bundle hash: |

1179 | 6c3e5d64b47db0d11f2d860c23ad3d77430e8da6 |