Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly
Sign up
Appearance settings

Commit 5e746ca

Browse files
committed
Add (Int, +) finger trees
* Export a type for `(Int,+)` finger trees. * Export more `Data.Sequence` internals. * Offer a module of `Data.Sequence` internals intended for external use, that should obey the PVP.
1 parent 9f65489 commit 5e746ca

File tree

7 files changed

+369
-79
lines changed

7 files changed

+369
-79
lines changed

‎containers-tests/tests/seq-properties.hs

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,8 @@ import Data.Sequence.Internal
1212
, Digit (..)
1313
, node2
1414
, node3
15-
, deep )
15+
, deep
16+
, unsafeMapNode )
1617

1718
import Data.Sequence
1819

@@ -242,7 +243,7 @@ instance (Sized a, Valid a) => Valid (FingerTree a) where
242243
s == size pr + size m + size sf && valid pr && valid m && valid sf
243244

244245
instance (Sized a, Valid a) => Valid (Node a) where
245-
valid node = size node == sum (fmap size node) && all valid node
246+
valid node = size node == sum (unsafeMapNode size node) && all valid node
246247

247248
instance Valid a => Valid (Digit a) where
248249
valid = all valid

‎containers/changelog.md

Lines changed: 15 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,20 @@
11
# Changelog for [`containers` package](http://github.com/haskell/containers)
22

3-
## [0.6.4.1]
3+
## 0.6.5.1
4+
5+
* Add support for finger trees with measurements in the `(Int, +)`
6+
monoid.
7+
* Export more `Data.Sequence` internals.
8+
* Add a `Data.Sequence.StableInternal` module exporting functions
9+
intended for use by external packages.
10+
* Remove the `Functor` and `Traversable` instances from the
11+
heretofore "internal" `FingerTree` and `Node` types, in favor
12+
of type-specific mapping functions. These instances could
13+
break data structure invariants.
14+
* Remove the `Generic1 FingerTree` instance, which can no longer
15+
be derived.
16+
17+
## 0.6.4.1
418

519
### Bug fixes
620

‎containers/containers.cabal

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,8 @@ Library
4141

