projects
/
haskell-directory.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Remove Control.Parallel*, now in package parallel
[haskell-directory.git]
/
Data
/
Sequence.hs
diff --git
a/Data/Sequence.hs
b/Data/Sequence.hs
index
3d38011
..
318dc20
100644
(file)
--- a/
Data/Sequence.hs
+++ b/
Data/Sequence.hs
@@
-22,7
+22,7
@@
--
-- * Ralf Hinze and Ross Paterson,
-- \"Finger trees: a simple general-purpose data structure\",
--
-- * Ralf Hinze and Ross Paterson,
-- \"Finger trees: a simple general-purpose data structure\",
--- to appear in /Journal of Functional Programming/.
+-- /Journal of Functional Programming/ 16:2 (2006) pp 197-217.
-- <http://www.soi.city.ac.uk/~ross/papers/FingerTree.html>
--
-- /Note/: Many of these operations have the same names as similar
-- <http://www.soi.city.ac.uk/~ross/papers/FingerTree.html>
--
-- /Note/: Many of these operations have the same names as similar
@@
-41,6
+41,9
@@
module Data.Sequence (
(><), -- :: Seq a -> Seq a -> Seq a
fromList, -- :: [a] -> Seq a
-- * Deconstruction
(><), -- :: Seq a -> Seq a -> Seq a
fromList, -- :: [a] -> Seq a
-- * Deconstruction
+ -- | Additional functions for deconstructing sequences are available
+ -- via the 'Foldable' instance of 'Seq'.
+
-- ** Queries
null, -- :: Seq a -> Bool
length, -- :: Seq a -> Int
-- ** Queries
null, -- :: Seq a -> Bool
length, -- :: Seq a -> Int
@@
-67,7
+70,7
@@
import Prelude hiding (
null, length, take, drop, splitAt, foldl, foldl1, foldr, foldr1,
reverse)
import qualified Data.List (foldl')
null, length, take, drop, splitAt, foldl, foldl1, foldr, foldr1,
reverse)
import qualified Data.List (foldl')
-import Control.Applicative (Applicative(..))
+import Control.Applicative (Applicative(..), (<$>))
import Control.Monad (MonadPlus(..))
import Data.Monoid (Monoid(..))
import Data.Foldable
import Control.Monad (MonadPlus(..))
import Data.Monoid (Monoid(..))
import Data.Foldable
@@
-100,7
+103,7
@@
class Sized a where
newtype Seq a = Seq (FingerTree (Elem a))
instance Functor Seq where
newtype Seq a = Seq (FingerTree (Elem a))
instance Functor Seq where
- fmap = fmapDefault
+ fmap f (Seq xs) = Seq (fmap (fmap f) xs)
instance Foldable Seq where
foldr f z (Seq xs) = foldr (flip (foldr f)) z xs
instance Foldable Seq where
foldr f z (Seq xs) = foldr (flip (foldr f)) z xs
@@
-223,6
+226,12
@@
instance Foldable FingerTree where
foldl1 f (Deep _ pr m sf) =
foldl f (foldl (foldl f) (foldl1 f pr) m) sf
foldl1 f (Deep _ pr m sf) =
foldl f (foldl (foldl f) (foldl1 f pr) m) sf
+instance Functor FingerTree where
+ fmap _ Empty = Empty
+ fmap f (Single x) = Single (f x)
+ fmap f (Deep v pr m sf) =
+ Deep v (fmap f pr) (fmap (fmap f) m) (fmap f sf)
+
instance Traversable FingerTree where
traverse _ Empty = pure Empty
traverse f (Single x) = Single <$> f x
instance Traversable FingerTree where
traverse _ Empty = pure Empty
traverse f (Single x) = Single <$> f x
@@
-268,6
+277,9
@@
instance Foldable Digit where
foldl1 f (Three a b c) = (a `f` b) `f` c
foldl1 f (Four a b c d) = ((a `f` b) `f` c) `f` d
foldl1 f (Three a b c) = (a `f` b) `f` c
foldl1 f (Four a b c d) = ((a `f` b) `f` c) `f` d
+instance Functor Digit where
+ fmap = fmapDefault
+
instance Traversable Digit where
traverse f (One a) = One <$> f a
traverse f (Two a b) = Two <$> f a <*> f b
instance Traversable Digit where
traverse f (One a) = One <$> f a
traverse f (Two a b) = Two <$> f a <*> f b
@@
-303,6
+315,9
@@
instance Foldable Node where
foldl f z (Node2 _ a b) = (z `f` a) `f` b
foldl f z (Node3 _ a b c) = ((z `f` a) `f` b) `f` c
foldl f z (Node2 _ a b) = (z `f` a) `f` b
foldl f z (Node3 _ a b c) = ((z `f` a) `f` b) `f` c
+instance Functor Node where
+ fmap = fmapDefault
+
instance Traversable Node where
traverse f (Node2 v a b) = Node2 v <$> f a <*> f b
traverse f (Node3 v a b c) = Node3 v <$> f a <*> f b <*> f c
instance Traversable Node where
traverse f (Node2 v a b) = Node2 v <$> f a <*> f b
traverse f (Node3 v a b c) = Node3 v <$> f a <*> f b <*> f c
@@
-774,7
+789,7
@@
viewRTree (Deep s pr m (Four w x y z)) =
-- | /O(log(min(i,n-i)))/. The element at the specified position
index :: Seq a -> Int -> a
index (Seq xs) i
-- | /O(log(min(i,n-i)))/. The element at the specified position
index :: Seq a -> Int -> a
index (Seq xs) i
- | 0 <= i && i < size xs = case lookupTree (-i) xs of
+ | 0 <= i && i < size xs = case lookupTree i xs of
Place _ (Elem x) -> x
| otherwise = error "index out of bounds"
Place _ (Elem x) -> x
| otherwise = error "index out of bounds"
@@
-789,49
+804,49
@@
lookupTree :: Sized a => Int -> FingerTree a -> Place a
lookupTree _ Empty = error "lookupTree of empty tree"
lookupTree i (Single x) = Place i x
lookupTree i (Deep _ pr m sf)
lookupTree _ Empty = error "lookupTree of empty tree"
lookupTree i (Single x) = Place i x
lookupTree i (Deep _ pr m sf)
- | vpr > 0 = lookupDigit i pr
- | vm > 0 = case lookupTree vpr m of
+ | i < spr = lookupDigit i pr
+ | i < spm = case lookupTree (i - spr) m of
Place i' xs -> lookupNode i' xs
Place i' xs -> lookupNode i' xs
- | otherwise = lookupDigit vm sf
- where vpr = i + size pr
- vm = vpr + size m
+ | otherwise = lookupDigit (i - spm) sf
+ where spr = size pr
+ spm = spr + size m
{-# SPECIALIZE lookupNode :: Int -> Node (Elem a) -> Place (Elem a) #-}
{-# SPECIALIZE lookupNode :: Int -> Node (Node a) -> Place (Node a) #-}
lookupNode :: Sized a => Int -> Node a -> Place a
lookupNode i (Node2 _ a b)
{-# SPECIALIZE lookupNode :: Int -> Node (Elem a) -> Place (Elem a) #-}
{-# SPECIALIZE lookupNode :: Int -> Node (Node a) -> Place (Node a) #-}
lookupNode :: Sized a => Int -> Node a -> Place a
lookupNode i (Node2 _ a b)
- | va > 0 = Place i a
- | otherwise = Place va b
- where va = i + size a
+ | i < sa = Place i a
+ | otherwise = Place (i - sa) b
+ where sa = size a
lookupNode i (Node3 _ a b c)
lookupNode i (Node3 _ a b c)
- | va > 0 = Place i a
- | vab > 0 = Place va b
- | otherwise = Place vab c
- where va = i + size a
- vab = va + size b
+ | i < sa = Place i a
+ | i < sab = Place (i - sa) b
+ | otherwise = Place (i - sab) c
+ where sa = size a
+ sab = sa + size b
{-# SPECIALIZE lookupDigit :: Int -> Digit (Elem a) -> Place (Elem a) #-}
{-# SPECIALIZE lookupDigit :: Int -> Digit (Node a) -> Place (Node a) #-}
lookupDigit :: Sized a => Int -> Digit a -> Place a
lookupDigit i (One a) = Place i a
lookupDigit i (Two a b)
{-# SPECIALIZE lookupDigit :: Int -> Digit (Elem a) -> Place (Elem a) #-}
{-# SPECIALIZE lookupDigit :: Int -> Digit (Node a) -> Place (Node a) #-}
lookupDigit :: Sized a => Int -> Digit a -> Place a
lookupDigit i (One a) = Place i a
lookupDigit i (Two a b)
- | va > 0 = Place i a
- | otherwise = Place va b
- where va = i + size a
+ | i < sa = Place i a
+ | otherwise = Place (i - sa) b
+ where sa = size a
lookupDigit i (Three a b c)
lookupDigit i (Three a b c)
- | va > 0 = Place i a
- | vab > 0 = Place va b
- | otherwise = Place vab c
- where va = i + size a
- vab = va + size b
+ | i < sa = Place i a
+ | i < sab = Place (i - sa) b
+ | otherwise = Place (i - sab) c
+ where sa = size a
+ sab = sa + size b
lookupDigit i (Four a b c d)
lookupDigit i (Four a b c d)
- | va > 0 = Place i a
- | vab > 0 = Place va b
- | vabc > 0 = Place vab c
- | otherwise = Place vabc d
- where va = i + size a
- vab = va + size b
- vabc = vab + size c
+ | i < sa = Place i a
+ | i < sab = Place (i - sa) b
+ | i < sabc = Place (i - sab) c
+ | otherwise = Place (i - sabc) d
+ where sa = size a
+ sab = sa + size b
+ sabc = sab + size c
-- | /O(log(min(i,n-i)))/. Replace the element at the specified position
update :: Int -> a -> Seq a -> Seq a
-- | /O(log(min(i,n-i)))/. Replace the element at the specified position
update :: Int -> a -> Seq a -> Seq a
@@
-840,7
+855,7
@@
update i x = adjust (const x) i
-- | /O(log(min(i,n-i)))/. Update the element at the specified position
adjust :: (a -> a) -> Int -> Seq a -> Seq a
adjust f i (Seq xs)
-- | /O(log(min(i,n-i)))/. Update the element at the specified position
adjust :: (a -> a) -> Int -> Seq a -> Seq a
adjust f i (Seq xs)
- | 0 <= i && i < size xs = Seq (adjustTree (const (fmap f)) (-i) xs)
+ | 0 <= i && i < size xs = Seq (adjustTree (const (fmap f)) i xs)
| otherwise = Seq xs
{-# SPECIALIZE adjustTree :: (Int -> Elem a -> Elem a) -> Int -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
| otherwise = Seq xs
{-# SPECIALIZE adjustTree :: (Int -> Elem a -> Elem a) -> Int -> FingerTree (Elem a) -> FingerTree (Elem a) #-}
@@
-850,48
+865,48
@@
adjustTree :: Sized a => (Int -> a -> a) ->
adjustTree _ _ Empty = error "adjustTree of empty tree"
adjustTree f i (Single x) = Single (f i x)
adjustTree f i (Deep s pr m sf)
adjustTree _ _ Empty = error "adjustTree of empty tree"
adjustTree f i (Single x) = Single (f i x)
adjustTree f i (Deep s pr m sf)
- | vpr > 0 = Deep s (adjustDigit f i pr) m sf
- | vm > 0 = Deep s pr (adjustTree (adjustNode f) vpr m) sf
- | otherwise = Deep s pr m (adjustDigit f vm sf)
- where vpr = i + size pr
- vm = vpr + size m
+ | i < spr = Deep s (adjustDigit f i pr) m sf
+ | i < spm = Deep s pr (adjustTree (adjustNode f) (i - spr) m) sf
+ | otherwise = Deep s pr m (adjustDigit f (i - spm) sf)
+ where spr = size pr
+ spm = spr + size m
{-# SPECIALIZE adjustNode :: (Int -> Elem a -> Elem a) -> Int -> Node (Elem a) -> Node (Elem a) #-}
{-# SPECIALIZE adjustNode :: (Int -> Node a -> Node a) -> Int -> Node (Node a) -> Node (Node a) #-}
adjustNode :: Sized a => (Int -> a -> a) -> Int -> Node a -> Node a
adjustNode f i (Node2 s a b)
{-# SPECIALIZE adjustNode :: (Int -> Elem a -> Elem a) -> Int -> Node (Elem a) -> Node (Elem a) #-}
{-# SPECIALIZE adjustNode :: (Int -> Node a -> Node a) -> Int -> Node (Node a) -> Node (Node a) #-}
adjustNode :: Sized a => (Int -> a -> a) -> Int -> Node a -> Node a
adjustNode f i (Node2 s a b)
- | va > 0 = Node2 s (f i a) b
- | otherwise = Node2 s a (f va b)
- where va = i + size a
+ | i < sa = Node2 s (f i a) b
+ | otherwise = Node2 s a (f (i - sa) b)
+ where sa = size a
adjustNode f i (Node3 s a b c)
adjustNode f i (Node3 s a b c)
- | va > 0 = Node3 s (f i a) b c
- | vab > 0 = Node3 s a (f va b) c
- | otherwise = Node3 s a b (f vab c)
- where va = i + size a
- vab = va + size b
+ | i < sa = Node3 s (f i a) b c
+ | i < sab = Node3 s a (f (i - sa) b) c
+ | otherwise = Node3 s a b (f (i - sab) c)
+ where sa = size a
+ sab = sa + size b
{-# SPECIALIZE adjustDigit :: (Int -> Elem a -> Elem a) -> Int -> Digit (Elem a) -> Digit (Elem a) #-}
{-# SPECIALIZE adjustDigit :: (Int -> Node a -> Node a) -> Int -> Digit (Node a) -> Digit (Node a) #-}
adjustDigit :: Sized a => (Int -> a -> a) -> Int -> Digit a -> Digit a
adjustDigit f i (One a) = One (f i a)
adjustDigit f i (Two a b)
{-# SPECIALIZE adjustDigit :: (Int -> Elem a -> Elem a) -> Int -> Digit (Elem a) -> Digit (Elem a) #-}
{-# SPECIALIZE adjustDigit :: (Int -> Node a -> Node a) -> Int -> Digit (Node a) -> Digit (Node a) #-}
adjustDigit :: Sized a => (Int -> a -> a) -> Int -> Digit a -> Digit a
adjustDigit f i (One a) = One (f i a)
adjustDigit f i (Two a b)
- | va > 0 = Two (f i a) b
- | otherwise = Two a (f va b)
- where va = i + size a
+ | i < sa = Two (f i a) b
+ | otherwise = Two a (f (i - sa) b)
+ where sa = size a
adjustDigit f i (Three a b c)
adjustDigit f i (Three a b c)
- | va > 0 = Three (f i a) b c
- | vab > 0 = Three a (f va b) c
- | otherwise = Three a b (f vab c)
- where va = i + size a
- vab = va + size b
+ | i < sa = Three (f i a) b c
+ | i < sab = Three a (f (i - sa) b) c
+ | otherwise = Three a b (f (i - sab) c)
+ where sa = size a
+ sab = sa + size b
adjustDigit f i (Four a b c d)
adjustDigit f i (Four a b c d)
- | va > 0 = Four (f i a) b c d
- | vab > 0 = Four a (f va b) c d
- | vabc > 0 = Four a b (f vab c) d
- | otherwise = Four a b c (f vabc d)
- where va = i + size a
- vab = va + size b
- vabc = vab + size c
+ | i < sa = Four (f i a) b c d
+ | i < sab = Four a (f (i - sa) b) c d
+ | i < sabc = Four a b (f (i - sab) c) d
+ | otherwise = Four a b c (f (i- sabc) d)
+ where sa = size a
+ sab = sa + size b
+ sabc = sab + size c
-- Splitting
-- Splitting
@@
-914,7
+929,7
@@
split i Empty = i `seq` (Empty, Empty)
split i xs
| size xs > i = (l, consTree x r)
| otherwise = (xs, Empty)
split i xs
| size xs > i = (l, consTree x r)
| otherwise = (xs, Empty)
- where Split l x r = splitTree (-i) xs
+ where Split l x r = splitTree i xs
data Split t a = Split t a t
#if TESTING
data Split t a = Split t a t
#if TESTING
@@
-927,15
+942,16
@@
splitTree :: Sized a => Int -> FingerTree a -> Split (FingerTree a) a
splitTree _ Empty = error "splitTree of empty tree"
splitTree i (Single x) = i `seq` Split Empty x Empty
splitTree i (Deep _ pr m sf)
splitTree _ Empty = error "splitTree of empty tree"
splitTree i (Single x) = i `seq` Split Empty x Empty
splitTree i (Deep _ pr m sf)
- | vpr > 0 = case splitDigit i pr of
+ | i < spr = case splitDigit i pr of
Split l x r -> Split (maybe Empty digitToTree l) x (deepL r m sf)
Split l x r -> Split (maybe Empty digitToTree l) x (deepL r m sf)
- | vm > 0 = case splitTree vpr m of
- Split ml xs mr -> case splitNode (vpr + size ml) xs of
+ | i < spm = case splitTree im m of
+ Split ml xs mr -> case splitNode (im - size ml) xs of
Split l x r -> Split (deepR pr ml l) x (deepL r mr sf)
Split l x r -> Split (deepR pr ml l) x (deepL r mr sf)
- | otherwise = case splitDigit vm sf of
+ | otherwise = case splitDigit (i - spm) sf of
Split l x r -> Split (deepR pr m l) x (maybe Empty digitToTree r)
Split l x r -> Split (deepR pr m l) x (maybe Empty digitToTree r)
- where vpr = i + size pr
- vm = vpr + size m
+ where spr = size pr
+ spm = spr + size m
+ im = i - spr
{-# SPECIALIZE deepL :: Maybe (Digit (Elem a)) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
{-# SPECIALIZE deepL :: Maybe (Digit (Node a)) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
{-# SPECIALIZE deepL :: Maybe (Digit (Elem a)) -> FingerTree (Node (Elem a)) -> Digit (Elem a) -> FingerTree (Elem a) #-}
{-# SPECIALIZE deepL :: Maybe (Digit (Node a)) -> FingerTree (Node (Node a)) -> Digit (Node a) -> FingerTree (Node a) #-}
@@
-957,44
+973,46
@@
deepR pr m (Just sf) = deep pr m sf
{-# SPECIALIZE splitNode :: Int -> Node (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
splitNode :: Sized a => Int -> Node a -> Split (Maybe (Digit a)) a
splitNode i (Node2 _ a b)
{-# SPECIALIZE splitNode :: Int -> Node (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
splitNode :: Sized a => Int -> Node a -> Split (Maybe (Digit a)) a
splitNode i (Node2 _ a b)
- | va > 0 = Split Nothing a (Just (One b))
+ | i < sa = Split Nothing a (Just (One b))
| otherwise = Split (Just (One a)) b Nothing
| otherwise = Split (Just (One a)) b Nothing
- where va = i + size a
+ where sa = size a
splitNode i (Node3 _ a b c)
splitNode i (Node3 _ a b c)
- | va > 0 = Split Nothing a (Just (Two b c))
- | vab > 0 = Split (Just (One a)) b (Just (One c))
+ | i < sa = Split Nothing a (Just (Two b c))
+ | i < sab = Split (Just (One a)) b (Just (One c))
| otherwise = Split (Just (Two a b)) c Nothing
| otherwise = Split (Just (Two a b)) c Nothing
- where va = i + size a
- vab = va + size b
+ where sa = size a
+ sab = sa + size b
{-# SPECIALIZE splitDigit :: Int -> Digit (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
{-# SPECIALIZE splitDigit :: Int -> Digit (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
splitDigit :: Sized a => Int -> Digit a -> Split (Maybe (Digit a)) a
splitDigit i (One a) = i `seq` Split Nothing a Nothing
splitDigit i (Two a b)
{-# SPECIALIZE splitDigit :: Int -> Digit (Elem a) -> Split (Maybe (Digit (Elem a))) (Elem a) #-}
{-# SPECIALIZE splitDigit :: Int -> Digit (Node a) -> Split (Maybe (Digit (Node a))) (Node a) #-}
splitDigit :: Sized a => Int -> Digit a -> Split (Maybe (Digit a)) a
splitDigit i (One a) = i `seq` Split Nothing a Nothing
splitDigit i (Two a b)
- | va > 0 = Split Nothing a (Just (One b))
+ | i < sa = Split Nothing a (Just (One b))
| otherwise = Split (Just (One a)) b Nothing
| otherwise = Split (Just (One a)) b Nothing
- where va = i + size a
+ where sa = size a
splitDigit i (Three a b c)
splitDigit i (Three a b c)
- | va > 0 = Split Nothing a (Just (Two b c))
- | vab > 0 = Split (Just (One a)) b (Just (One c))
+ | i < sa = Split Nothing a (Just (Two b c))
+ | i < sab = Split (Just (One a)) b (Just (One c))
| otherwise = Split (Just (Two a b)) c Nothing
| otherwise = Split (Just (Two a b)) c Nothing
- where va = i + size a
- vab = va + size b
+ where sa = size a
+ sab = sa + size b
splitDigit i (Four a b c d)
splitDigit i (Four a b c d)
- | va > 0 = Split Nothing a (Just (Three b c d))
- | vab > 0 = Split (Just (One a)) b (Just (Two c d))
- | vabc > 0 = Split (Just (Two a b)) c (Just (One d))
+ | i < sa = Split Nothing a (Just (Three b c d))
+ | i < sab = Split (Just (One a)) b (Just (Two c d))
+ | i < sabc = Split (Just (Two a b)) c (Just (One d))
| otherwise = Split (Just (Three a b c)) d Nothing
| otherwise = Split (Just (Three a b c)) d Nothing
- where va = i + size a
- vab = va + size b
- vabc = vab + size c
+ where sa = size a
+ sab = sa + size b
+ sabc = sab + size c
------------------------------------------------------------------------
-- Lists
------------------------------------------------------------------------
-- | /O(n)/. Create a sequence from a finite list of elements.
------------------------------------------------------------------------
-- Lists
------------------------------------------------------------------------
-- | /O(n)/. Create a sequence from a finite list of elements.
+-- There is a function 'toList' in the opposite direction for all
+-- instances of the 'Foldable' class, including 'Seq'.
fromList :: [a] -> Seq a
fromList = Data.List.foldl' (|>) empty
fromList :: [a] -> Seq a
fromList = Data.List.foldl' (|>) empty