[project @ 2003-07-08 15:46:40 by panne]
[packages/base.git] / Data / Generics.hs
index 7de6995..c14d965 100644 (file)
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Generics
--- Copyright   :  (c) The University of Glasgow 2001
+-- Copyright   :  (c) The University of Glasgow, CWI 2001--2003
 -- License     :  BSD-style (see the file libraries/base/LICENSE)
 -- 
--- Maintainer  :  libraries@haskell.org
+-- Maintainer  :  libraries@haskell.org, ralf@cwi.nl
 -- Stability   :  experimental
 -- Portability :  non-portable
 --
--- Data types for generic definitions (GHC only).
+-- Generic programming in Haskell; 
+-- see <http://www.cs.vu.nl/boilerplate/>.
 --
 -----------------------------------------------------------------------------
 
 module Data.Generics ( 
 
+       -- The Typeable class and the type-safe cast operation;
+        -- re-exported for convenience
+       Typeable(..), cast,
+
+       -- * Prime types of generic functions
+        GenericT, GenericQ, GenericM, GenericB,
+
+       -- * Combinators to \"make\" generic functions
+       mkT, mkQ, mkM, mkF, mkB,
+       extT, extQ, extM, extF, extB,
+
+       -- * The Data class for folding and unfolding constructor applications
+       Data( 
+             gfoldl,
+              gunfold,
+             conOf,
+              consOf 
+            ),
+
+        -- * Typical generic maps defined in terms of gfoldl 
+
+       gmapT,
+        gmapQ, 
+        gmapM,
+        gmapF,
+
+        -- * The Constr datatype for describing datatype constructors
+        Constr(..),    
+
+       -- * Frequently used generic traversal schemes
+        everywhere,
+        everywhere',
+        everywhereBut,
+        everywhereM,
+        somewhere,
+       everything,
+       listify,
+        something,
+       synthesize,
+
+       -- * Generic operations such as show, equality, read
+       glength,
+       gcount,
+       garity,
+       gundefineds,
+       gnodecount,
+       gtypecount,
+       gshow,
+       geq,
+       gzip,
+       gread,
+
+       -- * Miscellaneous further combinators
+       sameType, orElse, recoverF, recoverQ, choiceF, choiceQ
+
 #ifndef __HADDOCK__
-       -- * Data types for the sum-of-products type encoding
-       (:*:)(..), (:+:)(..), Unit(..),
+       ,
+       -- Data types for the sum-of-products type encoding;
+        -- included for backwards compatibility; maybe obsolete
+       (:*:)(..), (:+:)(..), Unit(..)
 #endif
 
-       -- * Typeable and types-save cast
-       Typeable(..),  cast, sameType, 
-
-       -- * The Data class and related types
-       Data( gmapT, gmapQ, gmapM, 
-             gfoldl, gfoldr, gunfold,
-             conOf, consOf ),
-       Constr(..), 
-
-       -- * Transformations (T), queries (Q), monadic transformations (Q), 
-       --   and twin transformations (TT)
-       GenericT, GenericQ, GenericM,
-       mkT,  mkQ,  mkM, 
-       extT, extQ, extM,
-       mkTT,
-
-       -- * Traversal combinators
-       everything, something, everywhere, everywhereBut,
-       synthesize, branches, undefineds,
-
-       -- * Generic operations: equality, zip, read, show
-       geq, gzip, gshow, gread,
-
-       -- * Miscellaneous
-       match, tick, count, alike       
-
-
  ) where
 
+------------------------------------------------------------------------------
+
 import Prelude -- So that 'make depend' works
 
 #ifdef __GLASGOW_HASKELL__
+#ifndef __HADDOCK__
 import GHC.Base ( (:*:)(..), (:+:)(..), Unit(..) )
 #endif
+#endif
 
+import Data.Maybe
 import Data.Dynamic
 import Control.Monad
 
 
 
----------------------------------------------
+------------------------------------------------------------------------------
+--
+--     Prime types of generic functions
 --
---     Operations involving Typeable only
+------------------------------------------------------------------------------
+
+-- | Generic transformations,
+--   i.e., take an \"a\" and return an \"a\"
 --
----------------------------------------------
+type GenericT = forall a. Data a => a -> a
+
+
+-- | Generic queries of type \"r\",
+--   i.e., take any \"a\" and return an \"r\"
+--
+type GenericQ r = forall a. Data a => a -> r
+
 
--- | Apply a function if appropriate or preserve term
+-- | Generic monadic transformations,
+--   i.e., take an \"a\" and compute an \"a\"
+--
+type GenericM m = forall a. Data a => a -> m a
+
+
+-- | Generic builders with input i,
+--   i.e., take an \"i\" and compute a pair of type (a,i)
+--
+type GenericB m i = forall a. Data a => i -> m (a,i)
+
+
+
+------------------------------------------------------------------------------
+--
+--     Combinators to "make" generic functions
+--     We use type-safe cast in a number of ways to make generic functions.
+--
+------------------------------------------------------------------------------
+
+-- | Make a generic transformation;
+--   start from a type-specific case;
+--   preserve the term otherwise
+--
 mkT :: (Typeable a, Typeable b) => (b -> b) -> a -> a
 mkT f = case cast f of
                Just g -> g
                Nothing -> id
 
