Remove Control.Parallel*, now in package parallel
[packages/random.git] / Data / Generics / Twins.hs
1 -----------------------------------------------------------------------------
2 -- |
3 -- Module : Data.Generics.Twins
4 -- Copyright : (c) The University of Glasgow, CWI 2001--2004
5 -- License : BSD-style (see the file libraries/base/LICENSE)
6 --
7 -- Maintainer : libraries@haskell.org
8 -- Stability : experimental
9 -- Portability : non-portable (local universal quantification)
10 --
11 -- \"Scrap your boilerplate\" --- Generic programming in Haskell
12 -- See <http://www.cs.vu.nl/boilerplate/>. The present module
13 -- provides support for multi-parameter traversal, which is also
14 -- demonstrated with generic operations like equality.
15 --
16 -----------------------------------------------------------------------------
17
18 module Data.Generics.Twins (
19
20 -- * Generic folds and maps that also accumulate
21 gfoldlAccum,
22 gmapAccumT,
23 gmapAccumM,
24 gmapAccumQl,
25 gmapAccumQr,
26 gmapAccumQ,
27
28 -- * Mapping combinators for twin traversal
29 gzipWithT,
30 gzipWithM,
31 gzipWithQ,
32
33 -- * Typical twin traversals
34 geq,
35 gzip
36
37 ) where
38
39
40 ------------------------------------------------------------------------------
41
42 #ifdef __HADDOCK__
43 import Prelude
44 #endif
45 import Data.Generics.Basics
46 import Data.Generics.Aliases
47
48 #ifdef __GLASGOW_HASKELL__
49 import Prelude hiding ( GT )
50 #endif
51
52 ------------------------------------------------------------------------------
53
54
55 ------------------------------------------------------------------------------
56 --
57 -- Generic folds and maps that also accumulate
58 --
59 ------------------------------------------------------------------------------
60
61 {--------------------------------------------------------------
62
63 A list map can be elaborated to perform accumulation.
64 In the same sense, we can elaborate generic maps over terms.
65
66 We recall the type of map:
67 map :: (a -> b) -> [a] -> [b]
68
69 We recall the type of an accumulating map (see Data.List):
70 mapAccumL :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c])
71
72 Applying the same scheme we obtain an accumulating gfoldl.
73
74 --------------------------------------------------------------}
75
76 -- | gfoldl with accumulation
77
78 gfoldlAccum :: Data d
79 => (forall d r. Data d => a -> c (d -> r) -> d -> (a, c r))
80 -> (forall g. a -> g -> (a, c g))
81 -> a -> d -> (a, c d)
82
83 gfoldlAccum k z a d = unA (gfoldl k' z' d) a
84 where
85 k' c y = A (\a -> let (a', c') = unA c a in k a' c' y)
86 z' f = A (\a -> z a f)
87
88
89 -- | A type constructor for accumulation
90 newtype A a c d = A { unA :: a -> (a, c d) }
91
92
93 -- | gmapT with accumulation
94 gmapAccumT :: Data d
95 => (forall d. Data d => a -> d -> (a,d))
96 -> a -> d -> (a, d)
97 gmapAccumT f a d = let (a',d') = gfoldlAccum k z a d
98 in (a',unID d')
99 where
100 k a (ID c) d = let (a',d') = f a d
101 in (a', ID (c d'))
102 z a x = (a, ID x)
103
104
105 -- | gmapM with accumulation
106 gmapAccumM :: (Data d, Monad m)
107 => (forall d. Data d => a -> d -> (a, m d))
108 -> a -> d -> (a, m d)
109 gmapAccumM f = gfoldlAccum k z
110 where
111 k a c d = let (a',d') = f a d
112 in (a', d' >>= \d'' -> c >>= \c' -> return (c' d''))
113 z a x = (a, return x)
114
115
116 -- | gmapQl with accumulation
117 gmapAccumQl :: Data d
118 => (r -> r' -> r)
119 -> r
120 -> (forall d. Data d => a -> d -> (a,r'))
121 -> a -> d -> (a, r)
122 gmapAccumQl o r f a d = let (a',r) = gfoldlAccum k z a d
123 in (a',unCONST r)
124 where
125 k a (CONST c) d = let (a',r') = f a d
126 in (a', CONST (c `o` r'))
127 z a _ = (a, CONST r)
128
129
130 -- | gmapQr with accumulation
131 gmapAccumQr :: Data d
132 => (r' -> r -> r)
133 -> r
134 -> (forall d. Data d => a -> d -> (a,r'))
135 -> a -> d -> (a, r)
136 gmapAccumQr o r f a d = let (a',l) = gfoldlAccum k z a d
137 in (a',unQr l r)
138 where
139 k a (Qr c) d = let (a',r') = f a d
140 in (a', Qr (\r -> c (r' `o` r)))
141 z a _ = (a, Qr id)
142
143
144 -- | gmapQ with accumulation
145 gmapAccumQ :: Data d
146 => (forall d. Data d => a -> d -> (a,q))
147 -> a -> d -> (a, [q])
148 gmapAccumQ f = gmapAccumQr (:) [] f
149
150
151
152 ------------------------------------------------------------------------------
153 --
154 -- Helper type constructors
155 --
156 ------------------------------------------------------------------------------
157
158
159 -- | The identity type constructor needed for the definition of gmapAccumT
160 newtype ID x = ID { unID :: x }
161
162
163 -- | The constant type constructor needed for the definition of gmapAccumQl
164 newtype CONST c a = CONST { unCONST :: c }
165
166
167 -- | The type constructor needed for the definition of gmapAccumQr
168 newtype Qr r a = Qr { unQr :: r -> r }
169
170
171
172 ------------------------------------------------------------------------------
173 --
174 -- Mapping combinators for twin traversal
175 --
176 ------------------------------------------------------------------------------
177
178
179 -- | Twin map for transformation
180 gzipWithT :: GenericQ (GenericT) -> GenericQ (GenericT)
181 gzipWithT f x y = case gmapAccumT perkid funs y of
182 ([], c) -> c
183 _ -> error "gzipWithT"
184 where
185 perkid a d = (tail a, unGT (head a) d)
186 funs = gmapQ (\k -> GT (f k)) x
187
188
189
190 -- | Twin map for monadic transformation
191 gzipWithM :: Monad m => GenericQ (GenericM m) -> GenericQ (GenericM m)
192 gzipWithM f x y = case gmapAccumM perkid funs y of
193 ([], c) -> c
194 _ -> error "gzipWithM"
195 where
196 perkid a d = (tail a, unGM (head a) d)
197 funs = gmapQ (\k -> GM (f k)) x
198
199
200 -- | Twin map for queries
201 gzipWithQ :: GenericQ (GenericQ r) -> GenericQ (GenericQ [r])
202 gzipWithQ f x y = case gmapAccumQ perkid funs y of
203 ([], r) -> r
204 _ -> error "gzipWithQ"
205 where
206 perkid a d = (tail a, unGQ (head a) d)
207 funs = gmapQ (\k -> GQ (f k)) x
208
209
210
211 ------------------------------------------------------------------------------
212 --
213 -- Typical twin traversals
214 --
215 ------------------------------------------------------------------------------
216
217 -- | Generic equality: an alternative to \"deriving Eq\"
218 geq :: Data a => a -> a -> Bool
219
220 {-
221
222 Testing for equality of two terms goes like this. Firstly, we
223 establish the equality of the two top-level datatype
224 constructors. Secondly, we use a twin gmap combinator, namely tgmapQ,
225 to compare the two lists of immediate subterms.
226
227 (Note for the experts: the type of the worker geq' is rather general
228 but precision is recovered via the restrictive type of the top-level
229 operation geq. The imprecision of geq' is caused by the type system's
230 unability to express the type equivalence for the corresponding
231 couples of immediate subterms from the two given input terms.)
232
233 -}
234
235 geq x y = geq' x y
236 where
237 geq' :: GenericQ (GenericQ Bool)
238 geq' x y = (toConstr x == toConstr y)
239 && and (gzipWithQ geq' x y)
240
241
242 -- | Generic zip controlled by a function with type-specific branches
243 gzip :: GenericQ (GenericM Maybe) -> GenericQ (GenericM Maybe)
244 -- See testsuite/.../Generics/gzip.hs for an illustration
245 gzip f x y =
246 f x y
247 `orElse`
248 if toConstr x == toConstr y
249 then gzipWithM (gzip f) x y
250 else Nothing