[project @ 2003-07-25 14:36:38 by ralf]

Data.Generics is up and running again!

The testsuite is passed 100% successful.
Much of the Data.Generics code looks better.
So the transition to a new Data class and
the deriving support is completed.

Some detailed changes:

- Rolled back type change for gmapQ.
  (We rather added gmapQl and gmapQr.)
- Renamed gmapF and other "F" to Mp like MonadPlus.
- Reconstructed gread.

diff --git a/Data/Generics/Aliases.hs b/Data/Generics/Aliases.hs
index ceb70c9..2aa8755 100644 (file)
--- a/Data/Generics/Aliases.hs
+++ b/Data/Generics/Aliases.hs
@@ -16,8 +16,8 @@
 module Data.Generics.Aliases ( 
 
        -- * Combinators to \"make\" generic functions via cast
 module Data.Generics.Aliases ( 
 
        -- * Combinators to \"make\" generic functions via cast

-       mkT, mkQ, mkM, mkF, mkB,
-       extT, extQ, extM, extF, extB,
+       mkT, mkQ, mkM, mkMp, mkB,
+       extT, extQ, extM, extMp, extB,

 
        -- * Type synonyms for generic function types
        GenericT, 
 
        -- * Type synonyms for generic function types
        GenericT, 

@@ -31,9 +31,9 @@ module Data.Generics.Aliases (
        orElse,
 
        -- * Function combinators on generic functions
        orElse,
 
        -- * Function combinators on generic functions

-       recoverF,
+       recoverMp,

        recoverQ,
        recoverQ,

-       choiceF,
+       choiceMp,

        choiceQ
 
   ) where
        choiceQ
 
   ) where

@@ -99,14 +99,14 @@ 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.
 --
 -- | Make a generic monadic transformation for MonadPlus;
 --   use \"const mzero\" (i.e., failure) instead of return as default.
 --

-mkF :: ( MonadPlus m,
-         Typeable a,
-         Typeable b,
-         Typeable (m a),
-         Typeable (m b)
-       )
+mkMp :: ( MonadPlus m,
+          Typeable a,
+          Typeable b,
+          Typeable (m a),
+          Typeable (m b)
+        )

     => (b -> m b) -> a -> m a
     => (b -> m b) -> a -> m a

-mkF = maybe (const mzero) id . cast
+mkMp = maybe (const mzero) id . cast

 
 
 -- | Make a generic builder;
 
 
 -- | Make a generic builder;

@@ -142,14 +142,14 @@ extM f = maybe f id . cast
 
 
 -- | Extend a generic MonadPlus transformation by a type-specific case
 
 
 -- | Extend a generic MonadPlus transformation by a type-specific case

-extF :: ( MonadPlus m,
-          Typeable a,
-          Typeable b,
-          Typeable (m a),
-          Typeable (m b)
-        )
+extMp :: ( MonadPlus m,
+           Typeable a,
+           Typeable b,
+           Typeable (m a),
+           Typeable (m b)
+         )

      => (a -> m a) -> (b -> m b) -> a -> m a
      => (a -> m a) -> (b -> m b) -> a -> m a

-extF = extM
+extMp = extM

 
 
 
 
 
 

@@ -229,8 +229,8 @@ queries a given constant is returned.
 -}
 
 -- | Choice for monadic transformations
 -}
 
 -- | Choice for monadic transformations

-choiceF :: MonadPlus m => GenericM m -> GenericM m -> GenericM m
-choiceF f g x = f x `mplus` g x
+choiceMp :: MonadPlus m => GenericM m -> GenericM m -> GenericM m
+choiceMp f g x = f x `mplus` g x

 
 
 -- | Choice for monadic queries
 
 
 -- | Choice for monadic queries

@@ -239,8 +239,8 @@ choiceQ f g x = f x `mplus` g x
 
 
 -- | Recover from the failure of monadic transformation by identity
 
 
 -- | Recover from the failure of monadic transformation by identity

-recoverF :: MonadPlus m => GenericM m -> GenericM m
-recoverF f = f `choiceF` return
+recoverMp :: MonadPlus m => GenericM m -> GenericM m
+recoverMp f = f `choiceMp` return

 
 
 -- | Recover from the failure of monadic query by a constant
 
 
 -- | Recover from the failure of monadic query by a constant

