From 5b272091fa9c22196f0c887d34f6a94d590a1398 Mon Sep 17 00:00:00 2001
From: ralf <unknown>
Date: Tue, 16 Mar 2004 13:46:08 +0000
Subject: [PATCH] [project @ 2004-03-16 13:46:07 by ralf] Some more
 refactoring and renaming to be aligned with the boilerplate
 II paper. Removed the weird module Generics.Reify, the code
 of which still lives in testsuite (see example reify.hs).
 One will also need to cvs upd the compiler which again
 changed slightly with regard to deriving Data.

---
 Data/Generics.hs           |    4 +-
 Data/Generics/Aliases.hs   |   14 ++--
 Data/Generics/Basics.hs    |  195 +++++++++++++++++++++++---------------------
 Data/Generics/Instances.hs |  158 +++++++++++++++++------------------
 Data/Generics/Schemes.hs   |   49 +++++++++++
 Data/Generics/Text.hs      |    4 +-
 Data/Generics/Twins.hs     |    2 +-
 Data/Typeable.hs           |   34 ++++----
 8 files changed, 257 insertions(+), 203 deletions(-)

diff --git a/Data/Generics.hs b/Data/Generics.hs
index 14c7f49..525efdc 100644
--- a/Data/Generics.hs
+++ b/Data/Generics.hs
@@ -1,7 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Generics
--- 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
@@ -24,7 +24,6 @@ module Data.Generics (
   module Data.Generics.Schemes,	  -- traversal schemes (everywhere etc.)
   module Data.Generics.Text,	  -- generic read and show
   module Data.Generics.Twins,  	  -- twin traversal, e.g., generic eq
-  module Data.Generics.Reify,	  -- experimental reification theme
 
 #ifndef __HADDOCK__
 	,
@@ -53,4 +52,3 @@ import Data.Generics.Aliases
 import Data.Generics.Schemes
 import Data.Generics.Text
 import Data.Generics.Twins
-import Data.Generics.Reify
diff --git a/Data/Generics/Aliases.hs b/Data/Generics/Aliases.hs
index 3c66298..ac5c039 100644
--- a/Data/Generics/Aliases.hs
+++ b/Data/Generics/Aliases.hs
@@ -19,7 +19,7 @@ module Data.Generics.Aliases (
 
 	-- * Combinators to \"make\" generic functions via cast
 	mkT, mkQ, mkM, mkMp, mkR,
-	extT, extQ, extM, extMp, extB, extR,
+	ext0, extT, extQ, extM, extMp, extB, extR,
 
 	-- * Type synonyms for generic function types
 	GenericT, 
@@ -77,9 +77,7 @@ mkT :: ( Typeable a
     => (b -> b)
     -> a 
     -> a
-mkT f = case cast f of
-               Just g -> g
-               Nothing -> id
+mkT = extT id
 
 
 -- | Make a generic query;
@@ -148,18 +146,18 @@ 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)
+ext0 def ext = maybe def id (gcast ext)
 
 
 -- | Extend a generic transformation by a type-specific case
 extT :: ( Typeable a
-        , Typeable b 
+        , Typeable b
         )
      => (a -> a)
      -> (b -> b)
      -> a
      -> a
-extT f = maybe f id . cast
+extT def ext = unT ((T def) `ext0` (T ext))
 
 
 -- | Extend a generic query by a type-specific case
@@ -342,7 +340,7 @@ ext1 :: (Data a, Typeable1 t)
      => c a
      -> (forall a. Data a => c (t a))
      -> c a
-ext1 def ext = maybe def id (cast0to1 ext)
+ext1 def ext = maybe def id (dataCast1 ext)
 
 
 -- | Type extension of transformations for unary type constructors
diff --git a/Data/Generics/Basics.hs b/Data/Generics/Basics.hs
index c552ddc..d8717a8 100644
--- a/Data/Generics/Basics.hs
+++ b/Data/Generics/Basics.hs
@@ -16,7 +16,7 @@
 
 module Data.Generics.Basics ( 
 
-	-- Module Data.Typeable re-exported for convenience
+	-- * Module Data.Typeable re-exported for convenience
 	module Data.Typeable,
 
 	-- * The Data class for processing constructor applications
@@ -25,48 +25,49 @@ module Data.Generics.Basics (
 		toConstr, 	-- :: a -> Constr
 		fromConstr,	-- :: Constr -> a
 		dataTypeOf,	-- :: a -> DataType
-		cast0to1,	-- mediate types and unary type constructors
-		cast0to2	-- mediate types and binary type constructors
+		dataCast1,	-- mediate types and unary type constructors
+		dataCast2	-- mediate types and binary type constructors
             ),
 
 	-- * Datatype representations
 	DataType,	-- abstract, instance of: Show
 	Constr,		-- abstract, instance of: Eq, Show
 	DataRep(..),	-- instance of: Eq, Show
-	ConRep(..),	-- instance of: Eq, Show
+	ConstrRep(..),	-- instance of: Eq, Show
 	ConIndex,	-- alias for Int, start at 1
 	Fixity(..),	-- instance of: Eq, Show
 
 	-- * Observers for datatype representations
-	dataTypeCon,	-- :: DataType -> String
+	dataTypeName,	-- :: DataType -> String
 	dataTypeRep,	-- :: DataType -> DataRep
- 	conDataType,	-- :: Constr -> DataType
- 	conRep,		-- :: Constr -> ConRep
- 	repCon,		-- :: DataType -> ConRep -> Constr
+ 	constrType,	-- :: Constr   -> DataType
+ 	constrRep,	-- :: Constr   -> ConstrRep
+ 	repConstr,		-- :: DataType -> ConstrRep -> Constr
 
 	-- * Representations of algebraic data types
-	mkDataType,	-- :: String -> [Constr] -> DataType
- 	mkDataCon,	-- :: DataType -> String -> Fixity -> Constr
-	algTypeCons,	-- :: DataType -> [Constr]
- 	conFixity,	-- :: Constr -> Fixity
+	mkDataType,	-- :: String   -> [Constr] -> DataType
+ 	mkConstr,	-- :: DataType -> String -> Fixity -> Constr
+	dataTypeConstrs,-- :: DataType -> [Constr]
+ 	constrFields,	-- :: Constr   -> [String]
+ 	constrFixity,	-- :: Constr   -> Fixity
 
 	-- * From strings to constr's and vice versa: all data types
-	conString, 	-- :: Constr -> String
-	stringCon,	-- :: DataType -> String -> Maybe Constr
+	showConstr, 	-- :: Constr   -> String
+	readConstr,	-- :: DataType -> String -> Maybe Constr
 
 	-- * Convenience funtions: algebraic data types
 	isAlgType,	-- :: DataType -> Bool
-	indexCon,	-- :: DataType -> ConIndex -> Constr
-	conIndex,	-- :: Constr -> ConIndex
-	maxConIndex,	-- :: DataType -> ConIndex
+	indexConstr,	-- :: DataType -> ConIndex -> Constr
+	constrIndex,	-- :: Constr   -> ConIndex
+	maxConstrIndex,	-- :: DataType -> ConIndex
 
 	-- * Representation of primitive types
 	mkIntType,	-- :: String -> DataType
 	mkFloatType,	-- :: String -> DataType
 	mkStringType,	-- :: String -> DataType
-	mkIntCon,	-- :: DataType -> Integer -> Constr
-	mkFloatCon,	-- :: DataType -> Double  -> Constr
-	mkStringCon,	-- :: DataType -> String  -> Constr
+	mkIntConstr,	-- :: DataType -> Integer -> Constr
+	mkFloatConstr,	-- :: DataType -> Double  -> Constr
+	mkStringConstr,	-- :: DataType -> String  -> Constr
 
 	-- * Non-representations for non-presentable types
 	mkNorepType,	-- :: String -> DataType
@@ -179,16 +180,16 @@ fold.
 ------------------------------------------------------------------------------
 
   -- | Mediate types and unary type constructors
-  cast0to1 :: Typeable1 t
-           => (forall a. Data a => c (t a))
-           -> Maybe (c a)
-  cast0to1 _ = Nothing
+  dataCast1 :: Typeable1 t
+            => (forall a. Data a => c (t a))
+            -> Maybe (c a)
+  dataCast1 _ = Nothing
 
   -- | Mediate types and binary type constructors
-  cast0to2 :: Typeable2 t
-           => (forall a b. (Data a, Data b) => c (t a b))
-           -> Maybe (c a)
-  cast0to2 _ = Nothing
+  dataCast2 :: Typeable2 t
+            => (forall a b. (Data a, Data b) => c (t a b))
+            -> Maybe (c a)
+  dataCast2 _ = Nothing
 
 
 
@@ -379,8 +380,9 @@ data DataType = DataType
 
 -- | Representation of constructors
 data Constr = Constr
-			{ conrep    :: ConRep
+			{ conrep    :: ConstrRep
 			, constring :: String
+			, confields :: [String]	-- for AlgRep only
 			, confixity :: Fixity	-- for AlgRep only
 			, datatype  :: DataType
 			}
@@ -391,7 +393,7 @@ instance Show Constr where
 
 -- | Equality of constructors
 instance Eq Constr where
-  c == c' = conRep c == conRep c'
+  c == c' = constrRep c == constrRep c'
 
 
 -- | Public representation of datatypes
@@ -405,12 +407,12 @@ data DataRep = AlgRep [Constr]
 
 
 -- | Public representation of constructors
-data ConRep = AlgCon ConIndex
-            | IntCon Integer
-    	    | FloatCon Double
-    	    | StringCon String
+data ConstrRep = AlgConstr    ConIndex
+               | IntConstr    Integer
+    	       | FloatConstr  Double
+    	       | StringConstr String
 
-	    deriving (Eq,Show)
+	       deriving (Eq,Show)
 
 
 --
@@ -435,8 +437,8 @@ data Fixity = Prefix
 
 
 -- | Gets the type constructor including the module
-dataTypeCon :: DataType -> String
-dataTypeCon = tycon
+dataTypeName :: DataType -> String
+dataTypeName = tycon
 
 
 
@@ -446,24 +448,24 @@ dataTypeRep = datarep
 
 
 -- | Gets the datatype of a constructor
-conDataType :: Constr -> DataType
-conDataType = datatype
+constrType :: Constr -> DataType
+constrType = datatype
 
 
 -- | Gets the public presentation of constructors
-conRep :: Constr -> ConRep
-conRep = conrep
+constrRep :: Constr -> ConstrRep
+constrRep = conrep
 
 
 -- | Look up a constructor by its representation
-repCon :: DataType -> ConRep -> Constr
-repCon dt cr =
+repConstr :: DataType -> ConstrRep -> Constr
+repConstr dt cr =
       case (dataTypeRep dt, cr) of
-	(AlgRep cs, AlgCon i)      -> cs !! (i-1)
-	(IntRep,    IntCon i)      -> mkIntCon dt i
-	(FloatRep,  FloatCon f)    -> mkFloatCon dt f
-	(StringRep, StringCon str) -> mkStringCon dt str
-	_ -> error "repCon"
+	(AlgRep cs, AlgConstr i)      -> cs !! (i-1)
+	(IntRep,    IntConstr i)      -> mkIntConstr dt i
+	(FloatRep,  FloatConstr f)    -> mkFloatConstr dt f
+	(StringRep, StringConstr str) -> mkStringConstr dt str
+	_ -> error "repConstr"
 
 
 
@@ -483,29 +485,35 @@ mkDataType str cs = DataType
 
 
 -- | Constructs a constructor
-mkDataCon :: DataType -> String -> Fixity -> Constr
-mkDataCon dt str fix =
+mkConstr :: DataType -> String -> [String] -> Fixity -> Constr
+mkConstr dt str fields fix =
 	Constr
-		{ conrep    = AlgCon idx
+		{ conrep    = AlgConstr idx
 		, constring = str
+		, confields = fields
 		, confixity = fix
 		, datatype  = dt 
 		}
   where
-    idx = head [ i | (c,i) <- algTypeCons dt `zip` [1..],
-                     conString c == str ]
+    idx = head [ i | (c,i) <- dataTypeConstrs dt `zip` [1..],
+                     showConstr c == str ]
 
 
 -- | Gets the constructors
-algTypeCons :: DataType -> [Constr]
-algTypeCons dt = case datarep dt of 
-		   (AlgRep cons) -> cons
-		   _ -> error "algTypeCons"
+dataTypeConstrs :: DataType -> [Constr]
+dataTypeConstrs dt = case datarep dt of 
+			(AlgRep cons) -> cons
+			_ -> error "dataTypeConstrs"
+
+
+-- | Gets the field labels of a constructor
+constrFields :: Constr -> [String]
+constrFields = confields
 
 
 -- | Gets the fixity of a constructor
-conFixity :: Constr -> Fixity
-conFixity = confixity
+constrFixity :: Constr -> Fixity
+constrFixity = confixity
 
 
 
@@ -517,18 +525,18 @@ conFixity = confixity
 
 
 -- | Gets the string for a constructor
-conString :: Constr -> String
-conString = constring
+showConstr :: Constr -> String
+showConstr = constring
 
 
 -- | Lookup a constructor via a string
-stringCon :: DataType -> String -> Maybe Constr
-stringCon dt str =
+readConstr :: DataType -> String -> Maybe Constr
+readConstr dt str =
       case dataTypeRep dt of
 	AlgRep cons -> idx cons
-	IntRep      -> mkReadCon (\i -> (mkPrimCon dt str (IntCon i)))
-	FloatRep    -> mkReadCon (\f -> (mkPrimCon dt str (FloatCon f)))
-	StringRep   -> Just (mkStringCon dt str)
+	IntRep      -> mkReadCon (\i -> (mkPrimCon dt str (IntConstr i)))
+	FloatRep    -> mkReadCon (\f -> (mkPrimCon dt str (FloatConstr f)))
+	StringRep   -> Just (mkStringConstr dt str)
         NoRep       -> Nothing
   where
 
@@ -540,7 +548,7 @@ stringCon dt str =
 
     -- Traverse list of algebraic datatype constructors
     idx :: [Constr] -> Maybe Constr
-    idx cons = let fit = filter ((==) str . conString) cons 
+    idx cons = let fit = filter ((==) str . showConstr) cons 
                 in if fit == []
                      then Nothing
                      else Just (head fit)
@@ -561,24 +569,24 @@ isAlgType dt = case datarep dt of
 
 
 -- | Gets the constructor for an index
-indexCon :: DataType -> ConIndex -> Constr
-indexCon dt idx = case datarep dt of
-                    (AlgRep cs) -> cs !! (idx-1)
-                    _           -> error "indexCon"
+indexConstr :: DataType -> ConIndex -> Constr
+indexConstr dt idx = case datarep dt of
+			(AlgRep cs) -> cs !! (idx-1)
+			_           -> error "indexConstr"
 
 
 -- | Gets the index of a constructor
-conIndex :: Constr -> ConIndex
-conIndex con = case conRep con of
-                 (AlgCon idx) -> idx
-		 _ -> error "conIndex"
+constrIndex :: Constr -> ConIndex
+constrIndex con = case constrRep con of
+                    (AlgConstr idx) -> idx
+ 		    _ -> error "constrIndex"
 
 
 -- | Gets the maximum constructor index
-maxConIndex :: DataType -> ConIndex
-maxConIndex dt = case dataTypeRep dt of
-		   AlgRep cs -> length cs
-		   _ 	     -> error "maxConIndex"
+maxConstrIndex :: DataType -> ConIndex
+maxConstrIndex dt = case dataTypeRep dt of
+			AlgRep cs -> length cs
+			_ 	     -> error "maxConstrIndex"
 
 
 
@@ -613,31 +621,32 @@ mkPrimType dr str = DataType
 
 
 -- Makes a constructor for primitive types
-mkPrimCon :: DataType -> String -> ConRep -> Constr
+mkPrimCon :: DataType -> String -> ConstrRep -> Constr
 mkPrimCon dt str cr = Constr 
 			{ datatype  = dt
 			, conrep    = cr
 			, constring = str
-			, confixity = error "conFixity"
+			, confields = error "constrFields"
+			, confixity = error "constrFixity"
 			}
 
 
-mkIntCon :: DataType -> Integer -> Constr
-mkIntCon dt i = case datarep dt of
-		  IntRep -> mkPrimCon dt (show i) (IntCon i)
-		  _ -> error "mkIntCon"
+mkIntConstr :: DataType -> Integer -> Constr
+mkIntConstr dt i = case datarep dt of
+		  IntRep -> mkPrimCon dt (show i) (IntConstr i)
+		  _ -> error "mkIntConstr"
 
 
-mkFloatCon :: DataType -> Double -> Constr
-mkFloatCon dt f = case datarep dt of
-		    FloatRep -> mkPrimCon dt (show f) (FloatCon f)
-		    _ -> error "mkFloatCon"
+mkFloatConstr :: DataType -> Double -> Constr
+mkFloatConstr dt f = case datarep dt of
+		    FloatRep -> mkPrimCon dt (show f) (FloatConstr f)
+		    _ -> error "mkFloatConstr"
 
 
-mkStringCon :: DataType -> String -> Constr
-mkStringCon dt str = case datarep dt of
-		       StringRep -> mkPrimCon dt str (StringCon str)
-		       _ -> error "mkStringCon"
+mkStringConstr :: DataType -> String -> Constr
+mkStringConstr dt str = case datarep dt of
+		       StringRep -> mkPrimCon dt str (StringConstr str)
+		       _ -> error "mkStringConstr"
 
 
 ------------------------------------------------------------------------------
diff --git a/Data/Generics/Instances.hs b/Data/Generics/Instances.hs
index e36b17d..97f3277 100644
--- a/Data/Generics/Instances.hs
+++ b/Data/Generics/Instances.hs
@@ -46,14 +46,14 @@ import GHC.Stable	     -- So we can give Data instance for StablePtr
 ------------------------------------------------------------------------------
 
 
-falseConstr  = mkDataCon boolDataType "False" Prefix
-trueConstr   = mkDataCon boolDataType "True"  Prefix
+falseConstr  = mkConstr boolDataType "False" [] Prefix
+trueConstr   = mkConstr boolDataType "True"  [] Prefix
 boolDataType = mkDataType "Prelude.Bool" [falseConstr,trueConstr]
 
 instance Data Bool where
   toConstr False = falseConstr
   toConstr True  = trueConstr
-  fromConstr c = case conIndex c of
+  fromConstr c = case constrIndex c of
                    1 -> False
                    2 -> True
                    _ -> error "fromConstr"
@@ -66,9 +66,9 @@ instance Data Bool where
 charType = mkStringType "Prelude.Char"
 
 instance Data Char where
-  toConstr x = mkStringCon charType [x]
-  fromConstr con = case conRep con of
-                     (StringCon [x]) -> x
+  toConstr x = mkStringConstr charType [x]
+  fromConstr con = case constrRep con of
+                     (StringConstr [x]) -> x
                      _ -> error "fromConstr"
   dataTypeOf _ = charType
 
@@ -79,9 +79,9 @@ instance Data Char where
 floatType = mkFloatType "Prelude.Float"
 
 instance Data Float where
-  toConstr x = mkFloatCon floatType (realToFrac x)
-  fromConstr con = case conRep con of
-                     (FloatCon x) -> realToFrac x
+  toConstr x = mkFloatConstr floatType (realToFrac x)
+  fromConstr con = case constrRep con of
+                     (FloatConstr x) -> realToFrac x
                      _ -> error "fromConstr"
   dataTypeOf _ = floatType
 
@@ -92,9 +92,9 @@ instance Data Float where
 doubleType = mkFloatType "Prelude.Double"
 
 instance Data Double where
-  toConstr = mkFloatCon floatType
-  fromConstr con = case conRep con of
-                     (FloatCon x) -> x
+  toConstr = mkFloatConstr floatType
+  fromConstr con = case constrRep con of
+                     (FloatConstr x) -> x
                      _ -> error "fromConstr"
   dataTypeOf _ = doubleType
 
@@ -105,9 +105,9 @@ instance Data Double where
 intType = mkIntType "Prelude.Int"
 
 instance Data Int where
-  toConstr x = mkIntCon intType (fromIntegral x)
-  fromConstr con = case conRep con of
-                     (IntCon x) -> fromIntegral x
+  toConstr x = mkIntConstr intType (fromIntegral x)
+  fromConstr con = case constrRep con of
+                     (IntConstr x) -> fromIntegral x
                      _ -> error "fromConstr"
   dataTypeOf _ = intType
 
@@ -118,9 +118,9 @@ instance Data Int where
 integerType = mkIntType "Prelude.Integer"
 
 instance Data Integer where
-  toConstr = mkIntCon integerType
-  fromConstr con = case conRep con of
-                     (IntCon x) -> x
+  toConstr = mkIntConstr integerType
+  fromConstr con = case constrRep con of
+                     (IntConstr x) -> x
                      _ -> error "fromConstr"
   dataTypeOf _ = integerType
 
@@ -131,9 +131,9 @@ instance Data Integer where
 int8Type = mkIntType "Data.Int.Int8"
 
 instance Data Int8 where
-  toConstr x = mkIntCon int8Type (fromIntegral x)
-  fromConstr con = case conRep con of
-                     (IntCon x) -> fromIntegral x
+  toConstr x = mkIntConstr int8Type (fromIntegral x)
+  fromConstr con = case constrRep con of
+                     (IntConstr x) -> fromIntegral x
                      _ -> error "fromConstr"
   dataTypeOf _ = int8Type
 
@@ -144,9 +144,9 @@ instance Data Int8 where
 int16Type = mkIntType "Data.Int.Int16"
 
 instance Data Int16 where
-  toConstr x = mkIntCon int16Type (fromIntegral x)
-  fromConstr con = case conRep con of
-                     (IntCon x) -> fromIntegral x
+  toConstr x = mkIntConstr int16Type (fromIntegral x)
+  fromConstr con = case constrRep con of
+                     (IntConstr x) -> fromIntegral x
                      _ -> error "fromConstr"
   dataTypeOf _ = int16Type
 
@@ -157,9 +157,9 @@ instance Data Int16 where
 int32Type = mkIntType "Data.Int.Int32"
 
 instance Data Int32 where
-  toConstr x = mkIntCon int32Type (fromIntegral x)
-  fromConstr con = case conRep con of
-                     (IntCon x) -> fromIntegral x
+  toConstr x = mkIntConstr int32Type (fromIntegral x)
+  fromConstr con = case constrRep con of
+                     (IntConstr x) -> fromIntegral x
                      _ -> error "fromConstr"
   dataTypeOf _ = int32Type
 
@@ -170,9 +170,9 @@ instance Data Int32 where
 int64Type = mkIntType "Data.Int.Int64"
 
 instance Data Int64 where
-  toConstr x = mkIntCon int64Type (fromIntegral x)
-  fromConstr con = case conRep con of
-                     (IntCon x) -> fromIntegral x
+  toConstr x = mkIntConstr int64Type (fromIntegral x)
+  fromConstr con = case constrRep con of
+                     (IntConstr x) -> fromIntegral x
                      _ -> error "fromConstr"
   dataTypeOf _ = int64Type
 
@@ -183,9 +183,9 @@ instance Data Int64 where
 wordType = mkIntType "Data.Word.Word"
 
 instance Data Word where
-  toConstr x = mkIntCon wordType (fromIntegral x)
-  fromConstr con = case conRep con of
-                     (IntCon x) -> fromIntegral x
+  toConstr x = mkIntConstr wordType (fromIntegral x)
+  fromConstr con = case constrRep con of
+                     (IntConstr x) -> fromIntegral x
                      _ -> error "fromConstr"
   dataTypeOf _ = wordType
 
@@ -196,9 +196,9 @@ instance Data Word where
 word8Type = mkIntType "Data.Word.Word8"
 
 instance Data Word8 where
-  toConstr x = mkIntCon word8Type (fromIntegral x)
-  fromConstr con = case conRep con of
-                     (IntCon x) -> fromIntegral x
+  toConstr x = mkIntConstr word8Type (fromIntegral x)
+  fromConstr con = case constrRep con of
+                     (IntConstr x) -> fromIntegral x
                      _ -> error "fromConstr"
   dataTypeOf _ = word8Type
 
@@ -209,9 +209,9 @@ instance Data Word8 where
 word16Type = mkIntType "Data.Word.Word16"
 
 instance Data Word16 where
-  toConstr x = mkIntCon word16Type (fromIntegral x)
-  fromConstr con = case conRep con of
-                     (IntCon x) -> fromIntegral x
+  toConstr x = mkIntConstr word16Type (fromIntegral x)
+  fromConstr con = case constrRep con of
+                     (IntConstr x) -> fromIntegral x
                      _ -> error "fromConstr"
   dataTypeOf _ = word16Type
 
@@ -222,9 +222,9 @@ instance Data Word16 where
 word32Type = mkIntType "Data.Word.Word32"
 
 instance Data Word32 where
-  toConstr x = mkIntCon word32Type (fromIntegral x)
-  fromConstr con = case conRep con of
-                     (IntCon x) -> fromIntegral x
+  toConstr x = mkIntConstr word32Type (fromIntegral x)
+  fromConstr con = case constrRep con of
+                     (IntConstr x) -> fromIntegral x
                      _ -> error "fromConstr"
   dataTypeOf _ = word32Type
 
@@ -235,9 +235,9 @@ instance Data Word32 where
 word64Type = mkIntType "Data.Word.Word64"
 
 instance Data Word64 where
-  toConstr x = mkIntCon word64Type (fromIntegral x)
-  fromConstr con = case conRep con of
-                     (IntCon x) -> fromIntegral x
+  toConstr x = mkIntConstr word64Type (fromIntegral x)
+  fromConstr con = case constrRep con of
+                     (IntConstr x) -> fromIntegral x
                      _ -> error "fromConstr"
   dataTypeOf _ = word64Type
 
@@ -245,12 +245,12 @@ instance Data Word64 where
 ------------------------------------------------------------------------------
 
 
-ratioConstr = mkDataCon ratioDataType ":%" Infix
+ratioConstr = mkConstr ratioDataType ":%" [] Infix
 ratioDataType = mkDataType "GHC.Real.Ratio" [ratioConstr]
 
 instance (Data a, Integral a) => Data (Ratio a) where
   toConstr _ = ratioConstr
-  fromConstr c | conIndex c == 1 = undefined :% undefined
+  fromConstr c | constrIndex c == 1 = undefined :% undefined
   fromConstr _ = error "fromConstr"
   dataTypeOf _ = ratioDataType
 
@@ -258,8 +258,8 @@ instance (Data a, Integral a) => Data (Ratio a) where
 ------------------------------------------------------------------------------
 
 
-nilConstr    = mkDataCon listDataType "[]"  Prefix
-consConstr   = mkDataCon listDataType "(:)" Infix
+nilConstr    = mkConstr listDataType "[]"  [] Prefix
+consConstr   = mkConstr listDataType "(:)" [] Infix
 listDataType = mkDataType "Prelude.[]" [nilConstr,consConstr]
 
 instance Data a => Data [a] where
@@ -267,12 +267,12 @@ instance Data a => Data [a] where
   gfoldl f z (x:xs) = z (:) `f` x `f` xs
   toConstr []    = nilConstr
   toConstr (_:_) = consConstr
-  fromConstr c = case conIndex c of
+  fromConstr c = case constrIndex c of
                    1 -> []
                    2 -> undefined:undefined
                    _ -> error "fromConstr"
   dataTypeOf _ = listDataType
-  cast0to1   = cast1
+  dataCast1    = gcast1
 
 --
 -- The gmaps are given as an illustration.
@@ -289,8 +289,8 @@ instance Data a => Data [a] where
 ------------------------------------------------------------------------------
 
 
-nothingConstr = mkDataCon maybeDataType "Nothing" Prefix
-justConstr    = mkDataCon maybeDataType "Just"    Prefix
+nothingConstr = mkConstr maybeDataType "Nothing" [] Prefix
+justConstr    = mkConstr maybeDataType "Just"    [] Prefix
 maybeDataType = mkDataType "Prelude.Maybe" [nothingConstr,justConstr]
 
 instance Data a => Data (Maybe a) where
@@ -298,20 +298,20 @@ instance Data a => Data (Maybe a) where
   gfoldl f z (Just x) = z Just `f` x
   toConstr Nothing  = nothingConstr
   toConstr (Just _) = justConstr
-  fromConstr c = case conIndex c of
+  fromConstr c = case constrIndex c of
                    1 -> Nothing
                    2 -> Just undefined
                    _ -> error "fromConstr"
   dataTypeOf _ = maybeDataType
-  cast0to1   = cast1
+  dataCast1    = gcast1
 
 
 ------------------------------------------------------------------------------
 
 
-ltConstr         = mkDataCon orderingDataType "LT" Prefix
-eqConstr         = mkDataCon orderingDataType "EQ" Prefix
-gtConstr         = mkDataCon orderingDataType "GT" Prefix
+ltConstr         = mkConstr orderingDataType "LT" [] Prefix
+eqConstr         = mkConstr orderingDataType "EQ" [] Prefix
+gtConstr         = mkConstr orderingDataType "GT" [] Prefix
 orderingDataType = mkDataType "Prelude.Ordering" [ltConstr,eqConstr,gtConstr]
 
 instance Data Ordering where
@@ -321,7 +321,7 @@ instance Data Ordering where
   toConstr LT  = ltConstr
   toConstr EQ  = eqConstr
   toConstr GT  = gtConstr
-  fromConstr c = case conIndex c of
+  fromConstr c = case constrIndex c of
                    1 -> LT
                    2 -> EQ
                    3 -> GT
@@ -332,8 +332,8 @@ instance Data Ordering where
 ------------------------------------------------------------------------------
 
 
-leftConstr     = mkDataCon eitherDataType "Left"  Prefix
-rightConstr    = mkDataCon eitherDataType "Right" Prefix
+leftConstr     = mkConstr eitherDataType "Left"  [] Prefix
+rightConstr    = mkConstr eitherDataType "Right" [] Prefix
 eitherDataType = mkDataType "Prelude.Either" [leftConstr,rightConstr]
 
 instance (Data a, Data b) => Data (Either a b) where
@@ -341,12 +341,12 @@ instance (Data a, Data b) => Data (Either a b) where
   gfoldl f z (Right a)  = z Right `f` a
   toConstr (Left _)  = leftConstr
   toConstr (Right _) = rightConstr
-  fromConstr c = case conIndex c of
+  fromConstr c = case constrIndex c of
                    1 -> Left undefined
                    2 -> Right undefined
                    _ -> error "fromConstr"
   dataTypeOf _ = eitherDataType
-  cast0to2   = cast2
+  dataCast2    = gcast2
 
 
 ------------------------------------------------------------------------------
@@ -360,18 +360,18 @@ instance (Data a, Data b) => Data (a -> b) where
   toConstr _   = error "toConstr"
   fromConstr _ = error "fromConstr"
   dataTypeOf _ = mkNorepType "Prelude.(->)"
-  cast0to2     = cast2
+  dataCast2    = gcast2
 
 
 ------------------------------------------------------------------------------
 
 
-tuple0Constr = mkDataCon tuple0DataType "()" Prefix
+tuple0Constr = mkConstr tuple0DataType "()" [] Prefix
 tuple0DataType = mkDataType "Prelude.()" [tuple0Constr]
 
 instance Data () where
   toConstr _ = tuple0Constr
-  fromConstr c | conIndex c == 1 = ()  
+  fromConstr c | constrIndex c == 1 = ()  
   fromConstr _ = error "fromConstr"
   dataTypeOf _ = tuple0DataType
 
@@ -379,28 +379,28 @@ instance Data () where
 ------------------------------------------------------------------------------
 
 
-tuple2Constr = mkDataCon tuple2DataType "(,)" Infix
+tuple2Constr = mkConstr tuple2DataType "(,)" [] Infix
 tuple2DataType = mkDataType "Prelude.(,)" [tuple2Constr]
 
 instance (Data a, Data b) => Data (a,b) where
   gfoldl f z (a,b) = z (,) `f` a `f` b
   toConstr _ = tuple2Constr
-  fromConstr c | conIndex c == 1 = (undefined,undefined)
+  fromConstr c | constrIndex c == 1 = (undefined,undefined)
   fromConstr _ = error "fromConstr"
   dataTypeOf _ = tuple2DataType
-  cast0to2   = cast2
+  dataCast2    = gcast2
 
 
 ------------------------------------------------------------------------------
 
 
-tuple3Constr = mkDataCon tuple3DataType "(,,)" Infix
+tuple3Constr = mkConstr tuple3DataType "(,,)" [] Infix
 tuple3DataType = mkDataType "Prelude.(,)" [tuple3Constr]
 
 instance (Data a, Data b, Data c) => Data (a,b,c) where
   gfoldl f z (a,b,c) = z (,,) `f` a `f` b `f` c
   toConstr _ = tuple3Constr
-  fromConstr c | conIndex c == 1 = (undefined,undefined,undefined)
+  fromConstr c | constrIndex c == 1 = (undefined,undefined,undefined)
   fromConstr _ = error "fromConstr"
   dataTypeOf _ = tuple3DataType
 
@@ -408,14 +408,14 @@ instance (Data a, Data b, Data c) => Data (a,b,c) where
 ------------------------------------------------------------------------------
 
 
-tuple4Constr = mkDataCon tuple4DataType "(,,,)" Infix
+tuple4Constr = mkConstr tuple4DataType "(,,,)" [] Infix
 tuple4DataType = mkDataType "Prelude.(,,,)" [tuple4Constr]
 
 instance (Data a, Data b, Data c, Data d)
          => Data (a,b,c,d) where
   gfoldl f z (a,b,c,d) = z (,,,) `f` a `f` b `f` c `f` d
   toConstr _ = tuple4Constr
-  fromConstr c = case conIndex c of
+  fromConstr c = case constrIndex c of
                    1 -> (undefined,undefined,undefined,undefined)
                    _ -> error "fromConstr"
   dataTypeOf _ = tuple4DataType
@@ -424,14 +424,14 @@ instance (Data a, Data b, Data c, Data d)
 ------------------------------------------------------------------------------
 
 
-tuple5Constr = mkDataCon tuple5DataType "(,,,,)" Infix
+tuple5Constr = mkConstr tuple5DataType "(,,,,)" [] Infix
 tuple5DataType = mkDataType "Prelude.(,,,,)" [tuple5Constr]
 
 instance (Data a, Data b, Data c, Data d, Data e)
          => Data (a,b,c,d,e) where
   gfoldl f z (a,b,c,d,e) = z (,,,,) `f` a `f` b `f` c `f` d `f` e
   toConstr _ = tuple5Constr
-  fromConstr c = case conIndex c of
+  fromConstr c = case constrIndex c of
                    1 -> (undefined,undefined,undefined,undefined,undefined)
                    _ -> error "fromConstr"
   dataTypeOf _ = tuple5DataType
@@ -440,7 +440,7 @@ instance (Data a, Data b, Data c, Data d, Data e)
 ------------------------------------------------------------------------------
 
 
-tuple6Constr = mkDataCon tuple6DataType "(,,,,,)" Infix
+tuple6Constr = mkConstr tuple6DataType "(,,,,,)" [] Infix
 tuple6DataType = mkDataType "Prelude.(,,,,,)" [tuple6Constr]
 
 instance (Data a, Data b, Data c, Data d, Data e, Data f)
@@ -448,7 +448,7 @@ instance (Data a, Data b, Data c, Data d, Data e, Data f)
   gfoldl f z (a,b,c,d,e,f') = z (,,,,,) `f` a `f` b `f` c `f` d `f` e `f` f'
   toConstr _ = tuple6Constr
   fromConstr c =
-    case conIndex c of
+    case constrIndex c of
            1 -> (undefined,undefined,undefined,undefined,undefined,undefined)
            _ -> error "fromConstr"
   dataTypeOf _ = tuple6DataType
@@ -457,7 +457,7 @@ instance (Data a, Data b, Data c, Data d, Data e, Data f)
 ------------------------------------------------------------------------------
 
 
-tuple7Constr = mkDataCon tuple7DataType "(,,,,,,)" Infix
+tuple7Constr = mkConstr tuple7DataType "(,,,,,,)" [] Infix
 tuple7DataType = mkDataType "Prelude.(,,,,,,)" [tuple7Constr]
 
 instance (Data a, Data b, Data c, Data d, Data e, Data f, Data g)
@@ -465,7 +465,7 @@ instance (Data a, Data b, Data c, Data d, Data e, Data f, Data g)
   gfoldl f z (a,b,c,d,e,f',g) =
     z (,,,,,,) `f` a `f` b `f` c `f` d `f` e `f` f' `f` g
   toConstr _ = tuple7Constr
-  fromConstr c = case conIndex c of
+  fromConstr c = case constrIndex c of
    1 -> (undefined,undefined,undefined,undefined,undefined,undefined,undefined)
    _ -> error "fromConstr"
   dataTypeOf _ = tuple7DataType
diff --git a/Data/Generics/Schemes.hs b/Data/Generics/Schemes.hs
index 5ee9b3a..1774933 100644
--- a/Data/Generics/Schemes.hs
+++ b/Data/Generics/Schemes.hs
@@ -25,6 +25,13 @@ module Data.Generics.Schemes (
 	listify,
         something,
 	synthesize,
+	gsize,
+	glength,
+	gdepth,
+	gcount,
+	gnodecount,
+	gtypecount,
+	gfindtype
 
  ) where
 
@@ -117,3 +124,45 @@ something = everything orElse
 --
 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))
+
+
+-- | 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, Data 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
diff --git a/Data/Generics/Text.hs b/Data/Generics/Text.hs
index b6ce518..881fd54 100644
--- a/Data/Generics/Text.hs
+++ b/Data/Generics/Text.hs
@@ -43,7 +43,7 @@ gshow :: Data a => a -> String
 -- 
 gshow = ( \t ->
                 "("
-             ++ conString (toConstr t)
+             ++ showConstr (toConstr t)
              ++ concat (gmapQ ((++) " " . gshow) t)
              ++ ")"
         ) `extQ` (show :: String -> String)
@@ -107,7 +107,7 @@ gread = readP_to_S gread'
     -- failing in the monad if it isn't a constructor of this data type
     str2con :: String -> ReadP Constr	
     str2con = maybe mzero return
-            . stringCon myDataType
+            . readConstr myDataType
 
     -- Get a Constr's string at the front of an input string
     parseConstr :: ReadP String
diff --git a/Data/Generics/Twins.hs b/Data/Generics/Twins.hs
index 99989bf..dd2cdec 100644
--- a/Data/Generics/Twins.hs
+++ b/Data/Generics/Twins.hs
@@ -1,7 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- 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
diff --git a/Data/Typeable.hs b/Data/Typeable.hs
index 6c0d3e6..b54f8fc 100644
--- a/Data/Typeable.hs
+++ b/Data/Typeable.hs
@@ -28,7 +28,7 @@ module Data.Typeable
 
 	-- * Type-safe cast
 	cast,			-- :: (Typeable a, Typeable b) => a -> Maybe b
-	cast0,			-- a flexible variation on cast
+	gcast,			-- a flexible variation on cast
 
 	-- * Type representations
 	TypeRep,	-- abstract, instance of: Eq, Show, Typeable
@@ -48,8 +48,8 @@ module Data.Typeable
 	-- * The Typeable1 class
 	Typeable1( typeOf1 ),	-- :: t a -> TyCon
 	Typeable2( typeOf2 ),	-- :: t a b -> TyCon
-	cast1,			-- :: ... => c (t a) -> Maybe (c (t' a))
-	cast2			-- :: ... => c (t a b) -> Maybe (c (t' a b))
+	gcast1,			-- :: ... => c (t a) -> Maybe (c (t' a))
+	gcast2			-- :: ... => c (t a b) -> Maybe (c (t' a b))
 
   ) where
 
@@ -270,8 +270,8 @@ cast x = r
 
 
 -- | A flexible variation parameterised in a type constructor
-cast0 :: (Typeable a, Typeable b) => c a -> Maybe (c b)
-cast0 x = r
+gcast :: (Typeable a, Typeable b) => c a -> Maybe (c b)
+gcast x = r
  where
   r = if typeOf (getArg x) == typeOf (getArg (fromJust r))
         then Just $ unsafeCoerce x
@@ -521,51 +521,51 @@ appKeys k ks = foldl appKey k ks
 
 -- | Variant for unary type constructors
 class Typeable1 t where
-  typeOf1 :: t a -> TyCon
+  typeOf1 :: t a -> TypeRep
 
 
 -- | Variant for binary type constructors
 class Typeable2 t where
-  typeOf2 :: t a b -> TyCon
+  typeOf2 :: t a b -> TypeRep
 
 
 #ifndef __NHC__
 
 -- | Instance for lists
 instance Typeable1 [] where
-  typeOf1 _ = typerepTyCon (typeOf (undefined::[()]))
+  typeOf1 _ = mkAppTy (typerepTyCon (typeOf (undefined::[()]))) []
 
 
 -- | Instance for maybes
 instance Typeable1 Maybe where
-  typeOf1 _ = typerepTyCon (typeOf (undefined::Maybe ()))
+  typeOf1 _ = mkAppTy (typerepTyCon (typeOf (undefined::Maybe ()))) []
 
 
 -- | Instance for ratios
 instance Typeable1 Ratio where
-  typeOf1 _ = typerepTyCon (typeOf (undefined::Ratio ()))
+  typeOf1 _ = mkAppTy (typerepTyCon (typeOf (undefined::Ratio ()))) []
 
 
 -- | Instance for products
 instance Typeable2 (,) where
-  typeOf2 _ = typerepTyCon (typeOf (undefined::((),())))
+  typeOf2 _ = mkAppTy (typerepTyCon (typeOf (undefined::((),())))) []
 
 
 -- | Instance for sums
 instance Typeable2 Either where
-  typeOf2 _ = typerepTyCon (typeOf (undefined::Either () ()))
+  typeOf2 _ = mkAppTy (typerepTyCon (typeOf (undefined::Either () ()))) []
 
 
 -- | Instance for functions
 instance Typeable2 (->) where
-  typeOf2 _ = typerepTyCon (typeOf (undefined::() -> ()))
+  typeOf2 _ = mkAppTy (typerepTyCon (typeOf (undefined::() -> ()))) []
 
 #endif
 
 
 -- | Cast for * -> *
-cast1 :: (Typeable1 t, Typeable1 t') => c (t a) -> Maybe (c (t' a)) 
-cast1 x = r
+gcast1 :: (Typeable1 t, Typeable1 t') => c (t a) -> Maybe (c (t' a)) 
+gcast1 x = r
  where
   r = if typeOf1 (getArg x) == typeOf1 (getArg (fromJust r))
        then Just $ unsafeCoerce x
@@ -575,8 +575,8 @@ cast1 x = r
 
 
 -- | Cast for * -> * -> *
-cast2 :: (Typeable2 t, Typeable2 t') => c (t a b) -> Maybe (c (t' a b)) 
-cast2 x = r
+gcast2 :: (Typeable2 t, Typeable2 t') => c (t a b) -> Maybe (c (t' a b)) 
+gcast2 x = r
  where
   r = if typeOf2 (getArg x) == typeOf2 (getArg (fromJust r))
        then Just $ unsafeCoerce x
-- 
1.7.10.4