-----------------------------------------------------------------------------
-- |
-- Module : Data.Generics.Aliases
--- 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
-- * Operators for (over-appreciated) unfolding
gunfoldB,
- gunfoldR
+ gunfoldR,
+
+ -- * Type extension for lists
+ extListT,
+ extListM,
+ extListQ,
+ extListR
) where
=> (b -> m b)
-> a
-> m a
-mkM f = case castarr f of
- Just g -> g
- Nothing -> return
+mkM = extM return
{-
=> (b -> m b)
-> a
-> m a
-mkMp = maybe (const mzero) id . castarr
+mkMp = extM (const mzero)
-- | Make a generic builder;
, Typeable b
)
=> m b -> m a
-mkR = maybe mzero id . castss
+mkR f = mzero `extR` f
+
+
+-- | Flexible type extension
+ext0 :: (Typeable a, Typeable b) => c a -> c b -> c a
+ext0 def ext = maybe def id (cast0 ext)
-- | Extend a generic transformation by a type-specific case
, Typeable b
)
=> (a -> m a) -> (b -> m b) -> a -> m a
-extM f = maybe f id . castarr
+extM def ext = unM ((M def) `ext0` (M ext))
-- | Extend a generic MonadPlus transformation by a type-specific case
, Typeable b
)
=> m a -> m b -> m a
-extR f = maybe f id . castss
+extR def ext = unR ((R def) `ext0` (R ext))
+
------------------------------------------------------------------------------
-- | The general scheme underlying generic functions
-- assumed by gfoldl; there are isomorphisms such as
--- GenericT = Generic ID.
+-- GenericT = Generic T.
--
type Generic c = forall a. Data a => a -> c a
-> (forall a. Data a => m a)
-> m a
gunfoldR c f = gmapM (const f) $ fromConstr c
+
+
+
+------------------------------------------------------------------------------
+--
+-- Type extension for lists
+--
+------------------------------------------------------------------------------
+
+
+-- | Type extension of transformations for lists
+extListT :: Data d
+ => (forall d. Data d => d -> d)
+ -> (forall d. Data d => [d] -> [d])
+ -> d -> d
+extListT def ext = unT ((T def) `ext1` (T ext))
+
+
+-- | Type extension of monadic transformations for lists
+extListM :: (Monad m, Data d)
+ => (forall d. Data d => d -> m d)
+ -> (forall d. Data d => [d] -> m [d])
+ -> d -> m d
+extListM def ext = unM ((M def) `ext1` (M ext))
+
+
+-- | Type extension of queries for lists
+extListQ :: Data d
+ => (d -> q)
+ -> (forall d. Data d => [d] -> q)
+ -> d -> q
+extListQ def ext = unQ ((Q def) `ext1` (Q ext))
+
+
+-- | Type extension of readers for lists
+extListR :: (Monad m, Data d)
+ => m d
+ -> (forall d. Data d => m [d])
+ -> m d
+extListR def ext = unR ((R def) `ext1` (R ext))
+
+
+
+------------------------------------------------------------------------------
+--
+-- Type constructors for type-level lambdas
+--
+------------------------------------------------------------------------------
+
+
+-- | The type constructor for transformations
+newtype T x = T { unT :: x -> x }
+
+-- | The type constructor for transformations
+newtype M m x = M { unM :: x -> m x }
+
+-- | The type constructor for queries
+newtype Q q x = Q { unQ :: x -> q }
+
+-- | The type constructor for readers
+newtype R m x = R { unR :: m x }
-----------------------------------------------------------------------------
-- |
-- Module : Data.Generics.Basics
--- 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
gfoldl, -- :: ... -> a -> c a
toConstr, -- :: a -> Constr
fromConstr, -- :: Constr -> a
- dataTypeOf -- :: a -> DataType
-
+ dataTypeOf, -- :: a -> DataType
+ ext1, -- type extension for unary type constructors
+ ext2 -- type extension for binary type constructors
),
-- * Constructor representations
import Data.Maybe
import Control.Monad
+
+
------------------------------------------------------------------------------
--
-- The Data class
--
gfoldl _ z = z
-
-- | Obtaining the constructor from a given datum.
-- For proper terms, this is meant to be the top-level constructor.
-- Primitive datatypes are here viewed as potentially infinite sets of
dataTypeOf :: a -> DataType
+
+------------------------------------------------------------------------------
+--
+-- Type extension for unary and binary type constructors
+--
+------------------------------------------------------------------------------
+
+ -- | Type extension for unary type constructors
+ ext1 :: Typeable1 t
+ => c a
+ -> (forall a. Data a => c (t a))
+ -> c a
+
+ ext1 def ext = def
+
+
+ -- | Type extension for binary type constructors
+ ext2 :: Typeable2 t
+ => c a
+ -> (forall a b. (Data a, Data b) => c (t a b)) -> c a
+ ext2 def ext = def
+
+
------------------------------------------------------------------------------
--
-- Typical generic maps defined in terms of gfoldl
-- | A generic query that processes one child by index (zero-based)
gmapQi :: Int -> (forall a. Data a => a -> u) -> a -> u
- gmapQi i f x = case gfoldl k z x of { COUNT _ (Just q) -> q }
+ gmapQi i f x = case gfoldl k z x of { Qi _ (Just q) -> q }
where
- k (COUNT i' q) a = COUNT (i'+1) (if i==i' then Just (f a) else q)
- z f = COUNT 0 Nothing
+ k (Qi i' q) a = Qi (i'+1) (if i==i' then Just (f a) else q)
+ z f = Qi 0 Nothing
-- | A generic monadic transformation that maps over the immediate subterms
-- | Type constructor for adding counters to queries
-data COUNT q a = COUNT Int (Maybe q)
+data Qi q a = Qi Int (Maybe q)
-- | The type constructor used in definition of gmapQr
1 -> []
2 -> undefined:undefined
dataTypeOf _ = listDataType
+ ext1 def ext = maybe def id (cast1 ext)
+
--
-- The gmaps are given as an illustration.
1 -> Nothing
2 -> Just undefined
dataTypeOf _ = maybeDataType
+ ext1 def ext = maybe def id (cast1 ext)
--
fromConstr c = case conIndex c of
1 -> (undefined,undefined)
dataTypeOf _ = productDataType
+ ext2 def ext = maybe def id (cast2 ext)
--
1 -> Left undefined
2 -> Right undefined
dataTypeOf _ = eitherDataType
+ ext2 def ext = maybe def id (cast2 ext)
{-
-}
-- A last resort for functions
-instance (Typeable a, Typeable b) => Data (a -> b) where
+instance (Data a, Data b) => Data (a -> b) where
toConstr _ = FunConstr
fromConstr _ = undefined
dataTypeOf _ = FunType
+ ext2 def ext = maybe def id (cast2 ext)
module Data.Generics.Twins (
- -- * The idiom for multi-parameter traversal
- gzipWith,
-
- -- * Mapping combinators with an additional list
- gzipWithT,
- gzipWithM,
- gzipWithQ,
- gzipWithQl,
- gzipWithQr,
+ -- * Generic folds and maps that also accumulate
+ gfoldlAccum,
+ gmapAccumT,
+ gmapAccumM,
+ gmapAccumQl,
+ gmapAccumQr,
+ gmapAccumQ,
-- * Mapping combinators for twin traversal
- tmapT,
- tmapM,
- tmapQ,
-
+ gzipWithT,
+ gzipWithM,
+ gzipWithQ,
-- * Typical twin traversals
geq,
------------------------------------------------------------------------------
--
--- The idiom for multi-parameter traversal
+-- Generic folds and maps that also accumulate
--
------------------------------------------------------------------------------
-{-
-
-gfoldl and friends so far facilitated traversal of a single term. We
-will now consider an idiom gfoldlWith to traverse two terms
-semi-simultaneously. By cascasding this idiom, we can also traverse
-more than two terms. The gfoldlWith primitive completes gfoldl in a
-way that is similar to the well-known couple map and
-zipWith. Basically, gfoldlWith takes an additional argument, namely a
-list, and this list is traversed simultaneously with the immediate
-subterms of a given term.
-
--}
-
+{--------------------------------------------------------------
--- | gfoldl with an additional list
-gzipWith :: Data a
- => (forall a b. Data a => d -> c (a -> b) -> a -> c b)
- -> (forall g. g -> c g)
- -> [d]
- -> a
- -> c a
-
-gzipWith k z l x = case gfoldl k' z' x of { WITH _ c -> c }
- where
- k' (WITH (h:t) c) y = WITH t (k h c y)
- k' (WITH [] _) _ = error "gzipWith"
- z' f = WITH l (z f)
-
-
--- | A type constructor for folding over the extra list
-data WITH q c a = WITH [q] (c a)
-
-
-
-------------------------------------------------------------------------------
---
--- Mapping combinators with an additional list
---
-------------------------------------------------------------------------------
+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]
--- | gmapT with an additional list
-gzipWithT :: Data a
- => (forall a. Data a => b -> a -> a)
- -> [b]
- -> a
- -> a
+We recall the type of an accumulating map (see Data.List):
+mapAccumL :: (a -> b -> (a,c)) -> a -> [b] -> (a,[c])
-gzipWithT f l = unID . gzipWith k ID l
- where
- k b (ID c) x = ID $ c $ f b x
+Applying the same scheme we obtain an accumulating gfoldl.
+--------------------------------------------------------------}
--- | gmapM with an additional list
-gzipWithM :: (Data a, Monad m)
- => (forall a. Data a => b -> a -> m a)
- -> [b]
- -> a
- -> m a
+-- | gfoldl with accumulation
-gzipWithM f = gzipWith k return
- where
- k b c x = do c' <- c
- x' <- f b x
- return (c' x')
+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
+ k' c y = A (\a -> let (a', c') = unA c a in k a' c' y)
+ z' f = A (\a -> z a f)
--- | gmapQl with an additional list
-gzipWithQl :: Data a
- => (r -> r -> r)
- -> r
- -> (forall a. Data a => b -> a -> r)
- -> [b]
- -> a
- -> r
-gzipWithQl o r f l = unCONST . gzipWith k z l
- where
- k b (CONST c) x = CONST (c `o` f b x)
- z _ = CONST r
+-- | A type constructor for accumulation
+newtype A a c d = A (a -> (a, c d))
+unA (A f) = f
--- | gmapQr with an additional list
-gzipWithQr :: Data a
- => (r' -> r -> r)
- -> r
- -> (forall a. Data a => b -> a -> r')
- -> [b]
- -> a
- -> r
+-- | 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)
-gzipWithQr o r f l x = unQr (gzipWith k z l x) r
- where
- k b (Qr c) x = Qr (\r -> c (f b x `o` r))
- z _ = Qr id
+-- | gmapT 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 an additional list
-gzipWithQ :: Data a
- => (forall a. Data a => b -> a -> u)
- -> [b]
- -> a
- -> [u]
-gzipWithQ f = gzipWithQr (:) [] f
+-- | gmapQ with accumulation
+gmapAccumQ :: Data d
+ => (forall d. Data d => a -> d -> (a,q))
+ -> a -> d -> (a, [q])
+gmapAccumQ f = gmapAccumQr (:) [] f
------------------------------------------------------------------------------
-
--- | The identity type constructor needed for the definition of gzipWithT
+-- | The identity type constructor needed for the definition of gmapAccumT
newtype ID x = ID { unID :: x }
--- | The constant type constructor needed for the definition of gzipWithQl
+-- | 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 gzipWithQr
+-- | The type constructor needed for the definition of gmapAccumQr
newtype Qr r a = Qr { unQr :: r -> r }
-- | Twin map for transformation
-tmapT :: GenericQ (GenericT) -> GenericQ (GenericT)
-tmapT f x y =
- gzipWithT unGenericT'
- (gmapQ (\x -> GenericT' (f x)) x)
- y
+gzipWithT :: GenericQ (GenericT) -> GenericQ (GenericT)
+gzipWithT f x y = case gmapAccumT perkid funs y of
+ ([], c) -> c
+ _ -> error "gzipWithT"
+ where
+ perkid a d = (tail a, unGenericT' (head a) d)
+ funs = gmapQ (\k -> GenericT' (f k)) x
+
-- | Twin map for monadic transformation
-tmapM :: Monad m => GenericQ (GenericM m) -> GenericQ (GenericM m)
-tmapM f x y =
- gzipWithM unGenericM'
- (gmapQ (\x -> GenericM' (f x)) x)
- y
+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, unGenericM' (head a) d)
+ funs = gmapQ (\k -> GenericM' (f k)) x
-- | Twin map for monadic transformation
-tmapQ :: GenericQ (GenericQ r) -> GenericQ (GenericQ [r])
-tmapQ f x y =
- gzipWithQ unGenericQ'
- (gmapQ (\x -> GenericQ' (f x)) x)
- y
+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, unGenericQ' (head a) d)
+ funs = gmapQ (\k -> GenericQ' (f k)) x
where
geq' :: forall a b. (Data a, Data b) => a -> b -> Bool
geq' x y = (toConstr x == toConstr y)
- && and (tmapQ geq' x 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
+ then gzipWithM (gzip f) x y
else Nothing
projects / haskell-directory.git / commitdiff