4242
exposed-modules:
4343
Data.Containers.ListUtils
44+
Data.FingerTree.IntPlus
45+
Data.FingerTree.IntPlus.Unsafe
4446
Data.IntMap
4547
Data.IntMap.Lazy
4648
Data.IntMap.Strict
@@ -65,6 +67,7 @@ Library
6567
Data.Sequence
6668
Data.Sequence.Internal
6769
Data.Sequence.Internal.Sorting
70+
Data.Sequence.StableInternal
6871
Data.Tree
6972
Utils.Containers.Internal.BitUtil
7073
Utils.Containers.Internal.BitQueue
Lines changed: 155 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,155 @@
1+
{-# LANGUAGE CPP #-}
2+
#include "containers.h"
3+
{-# LANGUAGE BangPatterns #-}
4+
5+
#ifdef DEFINE_PATTERN_SYNONYMS
6+
{-# LANGUAGE PatternSynonyms #-}
7+
{-# LANGUAGE ViewPatterns #-}
8+
#endif
9+
10+
-- | This module exports a type of finger trees with measurements ("sizes") in
11+
-- the @(Int, +)@ monoid. This type is used to implement sequences in
12+
-- "Data.Sequence". It may occasionally be useful for other purposes.
13+
--
14+
-- Caution: splitting and lookup functions assume that the size of the tree is
15+
-- at most @'maxBound' :: Int@. If this is not the case, then they may produce
16+
-- errors and/or utter nonsense.
17+
18+
module Data.FingerTree.IntPlus
19+
(
20+
#ifdef DEFINE_PATTERN_SYNONYMS
21+
FingerTree (Empty, (:<|), (:|>), Singleton)
22+
#else
23+
FingerTree
24+
#endif
25+
, Elem (..)
26+
, Sized (..)
27+
, Split (..)
28+
, UncheckedSplit (..)
29+
, ViewL (..)
30+
, ViewR (..)
31+
, (<|)
32+
, (|>)
33+
, (><)
34+
, fromList
35+
, viewl
36+
, viewr
37+
, split
38+
, uncheckedSplit
39+
) where
40+
41+
import Data.Sequence.Internal
42+
( FingerTree (..), Sized (..), Elem (..) )
43+
import qualified Data.Sequence.Internal as S
44+
#if !MIN_VERSION_base(4,8,0)
45+
import Data.Word (Word)
46+
#endif
47+
48+
infixr 5 ><
49+
infixr 5 <|, :<
50+
infixl 5 |>, :>
51+
52+
(<|) :: Sized a => a -> FingerTree a -> FingerTree a
53+
(<|) = S.consTree
54+
55+
(|>) :: Sized a => FingerTree a -> a -> FingerTree a
56+
(|>) = S.snocTree
57+
58+
(><) :: Sized a => FingerTree a -> FingerTree a -> FingerTree a
59+
(><) = S.appendTree
60+
61+
fromList :: Sized a => [a] -> FingerTree a
62+
fromList = S.fromListFT
63+
64+
data ViewL a = a :< FingerTree a | EmptyL
65+
data ViewR a = FingerTree a :> a | EmptyR
66+
67+
{-# INLINE viewl #-}
68+
viewl :: Sized a => FingerTree a -> ViewL a
69+
viewl t = case S.viewLTree t of
70+
S.ConsLTree a as -> a :< as
71+
S.EmptyLTree -> EmptyL
72+
73+
{-# INLINE viewr #-}
74+
viewr :: Sized a => FingerTree a -> ViewR a
75+
viewr t = case S.viewRTree t of
76+
S.SnocRTree as a -> as :> a
77+
S.EmptyRTree -> EmptyR
78+
79+
#ifdef DEFINE_PATTERN_SYNONYMS
80+
infixr 5 :<|
81+
infixl 5 :|>
82+
83+
#if __GLASGOW_HASKELL__ >= 801
84+
{-# COMPLETE (:<|), Empty #-}
85+
{-# COMPLETE (:|>), Empty #-}
86+
#endif
87+
88+
-- | A bidirectional pattern synonym matching an empty finger tree.
89+
pattern Empty :: S.FingerTree a
90+
pattern Empty = S.EmptyT
91+
92+
-- | A bidirectional pattern synonym viewing the front of a non-empty
93+
-- finger tree.
94+
pattern (:<|) :: Sized a => a -> FingerTree a -> FingerTree a
95+
pattern x :<| xs <- (viewl -> x :< xs)
96+
where
97+
x :<| xs = x <| xs
98+
99+
-- | A bidirectional pattern synonym viewing the rear of a non-empty
100+
-- finger tree.
101+
pattern (:|>) :: Sized a => FingerTree a -> a -> FingerTree a
102+
pattern xs :|> x <- (viewr -> xs :> x)
103+
where
104+
xs :|> x = xs |> x
105+
106+
-- | A bidirectional pattern synonym for a singleton
107+
-- sequence. @Singleton xs@ is equivalent to @xs :< Empty@.
108+
pattern Singleton :: a -> FingerTree a
109+
pattern Singleton x <- S.Single x
110+
where
111+
Singleton = S.Single
112+
#endif
113+
114+
data Split a
115+
= Split !(FingerTree a) a !(FingerTree a)
116+
| EmptySplit
117+
118+
data UncheckedSplit a
119+
= UncheckedSplit !(FingerTree a) a !(FingerTree a)
120+
121+
-- | Split a finger tree around a measurement.
122+
--
123+
-- @split i xs = EmptySplit@ if and only if @xs = Empty@. Given that
124+
--
125+
-- @
126+
-- split i xs = 'Split' l x r
127+
-- @
128+
--
129+
-- it's guaranteed that
130+
--
131+
-- 1. @ xs = l <> (x <| r) @
132+
-- 2. @i >= size l@ or @l = Empty@
133+
-- 3. @i < size l + size x@ or @r = Empty@
134+
135+
split :: Sized a => Int -> FingerTree a -> Split a
136+
split !_i S.EmptyT = EmptySplit
137+
split i ft
138+
| S.Split l m r <- S.splitTree i ft
139+
= Split l m r
140+
141+
-- | Split a nonempty finger tree around a measurement. Given that
142+
--
143+
-- @
144+
-- uncheckedSplit i xs = 'UncheckedSplit' l x r
145+
-- @
146+
--
147+
-- it's guaranteed that
148+
--
149+
-- 1. @ xs = l <> (x <| r) @
150+
-- 2. @i >= size l@ or @l = Empty@
151+
-- 3. @i < size l + size x@ or @r = Empty@
152+
uncheckedSplit :: Sized a => Int -> FingerTree a -> UncheckedSplit a
153+
uncheckedSplit i ft
154+
| S.Split l m r <- S.splitTree i ft
155+
= UncheckedSplit l m r
Lines changed: 46 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,46 @@
1+
{-# LANGUAGE CPP #-}
2+
#include "containers.h"
3+
4+
-- | This module exports functions that can easily
5+
-- produce finger trees violating the annotation invariants.
6+
-- Trees violating these invariants will produce garbage
7+
-- when split.
8+
module Data.FingerTree.IntPlus.Unsafe
9+
( unsafeMap
10+
, unsafeTraverse
11+
) where
12+
13+
import Data.Sequence.Internal
14+
( FingerTree (..), Node (..) )
15+
import qualified Data.Sequence.Internal as S
16+
import Control.Applicative (liftA2, liftA3)
17+
#if !MIN_VERSION_base(4,8,0)
18+
import Data.Traversable (traverse)
19+
#endif
20+
21+
-- | Map over a 'FingerTree'. The following precondition
22+
-- is assumed but not checked:
23+
--
24+
-- For each @a@ in the @FingerTree@, @size (f a) = size a@.
25+
unsafeMap :: (a -> b) -> FingerTree a -> FingerTree b
26+
unsafeMap = S.unsafeMapFT
27+
28+
-- | Traverse a 'FingerTree'. The following precondition is required
29+
-- but not checked:
30+
--
31+
-- For each element @a@ in the 'FingerTree',
32+
-- @size <$> f a = size a <$ f a@
33+
unsafeTraverse :: Applicative f => (a -> f b) -> FingerTree a -> f (FingerTree b)
34+
unsafeTraverse _ EmptyT = pure EmptyT
35+
unsafeTraverse f (Single x) = Single <$> f x
36+
unsafeTraverse f (Deep v pr m sf) =
37+
liftA3 (Deep v) (traverse f pr) (unsafeTraverse (unsafeTraverseNode f) m) (traverse f sf)
38+
39+
-- | Traverse a 'Node'. The following precondition is required
40+
-- but not checked:
41+
--
42+
-- For each element @a@ in the 'Node',
43+
-- @size <$> f a = size a <$ f a@
44+
unsafeTraverseNode :: Applicative f => (a -> f b) -> Node a -> f (Node b)
45+
unsafeTraverseNode f (Node2 v a b) = liftA2 (Node2 v) (f a) (f b)
46+
unsafeTraverseNode f (Node3 v a b c) = liftA3 (Node3 v) (f a) (f b) (f c)

0 commit comments

Comments
(0)

AltStyle によって変換されたページ (->オリジナル) /