diff --git a/Data/Generics/Basics.hs b/Data/Generics/Basics.hs
index e0d6dad..a39a35f 100644 (file)
--- a/Data/Generics/Basics.hs
+++ b/Data/Generics/Basics.hs
@@ -49,9 +49,10 @@ module Data.Generics.Basics (
         -- * Generic maps defined in terms of gfoldl 
        gmapT,
         gmapQ, 
         -- * Generic maps defined in terms of gfoldl 
        gmapT,
         gmapQ, 

-        gmapL,
+        gmapQl,
+        gmapQr,

         gmapM,
         gmapM,

-        gmapF,
+        gmapMp,

 
        -- * Generic unfolding defined in terms of gfoldl and fromConstr
        gunfoldM        -- :: Monad m => ... -> m a
 
        -- * Generic unfolding defined in terms of gfoldl and fromConstr
        gunfoldM        -- :: Monad m => ... -> m a

@@ -146,9 +147,9 @@ fold.
 
 {-
 
 
 {-
 

-The combinators gmapT, gmapQ, gmapL, gmapM, gmapF can all be defined
-in terms of gfoldl. We provide corresponding default definitions
-leaving open the opportunity to provide datatype-specific definitions.
+The combinators gmapT, gmapQ, gmapM, ... can all be defined in terms
+of gfoldl. We provide corresponding default definitions leaving open
+the opportunity to provide datatype-specific definitions.

 
 (The inclusion of the gmap combinators as members of class Data allows
 the programmer or the compiler to derive specialised, and maybe more
 
 (The inclusion of the gmap combinators as members of class Data allows
 the programmer or the compiler to derive specialised, and maybe more

@@ -177,24 +178,40 @@ arguments. Technically, we also need to identify the type constructor
       k (ID c) x = ID (c (f x))
 
 
       k (ID c) x = ID (c (f x))
 
 

-  -- | A generic query with monoid-like operators
-  gmapQ :: (r -> r -> r) -> r -> (forall a. Data a => a -> r) -> a -> r
-  gmapQ o r f = unCONST . gfoldl k z
+  -- | A generic query with a left-associative binary operator
+  gmapQl :: (r -> r' -> r) -> r -> (forall a. Data a => a -> r') -> a -> r
+  gmapQl o r f = unCONST . gfoldl k z

     where
       k c x = CONST $ (unCONST c) `o` f x 
       z _   = CONST r
 
     where
       k c x = CONST $ (unCONST c) `o` f x 
       z _   = CONST r
 

+{-

 
 

-  -- | A generic query that processes the immediate subterms and returns a list
-  gmapL   :: (forall a. Data a => a -> u) -> a -> [u]
+In the definition of gmapQ? combinators, we use phantom type
+constructors for the "c" in the type of "gfoldl" because the result
+type of a query does not involve the (polymorphic) type of the term
+argument. In the definition of gmapQl we simply use the plain constant
+type constructor because gfoldl is left-associative anyway and so it
+is readily suited to fold a left-associative binary operation over the
+immediate subterms. In the definition of gmapQr, extra effort is
+needed. We use a higher-order accumulation trick to mediate between
+left-associative constructor application vs. right-associative binary
+operation (e.g., (:)). When the query is meant to compute a value of
+type r, then the result type withing generic folding is r -> r. So the
+result of folding is a function to which we finally pass the right
+unit.

 
 

-  -- Use a phantom + function datatype constructor QL (see below),
-  -- to instantiate the type constructor c in the type of gfoldl,
-  -- and perform injections QL and projections unQL accordingly.
-  --
-  gmapL f x = unQL (gfoldl k (const (QL id)) x) []
+-}
+
+  -- | A generic query with a right-associative binary operator
+  gmapQr :: (r' -> r -> r) -> r -> (forall a. Data a => a -> r') -> a -> r
+  gmapQr o r f x = unQr (gfoldl k (const (Qr id)) x) r

     where
     where

-      k (QL c) x = QL (\rs -> c (f x : rs))
+      k (Qr c) x = Qr (\r -> c (f x `o` r))
+
+  -- | A generic query that processes the immediate subterms and returns a list
+  gmapQ :: (forall a. Data a => a -> u) -> a -> [u]
+  gmapQ f = gmapQr (:) [] f

 
 
   -- | A generic monadic transformation that maps over the immediate subterms
 
 
   -- | A generic monadic transformation that maps over the immediate subterms

@@ -212,17 +229,22 @@ arguments. Technically, we also need to identify the type constructor
 
 
   -- | Transformation of at least one immediate subterm does not fail
 
 
   -- | Transformation of at least one immediate subterm does not fail

-  gmapF :: MonadPlus m => (forall a. Data a => a -> m a) -> a -> m a
+  gmapMp :: 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 = unFAIL (gfoldl k z x) >>= \(x',b) ->
-              if b then return x' else mzero
+{-
+
+The type constructor that we use here simply keeps track of the fact
+if we already succeeded for an immediate subterm; see Mp below. To
+this end, we couple the monadic computation with a Boolean.
+
+-}
+
+  gmapMp f x = unMp (gfoldl k z x) >>= \(x',b) ->
+                if b then return x' else mzero

     where
     where

-      z g = FAIL (return (g,False))
-      k (FAIL c) x
-        = FAIL ( c >>= \(h,b) -> 
+      z g = Mp (return (g,False))
+      k (Mp c) x
+        = Mp ( c >>= \(h,b) -> 

                  (f x >>= \x' -> return (h x',True))
                  `mplus` return (h x, b)
                )
                  (f x >>= \x' -> return (h x',True))
                  `mplus` return (h x, b)
                )

@@ -232,20 +254,16 @@ arguments. Technically, we also need to identify the type constructor
 newtype ID x = ID { unID :: x }
 
 
 newtype ID x = ID { unID :: x }
 
 

--- | The constant type constructor needed for the definition of gmapQ
+-- | The constant type constructor needed for the definition of gmapQl

 newtype CONST c a = CONST { unCONST :: c }
 
 
 newtype CONST c a = CONST { unCONST :: c }
 
 

--- | A phantom datatype constructor used in definition of gmapL;
---   the function-typed component is needed to mediate between
---   left-associative constructor application vs. right-associative lists.
--- 
-newtype QL r a = QL { unQL  :: [r] -> [r] }
+-- | The type constructor used in definition of gmapQr
+newtype Qr r a = Qr { unQr  :: r -> 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 FAIL m x = FAIL { unFAIL :: m (x, Bool) }
+-- | The type constructor used in definition of gmapMp
+newtype Mp m x = Mp { unMp :: m (x, Bool) }

 
 
 
 
 
 

@@ -375,6 +393,7 @@ conIndex _                    = undefined
 stringCon :: DataType -> String -> Maybe Constr
 stringCon (DataType cs) str = worker cs
   where
 stringCon :: DataType -> String -> Maybe Constr
 stringCon (DataType cs) str = worker cs
   where

+    worker []     = Nothing

     worker (c:cs) =
       case c of
         (DataConstr _ str' _) -> if str == str'
     worker (c:cs) =
       case c of
         (DataConstr _ str' _) -> if str == str'

@@ -490,8 +509,8 @@ instance Data a => Data [a] where
 --
   gmapT  f   []     = []
   gmapT  f   (x:xs) = (f x:f xs)
 --
   gmapT  f   []     = []
   gmapT  f   (x:xs) = (f x:f xs)

-  gmapL  f   []     = []
-  gmapL  f   (x:xs) = [f x,f xs]
+--  gmapL  f   []     = []
+--  gmapL  f   (x:xs) = [f x,f xs]

   gmapM  f   []     = return []
   gmapM  f   (x:xs) = f x >>= \x' -> f xs >>= \xs' -> return (x':xs')
 
   gmapM  f   []     = return []
   gmapM  f   (x:xs) = f x >>= \x' -> f xs >>= \xs' -> return (x':xs')
 

diff --git a/Data/Generics/Counts.hs b/Data/Generics/Counts.hs
index 0fc3f6f..bb2c5d6 100644 (file)
--- a/Data/Generics/Counts.hs
+++ b/Data/Generics/Counts.hs
@@ -40,7 +40,7 @@ import Data.Generics.Schemes
 
 -- | Count the number of immediate subterms of the given term
 glength :: GenericQ Int
 
 -- | Count the number of immediate subterms of the given term
 glength :: GenericQ Int

-glength = length . gmapL (const ())
+glength = length . gmapQ (const ())

 
 
 -- | Determine the number of all suitable nodes in a given term
 
 
 -- | Determine the number of all suitable nodes in a given term

diff --git a/Data/Generics/Schemes.hs b/Data/Generics/Schemes.hs
index fd10942..532a94e 100644 (file)
--- a/Data/Generics/Schemes.hs
+++ b/Data/Generics/Schemes.hs
@@ -79,18 +79,18 @@ somewhere :: MonadPlus m => GenericM m -> GenericM m
 -- at the root of the term. The transformation fails if "f" fails
 -- everywhere, say succeeds nowhere.
 -- 
 -- 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;
 
 
 -- | 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 
 -- 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
 
 
 -- | Get a list of all entities that meet a predicate

@@ -114,4 +114,4 @@ something = everything orElse
 --   3rd argument f updates the sythesised data according to the given term
 --
 synthesize :: s  -> (s -> s -> s) -> GenericQ (s -> s) -> GenericQ s
 --   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 (gmapL (synthesize z o f) x))
+synthesize z o f x = f x (foldr o z (gmapQ (synthesize z o f) x))

diff --git a/Data/Generics/Strings.hs b/Data/Generics/Strings.hs
index 1111e26..00bc030 100644 (file)
--- a/Data/Generics/Strings.hs
+++ b/Data/Generics/Strings.hs
@@ -40,7 +40,7 @@ gshow :: Data a => a -> String
 gshow = ( \t ->
                 "("
              ++ conString (toConstr t)
 gshow = ( \t ->
                 "("
              ++ conString (toConstr t)

-             ++ concat (gmapL ((++) " " . gshow) t)
+             ++ concat (gmapQ ((++) " " . gshow) t)

              ++ ")"
         ) `extQ` (show :: String -> String)
 
              ++ ")"
         ) `extQ` (show :: String -> String)
 

@@ -48,65 +48,95 @@ gshow = ( \t ->
 -- | The type constructor for gunfold a la ReadS from the Prelude;
 --   we don't use lists here for simplicity but only maybes.
 --
 -- | The type constructor for gunfold a la ReadS from the Prelude;
 --   we don't use lists here for simplicity but only maybes.
 --

-newtype GRead a = GRead (String -> Maybe (a, String))
+newtype GRead a = GRead (String -> Maybe (a, String)) deriving Typeable

 unGRead (GRead x) = x
 
 unGRead (GRead x) = x
 

-{-
+

 -- | Turn GRead into a monad.
 instance Monad GRead where
   return x = GRead (\s -> Just (x, s))
   (GRead f) >>= g = GRead (\s -> 
                              maybe Nothing 
                                    (\(a,s') -> unGRead (g a) s')
 -- | Turn GRead into a monad.
 instance Monad GRead where
   return x = GRead (\s -> Just (x, s))
   (GRead f) >>= g = GRead (\s -> 
                              maybe Nothing 
                                    (\(a,s') -> unGRead (g a) s')

-                                   f s
+                                   (f s)

                           )
                           )

--}
+
+instance MonadPlus GRead where
+ mzero = GRead (\_ -> Nothing)
+ mplus = undefined
+
+
+-- | Special parsing operators
+trafo f = GRead (\s -> Just ((), f s))
+query f = GRead (\s -> if f s then Just ((), s) else Nothing)
+

 
 -- | Generic read: an alternative to \"deriving Read\"
 
 -- | Generic read: an alternative to \"deriving Read\"

-gread :: GenericB Maybe
+gread :: Data a => String -> Maybe (a, String)

 
 {-
 
 This is a read operation which insists on prefix notation.  (The
 
 {-
 
 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.
+Haskell 98 read deals with infix operators subject to associativity
+and precedence as well.) We use gunfoldM to "parse" the input. To be
+precise, gunfoldM is used for all types except String. The
+type-specific case for String uses basic String read.

 
 -}
 
 
 -}
 

-gread = undefined

 
 

-{-
-gdefault `extB` scase
+gread = unGRead gread' 

 
  where
 
 
  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 = undefined
-
--}
-
+  gread' :: GenericB GRead
+  gread' = gdefault `extB` scase
+
+   where
+
+    -- a specific case for strings
+    scase = GRead ( \s -> case reads s of
+                            [x::(String,String)] -> Just x
+                            _ -> Nothing
+                  ) 
+
+    -- the generic default for gread
+    gdefault = 
+      do 
+       trafo $  dropWhile ((==) ' ')
+       query $  not . (==) ""
+       query $  (==) '(' . head
+       trafo $  tail
+       trafo $  dropWhile ((==) ' ')                
+       str   <- parseConstr
+        con   <- str2con str
+        x     <- gunfoldM con gread'
+       trafo $  dropWhile ((==) ' ')
+       query $  not . (==) ""
+       query $  (==) ')' . head
+       trafo $  tail
+        return x
+
+     where
+       -- Turn string into constructor driven by gdefault's type
+       str2con = maybe mzero return
+               .
+                (    stringCon         -- look up constructor at hand
+                    $ dataTypeOf       -- get handle on all constructurs
+                    $ undefinedType    -- turn type value into undefined
+                    $ paraType         -- get a handle on a in m a
+                    $ gdefault         -- use as type argument
+                 )

 {-
 {-

+  foo = 

     do s' <- return $ dropWhile ((==) ' ') s
        guard (not (s' == ""))
        guard (head s' == '(')
     do s' <- return $ dropWhile ((==) ' ') s
        guard (not (s' == ""))
        guard (head s' == '(')

-       (c,s'')  <- prefixConstr (dropWhile ((==) ' ') (tail s'))
+       (c,s'')  <- parseConstr (dropWhile ((==) ' ') (tail s'))

        u  <- return undefined 
        dt <- return $ dataTypeOf u
        case stringCon dt c of
        u  <- return undefined 
        dt <- return $ dataTypeOf u
        case stringCon dt c of

-        Nothing -> error "Generics: gread failed"
+        Nothing -> error "Data.Generics.String: gread failed"

         Just c' -> 
           gunfoldm c' gread
 
         Just c' -> 
           gunfoldm c' gread
 

@@ -119,39 +149,25 @@ gdefault `extB` scase
        guard (not (s''' == "")) 
        guard (head s''' == ')')
        return (a, tail s''')
        guard (not (s''' == "")) 
        guard (head s''' == ')')
        return (a, tail s''')

+-}

 
 

+  -- Get a Constr's string at the front of an input string
+  parseConstr :: GRead String

 
 

-  -- To force two types to be the same
-  constrainTypes :: a -> a -> ()
-  constrainTypes _ _ = ()
-
-  -- Argument f for unfolding
-  f :: Data a => GRead (a -> b) -> GRead 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 g
-  z g = GRead (\s -> return (g,s))
-
+  parseConstr = GRead ( \s -> case s of

 
 

-  -- Get Constr at front of string
-  prefixConstr :: String -> Maybe (Constr, String)
+    -- Infix operators are prefixed in parantheses
+    ('(':s) -> case break ((==) ')') s of
+                 (s'@(_:_),(')':s'')) -> Just ("(" ++ s' ++ ")", s'')
+                 _ -> Nothing

 
 

-  -- 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
+    ('[':']':s) -> Just ("[]",s)

 
 

-  -- Special treatment of multiple token constructors
-  prefixConstr ('[':']':s) = Just (Constr "[]",s)
+    -- Try lex for ordinary constructor and basic datatypes
+    s -> case lex s of
+           [(s'@(_:_),s'')] -> Just (s',s'')
+           _ -> Nothing

 
 

-  -- Try lex for ordinary constructor and basic datatypes
-  prefixConstr s
-    = case lex s of
-        [(s'@(_:_),s'')] -> Just (Constr s',s'')
-        _ -> Nothing
+    )

 
 

--}
\ No newline at end of file

diff --git a/Data/Generics/Twins.hs b/Data/Generics/Twins.hs
index 2ec582d..3376774 100644 (file)
--- a/Data/Generics/Twins.hs
+++ b/Data/Generics/Twins.hs
@@ -20,7 +20,7 @@ module Data.Generics.Twins (
 
        -- * Twin mapping combinators
        tmapT,
 
        -- * Twin mapping combinators
        tmapT,

-       tmapQ,
+       tmapQl,

        tmapM,
 
        -- * Prime examples of twin traversal
        tmapM,
 
        -- * Prime examples of twin traversal

@@ -79,7 +79,7 @@ tfoldl :: (forall a b. Data a => c (a -> b) -> c a -> c b)
 
 tfoldl k z t xs ys = case gfoldl k' z' ys of { TWIN _ c -> c }
  where
 
 tfoldl k z t xs ys = case gfoldl k' z' ys of { TWIN _ c -> c }
  where

-   l = gmapL (\x -> Generic' (t x)) xs
+   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' (TWIN (r:rs) c) y = TWIN rs (k c (unGeneric' r y))
    z' f                 = TWIN l (z f)
 

@@ -103,11 +103,11 @@ tmapT f x y = unID $ tfoldl k z f' x y
   z = ID
 
 
   z = ID
 
 

-tmapQ :: (r -> r -> r) 
-      -> r
-      -> GenericQ (GenericQ r)
-      -> GenericQ (GenericQ r)
-tmapQ o r f x y = unCONST $ tfoldl k z f' x y
+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)  
  where
   f' x y = CONST $ f x y
   k (CONST c) (CONST x) = CONST (c `o` x)  

@@ -127,7 +127,7 @@ tmapM f x y = tfoldl k z f x y
 newtype ID x = ID { unID :: x }
 
 
 newtype ID x = ID { unID :: x }
 
 

--- The constant type constructor needed for the definition of tmapQ
+-- The constant type constructor needed for the definition of tmapQl

 newtype CONST c a = CONST { unCONST :: c }
 
 
 newtype CONST c a = CONST { unCONST :: c }
 
 

@@ -160,7 +160,7 @@ 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)
  where
   geq' :: forall a b. (Data a, Data b) => a -> b -> Bool
   geq' x y = and [ (toConstr x == toConstr y)

-                 , tmapQ (\b1 b2 -> and [b1,b2]) True geq' x y
+                 , tmapQl (\b1 b2 -> and [b1,b2]) True geq' x y

                  ]
 
 
                  ]
 
 

diff --git a/Data/Generics/Types.hs b/Data/Generics/Types.hs
index d97d49d..caa0fc8 100644 (file)
--- a/Data/Generics/Types.hs
+++ b/Data/Generics/Types.hs
@@ -70,6 +70,6 @@ typeReachableFrom (a::TypeVal a) (b::TypeVal b) =
     -- See if a is reachable from immediate subterms of a kind of b 
     recurse :: b -> Bool
     recurse = or
     -- See if a is reachable from immediate subterms of a kind of b 
     recurse :: b -> Bool
     recurse = or

-            . gmapL ( typeReachableFrom a 
+            . gmapQ ( typeReachableFrom a 

                     . typeValOf
                     )
                     . typeValOf
                     )

diff --git a/Data/Typeable.hs b/Data/Typeable.hs
index c224fdd..c88920c 100644 (file)
--- a/Data/Typeable.hs
+++ b/Data/Typeable.hs
@@ -48,6 +48,7 @@ module Data.Typeable
        withType,               -- :: a -> TypeVal a -> a
        argType,                -- :: (a -> b) -> TypeVal a
        resType,                -- :: (a -> b) -> TypeVal b
        withType,               -- :: a -> TypeVal a -> a
        argType,                -- :: (a -> b) -> TypeVal a
        resType,                -- :: (a -> b) -> TypeVal b

+       paraType,               -- :: t a -> TypeVal a

        TypeFun                 -- functions on types
 
   ) where
        TypeFun                 -- functions on types
 
   ) where

@@ -376,6 +377,11 @@ resType :: (a -> b) -> TypeVal b
 resType _ = typeVal
 
 
 resType _ = typeVal
 
 

+-- | The parameter type of type constructor
+paraType :: t a -> TypeVal a
+paraType _ = typeVal
+
+

 -- Type functions,
 -- i.e., functions mapping types to values
 --
 -- Type functions,
 -- i.e., functions mapping types to values
 --