--- | Apply a function if appropriate or return a constant
+
+-- | Make a generic query;
+--   start from a type-specific case;
+--   return a constant otherwise
+--
 mkQ :: (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
 (r `mkQ` br) a = case cast a of
                     Just b  -> br b
                     Nothing -> r
 
 
-
--- | Apply a monadic transformation if appropriate; resort to return otherwise
+-- | Make a generic monadic transformation;
+--   start from a type-specific case;
+--   resort to return otherwise
+--
 mkM :: (Typeable a, Typeable b, Typeable (m a), Typeable (m b), Monad m)
     => (b -> m b) -> a -> m a
 mkM f = case cast f of
           Just g  -> g
           Nothing -> return
 
--- | Extend a transformation
+
+{-
+
+For the remaining definitions, we stick to a more concise style, i.e.,
+we fold maybies with "maybe" instead of case ... of ..., and we also
+use a point-free style whenever possible.
+
+-}
+
+
+-- | Make a generic monadic transformation for MonadPlus;
+--   use \"const mzero\" (i.e., failure) instead of return as default.
+--
+mkF :: (Typeable a, Typeable b, Typeable (m a), Typeable (m b), MonadPlus m)
+    => (b -> m b) -> a -> m a
+mkF = maybe (const mzero) id . cast
+
+
+-- | Make a generic builder;
+--   start from a type-specific ase;
+--   resort to no build (i.e., mzero) otherwise
+--
+mkB :: (Typeable a, Typeable b,
+       Typeable i,
+        Typeable (m (a,i)), Typeable (m (b,i)),
+        MonadPlus m)
+    => (i -> m (b,i)) -> i -> m (a,i)
+mkB = maybe (const mzero) id . cast
+
+
+-- | Extend a generic transformation by a type-specific case
 extT :: (Typeable a, Typeable b) => (a -> a) -> (b -> b) -> a -> a
-extT f g = case cast g of
-              Just g' -> g'
-              Nothing -> f
+extT f = maybe f id . cast
 
--- | Extend a query
+
+-- | Extend a generic query by a type-specific case
 extQ :: (Typeable a, Typeable b) => (a -> q) -> (b -> q) -> a -> q
-extQ f g a = case cast a of
-                Just b -> g b
-                Nothing -> f a
-
--- | Extend a monadic transformation
-extM :: (Typeable a, Typeable b, Typeable (m a), Typeable (m b), Monad m)
-       => (a -> m a) -> (b -> m b) -> a -> m a
-extM f g = case cast g of
-              Just g' -> g'
-              Nothing -> f
-
--- | Test two entities to be of the same type
-sameType :: (Typeable a, Typeable b) => a -> b -> Bool
-sameType (_::a) = False `mkQ` (\(_::a) -> True)
+extQ f g a = maybe (f a) g (cast a)
 
 
+-- | Extend a generic monadic transformation by a type-specific case
+extM :: (Typeable a, Typeable b,
+         Typeable (m a), Typeable (m b), 
+         Monad m)
+     => (a -> m a) -> (b -> m b) -> a -> m a
+extM f = maybe f id . cast
 
--- | Make a twin transformation
--- Note: Should be worked on 
-mkTT :: (Typeable a, Typeable b, Typeable c)
-     => (a -> a -> a)
-     -> b -> c -> Maybe c
-mkTT (f::a ->a->a) x y =
-  case (cast x,cast y) of
-    (Just (x'::a),Just (y'::a)) -> cast (f x' y')
-    _ -> Nothing
 
+-- | Extend a generic MonadPlus transformation by a type-specific case
+extF :: (Typeable a, Typeable b,
+         Typeable (m a), Typeable (m b), 
+         MonadPlus m)
+     => (a -> m a) -> (b -> m b) -> a -> m a
+extF = extM
 
 
+-- | Extend a generic builder by a type-specific case
+extB :: (Typeable a, Typeable b,
+         Typeable i,
+         Typeable (m (a,i)), Typeable (m (b,i)),
+         MonadPlus m)
+     => (i -> m (a,i)) -> (i -> m (b,i)) -> i -> m (a,i)
+extB f = maybe f id . cast
 
--------------------------------------------------------------------
+
+
+------------------------------------------------------------------------------
 --
---     The representation of datatype constructors 
---      To be extended by fixity, associativity, and what else?
+--     The Data class
 --
--------------------------------------------------------------------
+------------------------------------------------------------------------------
 
--- | Describes a constructor
-data Constr = Constr { conString :: String }
+{- 
 
+The Data class comprehends two important primitives "gfoldl" and
+"gunfold" for folding and unfolding constructor applications, say
+terms. Besides, there are helpers "conOf" and "consOf" for retrieving
+constructors from terms and types. Finally, typical ways of mapping
+over immediate subterms are defined as "gmap" combinators in terms
+of gfoldl. A generic programmer does not necessarily need to use
+the ingenious gfoldl/gunfold couple but rather the "gmap" combinators. 
 
+-}
 
----------------------------------------------
---
---     The Data class and its operations
---
----------------------------------------------
+class Typeable a => Data a where
 
--- A class for traversal
+{-
 
-class Typeable a => Data a where
-  gmapT   :: (forall b. Data b => b -> b) -> a -> a
-  gmapQ   :: (forall a. Data a => a -> u) -> a -> [u]
-  gmapM   :: Monad m => (forall a. Data a => a -> m a) -> a -> m a
+Folding constructor applications ("gfoldl")
 
-  gfoldl  :: (forall a b. Data a => c (a -> b) -> a -> c b)
-          -> (forall g. g -> c g)
-          -> a -> c a
+The combinator takes two arguments "f" and "z" to fold over a term
+"x".  The result type is parametric via a type constructor "c" in the
+type of "gfoldl". The purpose of "z" is to define how the empty
+constructor application is folded. So "z" is like the neutral / start
+element for list folding. The purpose of "f" is to define how the
+nonempty constructor application is folded. That is, "f" takes the
+folded "tail" of the constructor application and its head, i.e., an
+immediate subterm, and combines them in some way. See the Data
+instances in this file which illustrate gfoldl. Conclusion: the type
+of gfoldl is a headache, but operationally it is simple generalisation
+of a list fold.
+
+-}
 
-  gfoldr  :: (forall a b. Data a => a -> c (a -> b) -> c b)
+  -- | Left-associative fold operation for constructor applications
+  gfoldl  :: (forall a b. Data a => c (a -> b) -> a -> c b)
           -> (forall g. g -> c g)
           -> a -> c a
 
+{-
 
-  -- | Find the constructor
-  conOf   :: a -> Constr
+Unfolding constructor applications ("gunfold")
+
+The combinator takes alike "gfoldl" two arguments "f" and "z", but
+this time its about constructing (say, unfolding) constructor
+applications rather than folding. The input for unfolding is primarily
+an opaque representation of the desired constructor, which is
+essentially a string representation of the constructor. (It is in the
+responsibility of the programmer not to attempt unfolding invalid
+constructors.  This is like the side condition that a programmer must
+not apply the "head" function to the empty list.) Besides the
+constructor, we also have to provide the "input" for constructing
+immediate subterms. This is anticipated via the type constructor "c"
+in the type of "gunfold". For example, in the case of a generic read
+function, "c" models string-processing functions. So "z" defines how
+to construct the empty constructor application, and "f" takes an
+incomplete constructor application to add more immediate subterm.
+Conclusion: the type of gunfoldl and what it does is a headache, but
+operationally it is a simple generalisation of the underappreciated
+list unfold.
 
-  -- | Does not look at a; Could live in Typeable as well maybe
-  consOf  :: a -> [Constr]
+-}
 
+  -- | Unfold operation to build terms from constructors and others
   gunfold :: (forall a b. Data a => c (a -> b) -> c b)
           -> (forall g. g -> c g)
           -> Constr
           -> c a
 
-  -- No default method for gfoldl, gunfold, conOf, consOf
+  -- Default definition for gfoldl
+  -- which copes immediately with basic datatypes
+  --
+  gfoldl _ z = z
 
-  -- Default methods for gfoldr, gmapT, gmapQ, gmapM, 
-  -- in terms of gfoldl
+  -- | Obtain the constructor from a given term
+  conOf   :: a -> Constr
+
+  -- | List all constructors for a given type
+  consOf  :: a -> [Constr]
+
+
+
+------------------------------------------------------------------------------
+--
+--     Typical generic maps defined in terms of gfoldl
+--
+------------------------------------------------------------------------------
+
+{-
+
+The combinators gmapT, gmapQ, gmapM, gmapF can all be defined in terms
+of gfoldl. We provide corresponding default definitions leaving open
+the opportunity to provide datatype-specific definitions if needed.
+
+(Also, the inclusion of the gmap combinators as members of class Data
+allows the programmer or the compiler to derive specialised, and maybe
+more efficient code per datatype. Note: gfoldl is more higher-order
+than the gmap combinators. This is subject to ongoing benchmarking
+experiments.)
 
-  gfoldr f z = gfoldl (flip f) z
+Conceptually, the definition of the gmap combinators in terms of the
+primitive gfoldl requires the identification of the gfoldl function
+arguments. Technically, we also need to identify the type constructor
+c used all over the type of gfoldl.
+
+-}
 
+  -- | A generic transformation that maps over the immediate subterms
+  gmapT   :: (forall b. Data b => b -> b) -> a -> a
+
+  -- Use an identity datatype constructor ID (see below)
+  -- to instantiate the type constructor c in the type of gfoldl,
+  -- and perform injections ID and projections unID accordingly.
+  --
   gmapT f x = unID (gfoldl k ID x)
     where
       k (ID c) x = ID (c (f x))
 
+
+  -- | A generic query that processes the immediate subterms and returns a list
+  gmapQ   :: (forall a. Data a => a -> u) -> a -> [u]
+
+  -- Use a phantom + function datatype constructor Q (see below),
+  -- to instantiate the type constructor c in the type of gfoldl,
+  -- and perform injections Q and projections unQ accordingly.
+  --
   gmapQ f x = unQ (gfoldl k (const (Q id)) x) []
     where
       k (Q c) x = Q (\rs -> c (f x : rs))
 
+
+  -- | A generic monadic transformation that maps over the immediate subterms
+  gmapM   :: Monad m => (forall a. Data a => a -> m a) -> a -> m a
+
+  -- Use immediately the monad datatype constructor 
+  -- to instantiate the type constructor c in the type of gfoldl,
+  -- so injection and projection is done by return and >>=.
+  --  
   gmapM f = gfoldl k return
-          where
-            k c x = do c' <- c
-                       x' <- f x
-                       return (c' x')
+    where
+      k c x = do c' <- c
+                 x' <- f x
+                 return (c' x')
 
 
-  -- Default definition for gfoldl copes with basic datatypes
-  gfoldl _ z = z
+  -- | Transformation of at least one immediate subterm does not fail
+  gmapF :: MonadPlus m => (forall a. Data a => a -> m a) -> a -> m a
 
+  -- Use a datatype constructor F (see below)
+  -- to instantiate the type constructor c in the type of gfoldl.
+  --  
+  gmapF f x = unF (gfoldl k z x) >>= \(x',b) ->
+              if b then return x' else mzero
+    where
+      z g = F (return (g,False))
+      k (F c) x
+        = F ( c >>= \(h,b) -> 
+              (f x >>= \x' -> return (h x',True))
+              `mplus` return (h x, b)
+            )
 
-{-
- A variation for gmapQ using an ordinary constant type constructor.
- A problem is here that the associativety might be wrong.
 
-  newtype Phantom x y = Phantom x
-  runPhantom (Phantom x) = x
+-- | The identity type constructor needed for the definition of gmapT
+newtype ID x = ID { unID :: x }
 
-  gmapQ f = runPhantom . gfoldl f' z
-   where
-    f' r a = Phantom (f a : runPhantom r)
-    z  = const (Phantom [])
--}
 
--- | Instructive type synonyms
-type GenericT = forall a. Data a => a -> a
-type GenericQ r = forall a. Data a => a -> r
-type GenericM m = forall a. Data a => a -> m a
+-- | A phantom datatype constructor used in definition of gmapQ;
+--   the function-typed component is needed to mediate between
+--   left-associative constructor application vs. right-associative lists.
+-- 
+newtype Q r a = Q { unQ  :: [r] -> [r] }
 
 
--- Auxiliary type constructors for the default methods (not exported)
-newtype ID x = ID { unID :: x }
-newtype Q r a = Q { unQ  :: [r]->[r] }
-newtype TQ r a = TQ { unTQ :: ([r]->[r],[GenericQ' r]) }
+-- | A pairing type constructor needed for the definition of gmapF;
+-- we keep track of the fact if a subterm was ever transformed successfully.
+newtype F m x = F { unF :: m (x, Bool) }
 
--- A twin variation on gmapQ
--- Note: Nested GenericQ (GenericQ ...) buggy in GHC 5.04
 
-tmapQ :: forall r.
-         (forall a b. (Data a, Data b) => a -> b -> r)
-      -> (forall a b. (Data a, Data b) => a -> b -> [r])
 
-tmapQ g x y = fst (unTQ (gfoldl k z y)) []
-    where
-      k (TQ (c,l)) x = TQ (\rs -> c (unQ' (head l) x:rs), tail l)
-      z _            = TQ (id,gmapQ (\x -> Q' (g x)) x)
+------------------------------------------------------------------------------
+--
+--     The Constr datatype for describing datatype constructors
+--      To be extended by fixity, associativity, and maybe others.
+--
+------------------------------------------------------------------------------
 
--- A first-class polymorphic version of GenericQ
+-- | Description of datatype constructors
+data Constr = Constr { conString :: String } deriving (Eq, Typeable)
 
-data GenericQ' u = Q' { unQ' :: forall a. Data a => a -> u }
 
+{-
 
+It is interesting to observe that we can determine the arity of a
+constructor without further meta-information. To this end, we use
+gunfold to construct a term from a given constructor while leaving the
+subterms undefined; see "gundefineds" below. Here we instantiate the
+type constructor c of the gunfold type by the identity type
+constructor ID. In a subsequent step we determine the number of
+subterms by folding as captured in the generic operation "glength"
+elsewhere in this module. Note that we need a type argument to specify
+the intended type of the constructor.
 
--- A first-class polymorphic version of GenericM
+-}
 
-data Monad m => GenericM' m = M' { unM' :: forall a. Data a => a -> m a }
 
--- A type constructor for monadic twin transformations
-newtype TM m a = TM { unTM :: (m a,[GenericM' m]) }
+-- | Compute arity of a constructor against a type argument
+garity :: Data a => (a -> ()) -> Constr -> Int
+garity ta = glength . gundefineds ta
+
+
+-- | Construct a term from a constructor with undefined subterms
+gundefineds :: Data a => (a -> ()) -> Constr -> a
+gundefineds (_::a -> ()) = (unID :: ID a -> a)
+                         . gunfold ((\f -> ID (f undefined)) . unID) ID
 
--- A twin variation on gmapM
 
-tmapM :: forall m. Monad m
-      => (forall a b. (Data a, Data b) => a -> b -> m b)
-      -> (forall a b. (Data a, Data b) => a -> b -> m b)
-tmapM g x y = fst (unTM (gfoldl k z y))
-  where
-    k (TM (f,l)) x = TM (f >>= \f' -> unM' (head l) x >>= return . f',tail l)
-    z f            = TM (return f,gmapQ (\x -> M' (g x)) x)
 
----------------------------------------------
+------------------------------------------------------------------------------
 --
---     Combinators for data structure traversal
+--     Frequently used generic traversal schemes
 --
----------------------------------------------
+------------------------------------------------------------------------------
+
+-- | Apply a transformation everywhere in bottom-up manner
+everywhere :: (forall a. Data a => a -> a)
+           -> (forall a. Data a => a -> a)
+
+-- Use gmapT to recurse into immediate subterms;
+-- recall: gmapT preserves the outermost constructor;
+-- post-process recursively transformed result via f
+-- 
+everywhere f = f . gmapT (everywhere f)
+
+
+-- | Apply a transformation everywhere in top-down manner
+everywhere' :: (forall a. Data a => a -> a)
+            -> (forall a. Data a => a -> a)
+
+-- Arguments of (.) are flipped compared to everywhere
+everywhere' f = gmapT (everywhere' f) . f
+
+
+-- | Variation on everywhere with an extra stop condition
+everywhereBut :: GenericQ Bool -> GenericT -> GenericT
+
+-- Guarded to let traversal cease if predicate q holds for x
+everywhereBut q f x
+    | q x       = x
+    | otherwise = f (gmapT (everywhereBut q f) x)
+
+
+-- | Monadic variation on everywhere
+everywhereM :: Monad m => GenericM m -> GenericM m
+
+-- Bottom-up order is also reflected in order of do-actions
+everywhereM f x = do x' <- gmapM (everywhereM f) x
+                     f x'
+
+
+-- | Apply a monadic transformation at least somewhere
+somewhere :: MonadPlus m => GenericM m -> GenericM m
 
--- | Summarise all nodes in top-down, left-to-right
-everything :: Data a
-           => (r -> r -> r)
-           -> (forall a. Data a => a -> r)
-           -> a -> r
+-- We try "f" in top-down manner, but descent into "x" when we fail
+-- at the root of the term. The transformation fails if "f" fails
+-- everywhere, say succeeds nowhere.
+-- 
+somewhere f x = f x `mplus` gmapF (somewhere f) x
+
+
+-- | Summarise all nodes in top-down, left-to-right order
+everything :: (r -> r -> r) -> GenericQ r -> GenericQ r
+
+-- Apply f to x to summarise top-level node;
+-- use gmapQ to recurse into immediate subterms;
+-- use ordinary foldl to reduce list of intermediate results
+-- 
 everything k f x 
-     = foldl k (f x) (gmapQ (everything k f) x)
+  = foldl k (f x) (gmapQ (everything k f) x)
 
 
+-- | Get a list of all entities that meet a predicate
+listify :: Typeable r => (r -> Bool) -> GenericQ [r]
+listify p
+  = everything (++) ([] `mkQ` (\x -> if p x then [x] else []))
 
--- | Look up something by means of a recognizer
-something :: (forall a. Data a => a -> Maybe u)
-          -> (forall a. Data a => a -> Maybe u)
+
+-- | Look up a subterm by means of a maybe-typed filter
+something :: GenericQ (Maybe u) -> GenericQ (Maybe u)
+
+-- "something" can be defined in terms of "everything"
+-- when a suitable "choice" operator is used for reduction
+-- 
 something = everything orElse
 
 
+-- | Bottom-up synthesis of a data structure;
+--   1st argument z is the initial element for the synthesis;
+--   2nd argument o is for reduction of results from subterms;
+--   3rd argument f updates the sythesised data according to the given term
+--
+synthesize :: s  -> (s -> s -> s) -> GenericQ (s -> s) -> GenericQ s
+synthesize z o f x = f x (foldr o z (gmapQ (synthesize z o f) x))
 
--- | Left-biased choice
-orElse :: Maybe a -> Maybe a -> Maybe a
-x `orElse` y = case x of
-                Just _  -> x
-                Nothing -> y
 
 
+-----------------------------------------------------------------------------
+--
+--     "Twin" variations on gmapT, gmapQ. gmapM,
+--      i.e., these combinators take two terms at the same time.
+--     They are needed for multi-parameter traversal as generic equality.
+--     They are not exported.
+--
+-----------------------------------------------------------------------------
 
--- | Some people like folding over the first maybe instead
-x `orElse'` y = maybe y Just x
+{-
 
+We need type constructors for twin traversal as we needed type
+constructor for the ordinary gmap combinators. These type constructors
+again serve for the instantiation of the type constructor c used in
+the definition of gfoldl. The type constructors for twin traversal are
+elaborations of the type constructors ID, Q and monads that were used
+for the ordinary gmap combinators. More precisely, we use a pairing
+technique to always attach an additional component to the results of
+folding. This additional component carries the list of generic 
+functions to be used for the intermediate subterms encountered during
+folding.
 
+-}
 
--- | Bottom-up synthesis of a data structure
-synthesize :: (forall a. Data a => a -> s -> s)
-           -> (s -> s -> s)
-           -> s
-           -> (forall a. Data a => a -> s)
-synthesize f o z x = f x (foldr o z (gmapQ (synthesize f o z) x))
+newtype TT r a = TT { unTT :: (a,[GenericT']) }
+newtype TQ r a = TQ { unTQ :: ([r]->[r],[GenericQ' r]) }
+newtype TM m a = TM { unTM :: (m a,[GenericM' m]) }
 
 
+-- First-class polymorphic versions of GenericT/GenericQ/GenericM;
+-- they are referenced in TQ amd TM above
+-- 
+data GenericT' = T' { unT' :: forall a. Data a => a -> a }
+data GenericQ' u = Q' { unQ' :: forall a. Data a => a -> u }
+data Monad m => GenericM' m = M' { unM' :: forall a. Data a => a -> m a }
 
--- | Apply a transformation everywhere in bottom-up manner
-everywhere :: (forall a. Data a => a -> a)
-           -> (forall a. Data a => a -> a)
-everywhere f = f . gmapT (everywhere f)
 
+{-
 
+A twin variation on gmapT, where the pattern "GenericQ GenericT"
+expresses that the argument terms x and y are processed rather
+independently. So firstly, x is "queried" with a generic
+transformation as intermediate result, and secondly, this generic
+transformation is applied to y.
 
--- | Variation with stop condition
-everywhereBut :: GenericQ Bool 
-              -> GenericT -> GenericT
-everywhereBut q f x
-    | q x       = x
-    | otherwise = f (gmapT (everywhereBut q f) x)
+-}
 
+tmapT :: GenericQ GenericT -> GenericQ GenericT
+tmapT g x y = fst (unTT (gfoldl k z y))
+  where
+    k (TT (f,l)) x = TT (f (unT' (head l) x),tail l)
+    z f            = TT (f,gmapQ (\x -> T' (g x)) x)
 
 
--- | Monadic variation
-everywhereM :: (Monad m, Data a)
-            => (forall b. Data b => b -> m b)
-            -> a -> m a
-everywhereM f x = do x' <- gmapM (everywhereM f) x
-                     f x'
 
+-- A twin variation on gmapQ
+
+tmapQ :: forall r.
+         (forall a b. (Data a, Data b) => a -> b -> r)
+      -> (forall a b. (Data a, Data b) => a -> b -> [r])
+
+tmapQ g x y = fst (unTQ (gfoldl k z y)) []
+    where
+      k (TQ (c,l)) x = TQ (\rs -> c (unQ' (head l) x:rs), tail l)
+      z _            = TQ (id,gmapQ (\x -> Q' (g x)) x)
 
--- | Count immediate subterms
-branches :: Data a => a -> Int
-branches = length . gmapQ (const ())
 
+-- A twin variation on gmapM
+
+tmapM :: forall m. Monad m
+      => (forall a b. (Data a, Data b) => a -> b -> m b)
+      -> (forall a b. (Data a, Data b) => a -> b -> m b)
+tmapM g x y = fst (unTM (gfoldl k z y))
+  where
+    k (TM (f,l)) x = TM (f >>= \f' -> unM' (head l) x >>= return . f',tail l)
+    z f            = TM (return f,gmapQ (\x -> M' (g x)) x)
 
--- |  Construct term with undefined subterms
-undefineds :: Data a => Constr -> Maybe a
-undefineds i =  gunfold (maybe Nothing (\x -> Just (x undefined)))
-                        Just
-                        i
 
 
----------------------------------------------
+------------------------------------------------------------------------------
 --
---     Generic equality, zip, read, show
+--     Generic operations such as show, equality, read
 --
----------------------------------------------
+------------------------------------------------------------------------------
+
+-- | Count the number of immediate subterms of the given term
+glength :: GenericQ Int
+glength = length . gmapQ (const ())
+
+
+-- | Determine the number of all suitable nodes in a given term
+gcount :: GenericQ Bool -> GenericQ Int
+gcount p =  everything (+) (\x -> if p x then 1 else 0)
+
+
+-- | Determine the number of all nodes in a given term
+gnodecount :: GenericQ Int
+gnodecount = gcount (const True)
+
+
+-- | Determine the number of nodes of a given type in a given term
+gtypecount :: Typeable a => (a -> ()) -> GenericQ Int
+gtypecount f = gcount (False `mkQ` (const True . f))
+
+
+-- | Generic show: an alternative to \"deriving Show\"
+gshow :: Data a => a -> String
+
+-- This is a prefix-show using surrounding "(" and ")",
+-- where we recurse into subterms with gmapQ.
+-- 
+gshow = ( \t ->
+                "("
+             ++ conString (conOf t)
+             ++ concat (gmapQ ((++) " " . gshow) t)
+             ++ ")"
+        ) `extQ` (show :: String -> String)
+
+
+-- | Generic equality: an alternative to \"deriving Eq\"
+geq :: Data a => a -> a -> Bool
+
+{-
+
+Testing for equality of two terms goes like this. Firstly, we
+establish the equality of the two top-level datatype
+constructors. Secondly, we use a twin gmap combinator, namely tgmapQ,
+to compare the two lists of immediate subterms.
+
+(Note for the experts: the type of the worker geq' is rather general
+but precision is recovered via the restrictive type of the top-level
+operation geq. The imprecision of geq' is caused by the type system's
+unability to express the type equivalence for the corresponding
+couples of immediate subterms from the two given input terms.)
+
+-}
 
--- | Generic equality
-geq :: forall a. Data a => a -> a -> Bool
 geq x y = geq' x y
  where
   geq' :: forall a b. (Data a, Data b) => a -> b -> Bool
@@ -352,10 +683,11 @@ geq x y = geq' x y
                  )
 
 
-
--- | Generic zip
+-- | 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`
@@ -364,83 +696,132 @@ gzip f x y =
    else Nothing
 
 
--- Generic show
-gshow :: Data a => a -> String
-gshow t =    "("
-          ++ conString (conOf t)
-          ++ concat (gmapQ ((++) " ". gshow) t)
-          ++ ")"
-
-
-
--- The type constructor for unfold a la ReadS from the Prelude
+-- | The type constructor for gunfold a la ReadS from the Haskell 98 Prelude;
+--   we don't use lists here for simplicity but only maybes.
 newtype GRead i a = GRead (i -> Maybe (a, i))
 unGRead (GRead x) = x
 
 
+-- | Generic read: an alternative to \"deriving Read\"
+gread :: GenericB Maybe String
 
--- Generic read
-gread :: Data a => String -> Maybe (a, String)
-gread s
- = do s' <- return $ dropWhile ((==) ' ') s
-      guard (not (s' == ""))
-      guard (head s' == '(')
-      (c,s'')  <- breakConOf (dropWhile ((==) ' ') (tail s'))
-      (a,s''') <- unGRead (gunfold f z c) s''
-      guard (not (s''' == "")) 
-      guard (head s''' == ')')
-      return (a,tail s''')
- where
-  f cab = GRead (\s -> do (ab,s') <- unGRead cab s
-                          (a,s'')  <- gread s'
-                          return (ab a,s''))
-  z c = GRead (\s -> Just (c,s))
-
-
--- Get Constr at front
-breakConOf :: String -> Maybe (Constr, String)
-
--- Assume an infix operators in parantheses
-breakConOf ('(':s)
- = case break ((==) ')') s of
-     (s'@(_:_),(')':s'')) -> Just (Constr ("(" ++ s' ++ ")"), s'')
-     _ -> Nothing
+{-
 
--- Special treatment of multiple token constructors
-breakConOf ('[':']':s) = Just (Constr "[]",s)
+This is a read operation which insists on prefix notation.  (The
+Haskell 98 read deals with infix operators as well. We will be able to
+deal with such special cases as well as sonn as we include fixity
+information into the definition of "Constr".)  We use gunfold to
+"parse" the input. To be precise, gunfold is used for all result types
+except String. The type-specific case for String uses basic String
+read. Another source of customisation would be to properly deal with
+infix operators subject to the capture of that information in the
+definition of Constr. The "gread" combinator properly checks the 
+validity of constructors before invoking gunfold in order to rule
+out run-time errors.
 
--- Try lex for ordinary constructor and basic datatypes
-breakConOf s
- = case lex s of
-     [(s'@(_:_),s'')] -> Just (Constr s',s'')
-     _ -> Nothing
+-}
 
+gread = gdefault `extB` scase
 
+ where
 
----------------------------------------------
+  -- a specific case for strings
+  scase s = case reads s of
+              [x::(String,String)] -> Just x
+              _ -> Nothing
+
+  -- the generic default of gread
+  gdefault s =
+    do s' <- return $ dropWhile ((==) ' ') s
+       guard (not (s' == ""))
+       guard (head s' == '(')
+       (c,s'')  <- prefixConstr (dropWhile ((==) ' ') (tail s'))
+       u <- return undefined 
+       guard (or [consOf u == [], c `elem` consOf u])
+       (a,s''') <- unGRead (gunfold f z c) s''
+       _ <- return $ constrainTypes a u
+       guard (not (s''' == "")) 
+       guard (head s''' == ')')
+       return (a, tail s''')
+
+  -- To force two types to be the same
+  constrainTypes :: a -> a -> ()
+  constrainTypes _ _ = ()
+
+  -- Argument f for unfolding
+  f :: Data a => GRead String (a -> b) -> GRead String b
+  f x = GRead (\s -> do (r,s') <- unGRead x s
+                        (t,s'')  <- gread s'
+                        return (r t,s''))
+
+  -- Argument z for unfolding
+  z ::  forall g. g -> GRead String g
+  z g = GRead (\s -> return (g,s))
+
+  -- Get Constr at front of string
+  prefixConstr :: String -> Maybe (Constr, String)
+
+  -- Assume an infix operators in parantheses
+  prefixConstr ('(':s)
+    = case break ((==) ')') s of
+        (s'@(_:_),(')':s'')) -> Just (Constr ("(" ++ s' ++ ")"), s'')
+        _ -> Nothing
+
+  -- Special treatment of multiple token constructors
+  prefixConstr ('[':']':s) = Just (Constr "[]",s)
+
+  -- Try lex for ordinary constructor and basic datatypes
+  prefixConstr s
+    = case lex s of
+        [(s'@(_:_),s'')] -> Just (Constr s',s'')
+        _ -> Nothing
+
+
+
+------------------------------------------------------------------------------
 --
 --     Instances of the Data class
 --
----------------------------------------------
+------------------------------------------------------------------------------
+
+-- Basic datatype Int; folding and unfolding is trivial
+instance Data Int where
+ conOf x = Constr (show x)
+ consOf _ = []
+ gunfold f z c = z (read (conString c))
+
+-- Another basic datatype instance
+instance Data Integer where
+ conOf x = Constr (show x)
+ consOf _ = []
+ gunfold f z c = z (read (conString c))
 
+-- Another basic datatype instance
 instance Data Float where
  conOf x = Constr (show x)
  consOf _ = []
  gunfold f z c = z (read (conString c))
 
+-- Another basic datatype instance
 instance Data Char where
  conOf x = Constr (show x)
  consOf _ = []
  gunfold f z c = z (read (conString c))
 
-{-      overlap
-instance Data String where
+{-
+
+Commented out;
+subject to inclusion of a missing Typeable instance
+
+-- Another basic datatype instance
+instance Data Rational where
  conOf x = Constr (show x)
  consOf _ = []
- gunfold f z = z . read
+ gunfold f z c = z (read (conString c))
 
 -}
 
+-- Bool as a kind of enumeration type
 instance Data Bool where
  conOf False = Constr "False"
  conOf True  = Constr "True"
@@ -448,6 +829,29 @@ instance Data Bool where
  gunfold f z (Constr "False") = z False
  gunfold f z (Constr "True")  = z True
 
+{-
+
+We should better not fold over characters in a string for efficiency.
+However, the following instance would clearly overlap with the
+instance for polymorphic lists. Given the current scheme of allowing
+overlapping instances, this would imply that ANY module that imports
+Data.Generics would need to explicitly and generally allow overlapping
+instances. This is prohibitive and calls for a more constrained model
+of allowing overlapping instances. The present instance would also be
+more sensible for UNFOLDING. In the definition of gread, we still
+obtained the favoured behaviour by using a type-specific case for
+String.
+
+-- instance Data String where
+ conOf x = Constr (show x)
+ consOf _ = []
+ gunfold f z c = z (read (conString c))
+
+-}
+
+-- Cons-lists are terms with two immediate subterms. Hence, the gmap
+-- combinators do NOT coincide with the list fold/map combinators.
+--
 instance Data a => Data [a] where
   gmapT  f   []     = []
   gmapT  f   (x:xs) = (f x:f xs)
@@ -457,135 +861,91 @@ instance Data a => Data [a] where
   gmapM  f   (x:xs) = f x >>= \x' -> f xs >>= \xs' -> return (x':xs')
   gfoldl f z []     = z []
   gfoldl f z (x:xs) = z (:) `f` x `f` xs
-  gfoldr f z []     = z []
-  gfoldr f z (x:xs) = f xs (f x (z (:)))
   conOf [] = Constr "[]"
   conOf (_:_) = Constr "(:)"
+  consOf _ = [Constr "[]",Constr "(:)"]
   gunfold f z (Constr "[]")  = z []
   gunfold f z (Constr "(:)") = f (f (z (:)))
-  consOf _ = [Constr "[]",Constr "(:)"]
 
-
-
-
-{- ----------------------------------------------------
-       Comments illustrating generic instances
-
-   An illustrative instance for a nested datatype
-   
-   data Nest a = Box a | Wrap (Nest [a])
-    
-    nestTc = mkTyCon "Nest"
-    
-    instance Typeable a => Typeable (Nest a) where
-      typeOf n = mkAppTy nestTc [typeOf (paratype n)]
-       where
-       paratype :: Nest a -> a
-       paratype _ = undefined
-   
-   instance (Data a, Data [a]) => Data (Nest a) where
-    gmapT f (Box a)  = Box (f a)
-    gmapT f (Wrap w) = Wrap (f w)
-    gmapQ f (Box a)  = [f a]
-    gmapQ f (Wrap w) = [f w]
-    gmapM f (Box a)  = f a >>= return . Box
-    gmapM f (Wrap w) = f w >>= return . Wrap
-    conOf (Box _) = Constr "Box"
-    conOf (Wrap _) = Constr "Wrap"
-    consOf _ = map Constr ["Box","Wrap"]
-    gunfold f z "Box"  = f (z Box)
-    gunfold f z "Wrap" = f (z Wrap)
-   
-   
-   
-   -- An illustrative instance for local quantors
-   
-   instance Data GenericT' where
-    gmapT f (T' g) = (T' (f g))
-    conOf _ = Constr "T'"
-    consOf _ = map Constr ["T'"]
-   
-   
-   -- test code only
-   instance Typeable GenericT' where
-    typeOf _ = undefined
-   
-   
-   
-   -- The instance for function types
-   -- needs -fallow-undecidable-instances
-
-instance Typeable (a -> b) => Data (a -> b) where
- gmapT f = id
- gmapQ f = const []
- gmapM f = return
+-- Yet enother polymorphic datatype constructor
+instance Data a => Data (Maybe a) where
+ gfoldl f z Nothing  = z Nothing
+ gfoldl f z (Just x) = z Just `f` x
+ conOf Nothing  = Constr "Nothing"
+ conOf (Just _) = Constr "Just"
+ consOf _ = [Constr "Nothing", Constr "Just"]
+ gunfold f z c | conString c == "Nothing" = z Nothing
+ gunfold f z c | conString c == "Just"    = f (z Just)
+
+-- Yet enother polymorphic datatype constructor
+instance (Data a, Data b) => Data (a,b) where
+ gfoldl f z (a,b) = z (,) `f` a `f` b
+ conOf _ = Constr "(,)"
+ consOf _ = [Constr "(,)"]
+ gunfold f z c | conString c == "(,)" = f (f (z (,)))
+
+-- Functions are treated as "non-compound" data regarding folding while
+-- unfolding is out of reach, maybe not anymore with Template Haskell.
+-- 
+instance (Typeable a, Typeable b) => Data (a -> b) where
  conOf _ = Constr "->"
  consOf _ = [Constr "->"]
--}
-
-
---------------------------------------------------------
--- A first-class polymorphic version of GenericT
--- Note: needed because [GenericT] not valid in GHC 5.04
-
-{-     Comment out for now (SLPJ 17 Apr 03)
-
-data GenericT' = T' (forall a. Data a => a -> a)
-unT' (T' x) = x
+ gunfold _ _ _ = undefined
 
--- A type constructor for twin transformations
 
-newtype IDL r a = IDL (a,[GenericT'])
-unIDL (IDL x) = x
 
+------------------------------------------------------------------------------
+--
+--     Miscellaneous
+--
+------------------------------------------------------------------------------
 
-
--- A twin variation on gmapT
-
-tmapT :: (forall a b. (Data a, Data b) => a -> b -> b)
-      -> (forall a b. (Data a, Data b) => a -> b -> b)
-tmapT g x y = fst (unIDL (gfoldl k z y))
-  where
-    k (IDL (f,l)) x = IDL (f (unT' (head l) x),tail l)
-    z f             = IDL (f,gmapQ (\x -> T' (g x)) x)
+-- | Test for two objects to agree on the type
+sameType :: (Typeable a, Typeable b) => a -> b -> Bool
+sameType (_::a) = maybe False (\(_::a) -> True) . cast
 
 
+-- | Left-biased choice on maybes (non-strict in right argument)
+orElse :: Maybe a -> Maybe a -> Maybe a
+x `orElse` y = maybe y Just x
 
--- A first-class polymorphic version of GenericQ
 
-data GenericQ' u = Q' (forall a. Data a => a -> u)
-unQ' (Q' x) = x
+-- Another definition of orElse
+-- where the folding over maybies as defined by maybe is inlined
+-- to ease readability
+-- 
+x `orElse'` y = case x of
+                  Just _  -> x
+                  Nothing -> y
 
 
+{-
 
+The following variations take "orElse" to the function
+level. Furthermore, we generalise from "Maybe" to any
+"MonadPlus". This makes sense for monadic transformations and
+queries. We say that the resulting combinators modell choice. We also
+provide a prime example of choice, that is, recovery from failure. In
+the case of transformations, we recover via return whereas for
+queries a given constant is returned.
 
 -}
 
+-- | Choice for monadic transformations
+choiceF :: MonadPlus m => GenericM m -> GenericM m -> GenericM m
+choiceF f g x = f x `mplus` g x
 
 
+-- | Choice for monadic queries
+choiceQ :: MonadPlus m => GenericQ (m r) -> GenericQ (m r) -> GenericQ (m r)
+choiceQ f g x = f x `mplus` g x
 
 
--- Compute arity of term constructor
-
-
--- | Turn a predicate into a filter
-match :: (Typeable a, Typeable b) => (a -> Bool) -> b -> Maybe a
-match f = Nothing `mkQ` (\ a -> if f a then Just a else Nothing)
-
-
-
--- | Turn a predicate into a ticker
-tick :: (Typeable a, Typeable b) => (a -> Bool) -> b -> Int
-tick f = 0 `mkQ` (\a -> if f a then 1 else 0)
-
-
-
--- | Turn a ticker into a counter
-count :: (Typeable a, Data b) => (a -> Bool) -> b -> Int
-count f = everything (+) (tick f)
-
+-- | Recover from the failure of monadic transformation by identity
+recoverF :: MonadPlus m => GenericM m -> GenericM m
+recoverF f = f `choiceF` return
 
 
--- | Lift a monomorphic predicate to the polymorphic level
-alike :: (Typeable a, Typeable b) => (a -> Bool) -> b -> Bool
-alike f = False `mkQ` f
+-- | Recover from the failure of monadic query by a constant
+recoverQ :: MonadPlus m => r -> GenericQ (m r) -> GenericQ (m r)
+recoverQ r f = f `choiceQ` const (return r)