-----------------------------------------------------------------------------
-- |
-- Module : Data.Generics.Twins
--- Copyright : (c) The University of Glasgow, CWI 2001--2003
+-- Copyright : (c) The University of Glasgow, CWI 2001--2004
-- License : BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer : libraries@haskell.org
-- Stability : experimental
--- Portability : non-portable
+-- Portability : non-portable (local universal quantification)
--
--- "Scrap your boilerplate" --- Generic programming in Haskell
--- See <http://www.cs.vu.nl/boilerplate/>.
+-- \"Scrap your boilerplate\" --- Generic programming in Haskell
+-- See <http://www.cs.vu.nl/boilerplate/>. The present module
+-- provides support for multi-parameter traversal, which is also
+-- demonstrated with generic operations like equality.
--
-----------------------------------------------------------------------------
module Data.Generics.Twins (
- -- * The idiom of multi-parameter traversal
- tfoldl,
+ -- * Generic folds and maps that also accumulate
+ gfoldlAccum,
+ gmapAccumT,
+ gmapAccumM,
+ gmapAccumQl,
+ gmapAccumQr,
+ gmapAccumQ,
- -- * Twin mapping combinators
- tmapT,
- tmapQl,
- tmapM,
+ -- * Mapping combinators for twin traversal
+ gzipWithT,
+ gzipWithM,
+ gzipWithQ,
- -- * Prime examples of twin traversal
+ -- * Typical twin traversals
geq,
gzip
------------------------------------------------------------------------------
-
+#ifdef __HADDOCK__
+import Prelude
+#endif
import Data.Generics.Basics
import Data.Generics.Aliases
+#ifdef __GLASGOW_HASKELL__
+import Prelude hiding ( GT )
+#endif
------------------------------------------------------------------------------
------------------------------------------------------------------------------
--
--- The idiom of multi-parameter traversal
+-- Generic folds and maps that also accumulate
--
------------------------------------------------------------------------------
-{-
+{--------------------------------------------------------------
-The fact that we traverse two terms semi-simultaneously is reflected
-by the nested generic function type that occurs as the result type of
-tfoldl. By "semi-simultaneously", we mean that we first fold over the
-first term and compute a LIST of generic functions to be folded over
-the second term. So the outermost generic function type is GenericQ
-because we compute a list of generic functions which is a kind of
-query. The inner generic function type is parameterised in a type
-constructor c so that we can instantiate twin traversal for
-transformations (T), queries (Q), and monadic transformations (M).
-The combinator tfoldl is also parameterised by a nested generic
-function which serves as the function to be mapped over the first term
-to get the functions to be mapped over the second term. The combinator
-tfoldl is further parameterised by gfoldl-like parameters k and z
-which however need to be lifted to k' and z' such that plain term
-traversal is combined with list traversal (of the list of generic
-functions). That is, the essence of multi-parameter term traversal is
-a single term traversal interleaved with a list fold. As the
-definition of k' and z' details, the list fold can be arranged by the
-ingredients of the term fold. To this end, we use a designated TWIN
-datatype constructor which pairs a given type constructor c with a
-list of generic functions.
+A list map can be elaborated to perform accumulation.
+In the same sense, we can elaborate generic maps over terms.
--}
+We recall the type of map:
+map :: (a -> b) -> [a] -> [b]
+
+We recall the type of an accumulating map (see Data.List):
+mapAccumL :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c])
+
+Applying the same scheme we obtain an accumulating gfoldl.
-tfoldl :: (forall a b. Data a => c (a -> b) -> c a -> c b)
- -> (forall g. g -> c g)
- -> GenericQ (Generic c)
- -> GenericQ (Generic c)
+--------------------------------------------------------------}
-tfoldl k z t xs ys = case gfoldl k' z' ys of { TWIN _ c -> c }
+-- | gfoldl with accumulation
+
+gfoldlAccum :: Data d
+ => (forall d r. Data d => a -> c (d -> r) -> d -> (a, c r))
+ -> (forall g. a -> g -> (a, c g))
+ -> a -> d -> (a, c d)
+
+gfoldlAccum k z a d = unA (gfoldl k' z' d) a
where
- l = gmapQ (\x -> Generic' (t x)) xs
- k' (TWIN (r:rs) c) y = TWIN rs (k c (unGeneric' r y))
- z' f = TWIN l (z f)
+ k' c y = A (\a -> let (a', c') = unA c a in k a' c' y)
+ z' f = A (\a -> z a f)
--- Pairing ID, CONST, m or others with lists of generic functions
-data TWIN c a = TWIN [Generic' c] (c a)
+-- | A type constructor for accumulation
+newtype A a c d = A { unA :: a -> (a, c d) }
+
+
+-- | gmapT with accumulation
+gmapAccumT :: Data d
+ => (forall d. Data d => a -> d -> (a,d))
+ -> a -> d -> (a, d)
+gmapAccumT f a d = let (a',d') = gfoldlAccum k z a d
+ in (a',unID d')
+ where
+ k a (ID c) d = let (a',d') = f a d
+ in (a', ID (c d'))
+ z a x = (a, ID x)
+
+
+-- | gmapM with accumulation
+gmapAccumM :: (Data d, Monad m)
+ => (forall d. Data d => a -> d -> (a, m d))
+ -> a -> d -> (a, m d)
+gmapAccumM f = gfoldlAccum k z
+ where
+ k a c d = let (a',d') = f a d
+ in (a', d' >>= \d'' -> c >>= \c' -> return (c' d''))
+ z a x = (a, return x)
+
+
+-- | gmapQl with accumulation
+gmapAccumQl :: Data d
+ => (r -> r' -> r)
+ -> r
+ -> (forall d. Data d => a -> d -> (a,r'))
+ -> a -> d -> (a, r)
+gmapAccumQl o r f a d = let (a',r) = gfoldlAccum k z a d
+ in (a',unCONST r)
+ where
+ k a (CONST c) d = let (a',r') = f a d
+ in (a', CONST (c `o` r'))
+ z a _ = (a, CONST r)
+
+
+-- | gmapQr with accumulation
+gmapAccumQr :: Data d
+ => (r' -> r -> r)
+ -> r
+ -> (forall d. Data d => a -> d -> (a,r'))
+ -> a -> d -> (a, r)
+gmapAccumQr o r f a d = let (a',l) = gfoldlAccum k z a d
+ in (a',unQr l r)
+ where
+ k a (Qr c) d = let (a',r') = f a d
+ in (a', Qr (\r -> c (r' `o` r)))
+ z a _ = (a, Qr id)
+
+
+-- | gmapQ with accumulation
+gmapAccumQ :: Data d
+ => (forall d. Data d => a -> d -> (a,q))
+ -> a -> d -> (a, [q])
+gmapAccumQ f = gmapAccumQr (:) [] f
------------------------------------------------------------------------------
--
--- Twin mapping combinators
+-- Helper type constructors
--
------------------------------------------------------------------------------
-tmapT :: GenericQ (GenericT) -> GenericQ (GenericT)
-tmapT f x y = unID $ tfoldl k z f' x y
- where
- f' x y = ID $ f x y
- k (ID c) (ID x) = ID (c x)
- z = ID
+
+-- | The identity type constructor needed for the definition of gmapAccumT
+newtype ID x = ID { unID :: x }
-tmapQl :: (r -> r -> r)
- -> r
- -> GenericQ (GenericQ r)
- -> GenericQ (GenericQ r)
-tmapQl o r f x y = unCONST $ tfoldl k z f' x y
- where
- f' x y = CONST $ f x y
- k (CONST c) (CONST x) = CONST (c `o` x)
- z _ = CONST r
+-- | The constant type constructor needed for the definition of gmapAccumQl
+newtype CONST c a = CONST { unCONST :: c }
+
+
+-- | The type constructor needed for the definition of gmapAccumQr
+newtype Qr r a = Qr { unQr :: r -> r }
-tmapM :: Monad m => GenericQ (GenericM m) -> GenericQ (GenericM m)
-tmapM f x y = tfoldl k z f x y
+
+------------------------------------------------------------------------------
+--
+-- Mapping combinators for twin traversal
+--
+------------------------------------------------------------------------------
+
+
+-- | Twin map for transformation
+gzipWithT :: GenericQ (GenericT) -> GenericQ (GenericT)
+gzipWithT f x y = case gmapAccumT perkid funs y of
+ ([], c) -> c
+ _ -> error "gzipWithT"
where
- k c x = do c' <- c
- x' <- x
- return $ c' x'
- z = return
+ perkid a d = (tail a, unGT (head a) d)
+ funs = gmapQ (\k -> GT (f k)) x
--- The identity type constructor needed for the definition of tmapT
-newtype ID x = ID { unID :: x }
+-- | Twin map for monadic transformation
+gzipWithM :: Monad m => GenericQ (GenericM m) -> GenericQ (GenericM m)
+gzipWithM f x y = case gmapAccumM perkid funs y of
+ ([], c) -> c
+ _ -> error "gzipWithM"
+ where
+ perkid a d = (tail a, unGM (head a) d)
+ funs = gmapQ (\k -> GM (f k)) x
--- The constant type constructor needed for the definition of tmapQl
-newtype CONST c a = CONST { unCONST :: c }
+
+-- | Twin map for queries
+gzipWithQ :: GenericQ (GenericQ r) -> GenericQ (GenericQ [r])
+gzipWithQ f x y = case gmapAccumQ perkid funs y of
+ ([], r) -> r
+ _ -> error "gzipWithQ"
+ where
+ perkid a d = (tail a, unGQ (head a) d)
+ funs = gmapQ (\k -> GQ (f k)) x
------------------------------------------------------------------------------
--
--- Prime examples of twin traversal
+-- Typical twin traversals
--
------------------------------------------------------------------------------
-}
geq x y = geq' x y
- where
- geq' :: forall a b. (Data a, Data b) => a -> b -> Bool
- geq' x y = and [ (toConstr x == toConstr y)
- , tmapQl (\b1 b2 -> and [b1,b2]) True geq' x y
- ]
+ where
+ geq' :: forall a b. (Data a, Data b) => a -> b -> Bool
+ geq' x y = (toConstr x == toConstr y)
+ && and (gzipWithQ geq' x y)
-- | Generic zip controlled by a function with type-specific branches
gzip :: (forall a b. (Data a, Data b) => a -> b -> Maybe b)
-> (forall a b. (Data a, Data b) => a -> b -> Maybe b)
-
-- See testsuite/.../Generics/gzip.hs for an illustration
gzip f x y =
f x y
`orElse`
if toConstr x == toConstr y
- then tmapM (gzip f) x y
- else Nothing
+ then gzipWithM (gzip f) x y
+ else Nothing
projects / haskell-directory.git / blobdiff