[project @ 2005-02-02 13:47:24 by simonpj]

[ghc-base.git] / Data / Generics / Schemes.hs

diff --git a/Data/Generics/Schemes.hs b/Data/Generics/Schemes.hs
index fd10942..5234b01 100644 (file)
--- a/Data/Generics/Schemes.hs
+++ b/Data/Generics/Schemes.hs
@@ -8,14 +8,14 @@
 -- Stability   :  experimental
 -- Portability :  non-portable
 --
--- "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
+-- frequently used generic traversal schemes.
 --
 -----------------------------------------------------------------------------
 
 module Data.Generics.Schemes ( 
 
-       -- * Frequently used generic traversal schemes
         everywhere,
         everywhere',
         everywhereBut,
@@ -25,17 +25,26 @@ module Data.Generics.Schemes (
        listify,
         something,
        synthesize,
+       gsize,
+       glength,
+       gdepth,
+       gcount,
+       gnodecount,
+       gtypecount,
+       gfindtype
 
  ) where
 
 ------------------------------------------------------------------------------
 
+#ifdef __HADDOCK__
+import Prelude
+#endif
 import Data.Generics.Basics
 import Data.Generics.Aliases
 import Control.Monad
 
 
-
 -- | Apply a transformation everywhere in bottom-up manner
 everywhere :: (forall a. Data a => a -> a)
            -> (forall a. Data a => a -> a)
@@ -79,18 +88,18 @@ somewhere :: MonadPlus m => GenericM m -> GenericM m
 -- 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
+somewhere f x = f x `mplus` gmapMp (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 gmapL to recurse into immediate subterms;
+-- use gmapQ to recurse into immediate subterms;
 -- use ordinary foldl to reduce list of intermediate results
 -- 
 everything k f x 
-  = foldl k (f x) (gmapL (everything k f) x)
+  = foldl k (f x) (gmapQ (everything k f) x)
 
 
 -- | Get a list of all entities that meet a predicate
@@ -111,7 +120,49 @@ 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
+--   3rd argument f updates the synthesised 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 (gmapL (synthesize z o f) x))
+synthesize z o f x = f x (foldr o z (gmapQ (synthesize z o f) x))
+
+
+-- | Compute size of an arbitrary data structure
+gsize :: Data a => a -> Int
+gsize t = 1 + sum (gmapQ gsize t)
+
+
+-- | Count the number of immediate subterms of the given term
+glength :: GenericQ Int
+glength = length . gmapQ (const ())
+
+
+-- | Determine depth of the given term
+gdepth :: GenericQ Int
+gdepth = (+) 1 . foldr max 0 . gmapQ gdepth
+
+
+-- | 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 (_::a) = gcount (False `mkQ` (\(_::a) -> True))
+
+
+-- | Find (unambiguously) an immediate subterm of a given type
+gfindtype :: (Data x, Typeable y) => x -> Maybe y
+gfindtype = singleton
+          . foldl unJust []
+          . gmapQ (Nothing `mkQ` Just)
+ where
+  unJust l (Just x) = x:l
+  unJust l Nothing  = l
+  singleton [s] = Just s
+  singleton _   = Nothing