X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FGenerics%2FBasics.hs;h=d8717a8d0bb4d59c1961c24dc233e4bb707214d0;hb=06638f8c2dc14da8cf4f999028a92aa50a27fab9;hp=ad16067114182d402ddcc2b4e0b5db7d44a76acf;hpb=a1f5912fe0c0c73e87e1c7e254e4ea9a6060effd;p=ghc-base.git

diff --git a/Data/Generics/Basics.hs b/Data/Generics/Basics.hs
index ad16067..d8717a8 100644
--- a/Data/Generics/Basics.hs
+++ b/Data/Generics/Basics.hs
@@ -1,21 +1,22 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Generics.Basics
--- Copyright   :  (c) The University of Glasgow, CWI 2001--2003
+-- Copyright   :  (c) The University of Glasgow, CWI 2001--2004
 -- License     :  BSD-style (see the file libraries/base/LICENSE)
 -- 
 -- Maintainer  :  libraries@haskell.org
 -- 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
+-- the Data class with its primitives for generic programming.
 --
 -----------------------------------------------------------------------------
 
 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
@@ -23,51 +24,84 @@ module Data.Generics.Basics (
 		gfoldl,		-- :: ... -> a -> c a
 		toConstr, 	-- :: a -> Constr
 		fromConstr,	-- :: Constr -> a
-		dataTypeOf	-- :: a -> DataType
-		
+		dataTypeOf,	-- :: a -> DataType
+		dataCast1,	-- mediate types and unary type constructors
+		dataCast2	-- mediate types and binary type constructors
             ),
 
-	-- * Constructor representations
+	-- * Datatype representations
+	DataType,	-- abstract, instance of: Show
 	Constr,		-- abstract, instance of: Eq, Show
+	DataRep(..),	-- instance of: Eq, Show
+	ConstrRep(..),	-- instance of: Eq, Show
 	ConIndex,	-- alias for Int, start at 1
 	Fixity(..),	-- instance of: Eq, Show
-	DataType,	-- abstract, instance of: Show
 
-	-- * Constructing constructor representations
-	mkConstr,   	-- :: ConIndex -> String -> Fixity -> Constr
-	mkDataType,	-- :: [Constr] -> DataType
-
-	-- * Observing constructor representations
-	conString,	-- :: Constr -> String
-	conFixity,	-- :: Constr -> Fixity
-	conIndex,	-- :: Constr -> ConIndex
-	stringCon,	-- :: DataType -> String -> Maybe Constr
-	indexCon,	-- :: DataType -> ConIndex -> Constr
-	maxConIndex,	-- :: DataType -> ConIndex
-	dataTypeCons, 	-- :: DataType -> [Constr]
+	-- * Observers for datatype representations
+	dataTypeName,	-- :: DataType -> String
+	dataTypeRep,	-- :: DataType -> DataRep
+ 	constrType,	-- :: Constr   -> DataType
+ 	constrRep,	-- :: Constr   -> ConstrRep
+ 	repConstr,		-- :: DataType -> ConstrRep -> Constr
+
+	-- * Representations of algebraic data types
+	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
+	showConstr, 	-- :: Constr   -> String
+	readConstr,	-- :: DataType -> String -> Maybe Constr
+
+	-- * Convenience funtions: algebraic data types
+	isAlgType,	-- :: DataType -> Bool
+	indexConstr,	-- :: DataType -> ConIndex -> Constr
+	constrIndex,	-- :: Constr   -> ConIndex
+	maxConstrIndex,	-- :: DataType -> ConIndex
+
+	-- * Representation of primitive types
+	mkIntType,	-- :: String -> DataType
+	mkFloatType,	-- :: String -> DataType
+	mkStringType,	-- :: String -> DataType
+	mkIntConstr,	-- :: DataType -> Integer -> Constr
+	mkFloatConstr,	-- :: DataType -> Double  -> Constr
+	mkStringConstr,	-- :: DataType -> String  -> Constr
+
+	-- * Non-representations for non-presentable types
+	mkNorepType,	-- :: String -> DataType
+	isNorepType,	-- :: DataType -> Bool
+
+	-- * Convenience functions: take type constructors apart
+	tyconUQname,	-- :: String -> String
+	tyconModule,	-- :: String -> String
 
         -- * Generic maps defined in terms of gfoldl 
 	gmapT,
         gmapQ, 
         gmapQl,
         gmapQr,
+        gmapQi,
         gmapM,
         gmapMp,
-
-	-- * Generic unfolding defined in terms of gfoldl and fromConstr
-	gunfoldM	-- :: Monad m => ... -> m a
+        gmapMo,
 
   ) where
 
 
 ------------------------------------------------------------------------------
 
+#ifdef __HADDOCK__
+import Prelude
+#endif
 
 import Data.Typeable
 import Data.Maybe
 import Control.Monad
 
 
+
 ------------------------------------------------------------------------------
 --
 --	The Data class
@@ -122,7 +156,6 @@ fold.
   --
   gfoldl _ z = z
 
-
   -- | Obtaining the constructor from a given datum.
   -- For proper terms, this is meant to be the top-level constructor.
   -- Primitive datatypes are here viewed as potentially infinite sets of
@@ -139,6 +172,27 @@ fold.
   dataTypeOf  :: a -> DataType
 
 
+
+------------------------------------------------------------------------------
+--
+-- Mediate types and type constructors
+--
+------------------------------------------------------------------------------
+
+  -- | Mediate types and unary type constructors
+  dataCast1 :: Typeable1 t
+            => (forall a. Data a => c (t a))
+            -> Maybe (c a)
+  dataCast1 _ = Nothing
+
+  -- | Mediate types and binary type constructors
+  dataCast2 :: Typeable2 t
+            => (forall a b. (Data a, Data b) => c (t a b))
+            -> Maybe (c a)
+  dataCast2 _ = Nothing
+
+
+
 ------------------------------------------------------------------------------
 --
 --	Typical generic maps defined in terms of gfoldl
@@ -209,11 +263,20 @@ unit.
     where
       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 query that processes one child by index (zero-based)
+  gmapQi :: Int -> (forall a. Data a => a -> u) -> a -> u
+  gmapQi i f x = case gfoldl k z x of { Qi _ q -> fromJust q } 
+    where
+      k (Qi i' q) a = Qi (i'+1) (if i==i' then Just (f a) else q) 
+      z f           = Qi 0 Nothing
+
+
   -- | A generic monadic transformation that maps over the immediate subterms
   gmapM   :: Monad m => (forall a. Data a => a -> m a) -> a -> m a
 
@@ -246,8 +309,32 @@ this end, we couple the monadic computation with a Boolean.
       k (Mp c) x
         = Mp ( c >>= \(h,b) -> 
                  (f x >>= \x' -> return (h x',True))
-                 `mplus` return (h x, b)
-               )
+                 `mplus` return (h x,b)
+             )
+
+  -- | Transformation of one immediate subterm with success
+  gmapMo :: MonadPlus m => (forall a. Data a => a -> m a) -> a -> m a
+
+{-
+
+We use the same pairing trick as for gmapMp, 
+i.e., we use an extra Bool component to keep track of the 
+fact whether an immediate subterm was processed successfully.
+However, we cut of mapping over subterms once a first subterm
+was transformed successfully.
+
+-}
+
+  gmapMo f x = unMp (gfoldl k z x) >>= \(x',b) ->
+                if b then return x' else mzero
+    where
+      z g = Mp (return (g,False))
+      k (Mp c) x
+        = Mp ( c >>= \(h,b) -> if b 
+                        then return (h x,b)
+                        else (f x >>= \x' -> return (h x',True))
+                             `mplus` return (h x,b)
+             )
 
 
 -- | The identity type constructor needed for the definition of gmapT
@@ -258,6 +345,10 @@ newtype ID x = ID { unID :: x }
 newtype CONST c a = CONST { unCONST :: c }
 
 
+-- | Type constructor for adding counters to queries
+data Qi q a = Qi Int (Maybe q)
+
+
 -- | The type constructor used in definition of gmapQr
 newtype Qr r a = Qr { unQr  :: r -> r }
 
@@ -269,46 +360,64 @@ newtype Mp m x = Mp { unMp :: m (x, Bool) }
 
 ------------------------------------------------------------------------------
 --
---	Constructor representations
+--	Datatype and constructor representations
 --
 ------------------------------------------------------------------------------
 
 
--- | Representation of constructors
-data Constr =
-	-- The prime case for proper datatype constructors
-	       DataConstr ConIndex String Fixity
+--
+-- | Representation of datatypes.
+-- | A package of constructor representations with names of type and module.
+-- | The list of constructors could be an array, a balanced tree, or others.
+--
+data DataType = DataType
+			{ tycon   :: String
+			, datarep :: DataRep
+			}
 
-	-- Provision for built-in types
-	    | IntConstr     Int
-	    | IntegerConstr Integer
-	    | FloatConstr   Float
-	    | CharConstr    Char
+              deriving Show
 
-	-- Provision for any type that can be read/shown as string
-	    | StringConstr  String
 
-	-- Provision for function types
-	    | FunConstr
+-- | Representation of constructors
+data Constr = Constr
+			{ conrep    :: ConstrRep
+			, constring :: String
+			, confields :: [String]	-- for AlgRep only
+			, confixity :: Fixity	-- for AlgRep only
+			, datatype  :: DataType
+			}
 
-              deriving (Show, Typeable)
+instance Show Constr where
+ show = constring
 
--- 
--- Equality of datatype constructors via index.
--- Use designated equalities for primitive types.
--- 
+
+-- | Equality of constructors
 instance Eq Constr where
-  (DataConstr i1 _ _) == (DataConstr i2 _ _) = i1 == i2
-  (IntConstr i1)      == (IntConstr i2)      = i1 == i2
-  (IntegerConstr i1)  == (IntegerConstr i2)  = i1 == i2
-  (FloatConstr i1)    == (FloatConstr i2)    = i1 == i2
-  (CharConstr i1)     == (CharConstr i2)     = i1 == i2
-  (StringConstr i1)   == (StringConstr i2)   = i1 == i2
-  _ == _ = False
+  c == c' = constrRep c == constrRep c'
+
+
+-- | Public representation of datatypes
+data DataRep = AlgRep [Constr]
+             | IntRep
+	     | FloatRep
+	     | StringRep
+             | NoRep
+
+	    deriving (Eq,Show)
 
 
+-- | Public representation of constructors
+data ConstrRep = AlgConstr    ConIndex
+               | IntConstr    Integer
+    	       | FloatConstr  Double
+    	       | StringConstr String
+
+	       deriving (Eq,Show)
+
+
+--
 -- | Unique index for datatype constructors.
---   Textual order is respected. Starts at 1.
+-- | Textual order is respected. Starts at 1.
 --
 type ConIndex = Int
 
@@ -316,278 +425,275 @@ type ConIndex = Int
 -- | Fixity of constructors
 data Fixity = Prefix
             | Infix	-- Later: add associativity and precedence
+
 	    deriving (Eq,Show)
 
--- | A package of constructor representations;
---   could be a list, an array, a balanced tree, or others.
+
+------------------------------------------------------------------------------
+--
+--	Observers for datatype representations
 --
-data DataType =
-	-- The prime case for algebraic datatypes
-	       DataType [Constr]
+------------------------------------------------------------------------------
 
-	-- Provision for built-in types
-	    | IntType
-	    | IntegerType
-	    | FloatType
-	    | CharType
 
-	-- Provision for any type that can be read/shown as string
-	    | StringType
+-- | Gets the type constructor including the module
+dataTypeName :: DataType -> String
+dataTypeName = tycon
 
-	-- Provision for function types
-	    | FunType
 
-              deriving Show
+
+-- | Gets the public presentation of datatypes
+dataTypeRep :: DataType -> DataRep
+dataTypeRep = datarep
+
+
+-- | Gets the datatype of a constructor
+constrType :: Constr -> DataType
+constrType = datatype
+
+
+-- | Gets the public presentation of constructors
+constrRep :: Constr -> ConstrRep
+constrRep = conrep
+
+
+-- | Look up a constructor by its representation
+repConstr :: DataType -> ConstrRep -> Constr
+repConstr dt cr =
+      case (dataTypeRep dt, cr) of
+	(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"
+
 
 
 ------------------------------------------------------------------------------
 --
---	Constructing constructor representations
+--	Representations of algebraic data types
 --
 ------------------------------------------------------------------------------
 
 
--- | Make a representation for a datatype constructor
-mkConstr   :: ConIndex -> String -> Fixity -> Constr
---	ToDo: consider adding arity?
-mkConstr = DataConstr
+-- | Constructs an algebraic datatype
+mkDataType :: String -> [Constr] -> DataType
+mkDataType str cs = DataType
+			{ tycon   = str
+			, datarep = AlgRep cs
+			}
+
+
+-- | Constructs a constructor
+mkConstr :: DataType -> String -> [String] -> Fixity -> Constr
+mkConstr dt str fields fix =
+	Constr
+		{ conrep    = AlgConstr idx
+		, constring = str
+		, confields = fields
+		, confixity = fix
+		, datatype  = dt 
+		}
+  where
+    idx = head [ i | (c,i) <- dataTypeConstrs dt `zip` [1..],
+                     showConstr c == str ]
+
+
+-- | Gets the constructors
+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
+constrFixity :: Constr -> Fixity
+constrFixity = confixity
 
--- | Make a package of constructor representations
-mkDataType :: [Constr] -> DataType
-mkDataType = DataType
 
 
 ------------------------------------------------------------------------------
 --
---	Observing constructor representations
---
+--	From strings to constr's and vice versa: all data types
+--	
 ------------------------------------------------------------------------------
 
 
--- | Turn a constructor into a string
-conString :: Constr -> String
-conString (DataConstr _ str _) = str
-conString (IntConstr int)      = show int
-conString (IntegerConstr int)  = show int
-conString (FloatConstr real)   = show real
-conString (CharConstr char)    = show char
-conString (StringConstr str)   = show str
-conString FunConstr            = "->"
+-- | Gets the string for a constructor
+showConstr :: Constr -> String
+showConstr = constring
 
 
--- | Determine fixity of a constructor;
---   undefined for primitive types.
-conFixity :: Constr -> Fixity
-conFixity (DataConstr _ _ fix) = fix
-conFixity _                    = undefined
+-- | Lookup a constructor via a string
+readConstr :: DataType -> String -> Maybe Constr
+readConstr dt str =
+      case dataTypeRep dt of
+	AlgRep cons -> idx cons
+	IntRep      -> mkReadCon (\i -> (mkPrimCon dt str (IntConstr i)))
+	FloatRep    -> mkReadCon (\f -> (mkPrimCon dt str (FloatConstr f)))
+	StringRep   -> Just (mkStringConstr dt str)
+        NoRep       -> Nothing
+  where
 
+    -- Read a value and build a constructor
+    mkReadCon :: Read t => (t -> Constr) -> Maybe Constr
+    mkReadCon f = case (reads str) of
+		    [(t,"")] -> Just (f t)
+		    _ -> Nothing
 
--- | Determine index of a constructor.
---   Undefined for primitive types.
-conIndex   :: Constr -> ConIndex
-conIndex (DataConstr idx _ _) = idx
-conIndex _                    = undefined
+    -- Traverse list of algebraic datatype constructors
+    idx :: [Constr] -> Maybe Constr
+    idx cons = let fit = filter ((==) str . showConstr) cons 
+                in if fit == []
+                     then Nothing
+                     else Just (head fit)
 
 
--- | Lookup a constructor via a string
-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'
-                                   then Just c
-                                   else worker cs
-        _ -> undefined -- other forms of Constr not valid here
+------------------------------------------------------------------------------
+--
+--	Convenience funtions: algebraic data types
+--
+------------------------------------------------------------------------------
+
 
-stringCon IntType str       = Just . IntConstr     $ read str
-stringCon IntegerType str   = Just . IntegerConstr $ read str
-stringCon FloatType str     = Just . FloatConstr   $ read str
-stringCon CharType str      = Just . CharConstr    $ read str
-stringCon StringType str    = Just . StringConstr  $ read str
-stringCon FunType str       = Just FunConstr
+-- | Test for an algebraic type
+isAlgType :: DataType -> Bool
+isAlgType dt = case datarep dt of
+		 (AlgRep _) -> True
+		 _ -> False 
 
 
--- | Lookup a constructor by its index;
----  not defined for primitive types.
-indexCon :: DataType -> ConIndex -> Constr
-indexCon (DataType cs) idx = cs !! (idx-1)
-indexCon _ _ = undefined -- otherwise
+-- | Gets the constructor for an index
+indexConstr :: DataType -> ConIndex -> Constr
+indexConstr dt idx = case datarep dt of
+			(AlgRep cs) -> cs !! (idx-1)
+			_           -> error "indexConstr"
 
 
--- | Return maximum index;
---   0 for primitive types
-maxConIndex :: DataType -> ConIndex
-maxConIndex (DataType cs) = length cs
-maxConIndex _ = 0 -- otherwise
+-- | Gets the index of a constructor
+constrIndex :: Constr -> ConIndex
+constrIndex con = case constrRep con of
+                    (AlgConstr idx) -> idx
+ 		    _ -> error "constrIndex"
 
 
--- | Return all constructors in increasing order of indicies;
--- empty list for primitive types
-dataTypeCons :: DataType -> [Constr] 
-dataTypeCons (DataType cs) = cs
-dataTypeCons _ = [] -- otherwise
+-- | Gets the maximum constructor index
+maxConstrIndex :: DataType -> ConIndex
+maxConstrIndex dt = case dataTypeRep dt of
+			AlgRep cs -> length cs
+			_ 	     -> error "maxConstrIndex"
+
 
 
 ------------------------------------------------------------------------------
 --
---	Instances of the Data class for Prelude types
+--	Representation of primitive types
 --
 ------------------------------------------------------------------------------
 
--- Basic datatype Int; folding and unfolding is trivial
-instance Data Int where
-  toConstr x = IntConstr x
-  fromConstr (IntConstr x) = x
-  dataTypeOf _ = IntType
-
--- Another basic datatype instance
-instance Data Integer where
-  toConstr x = IntegerConstr x
-  fromConstr (IntegerConstr x) = x
-  dataTypeOf _ = IntegerType
-
--- Another basic datatype instance
-instance Data Float where
-  toConstr x = FloatConstr x
-  fromConstr (FloatConstr x) = x
-  dataTypeOf _ = FloatType
-
--- Another basic datatype instance
-instance Data Char where
-  toConstr x = CharConstr x
-  fromConstr (CharConstr x) = x
-  dataTypeOf _ = CharType
-
--- A basic datatype without a specific branch in Constr
-instance Data Rational where
-  toConstr x = StringConstr (show x)
-  fromConstr (StringConstr x) = read x
-  dataTypeOf _ = StringType
 
---
--- Bool as the most trivial algebraic datatype;
--- define top-level definitions for representations.
---
+-- | Constructs the Int type
+mkIntType :: String -> DataType
+mkIntType = mkPrimType IntRep
 
-falseConstr  = mkConstr 1 "False" Prefix
-trueConstr   = mkConstr 2 "True"  Prefix
-boolDataType = mkDataType [falseConstr,trueConstr]
 
-instance Data Bool where
-  toConstr False = falseConstr
-  toConstr True  = trueConstr
-  fromConstr c = case conIndex c of
-                   1 -> False
-                   2 -> True
-  dataTypeOf _ = boolDataType
+-- | Constructs the Float type
+mkFloatType :: String -> DataType
+mkFloatType = mkPrimType FloatRep
 
 
---
--- Lists as an example of a polymorphic algebraic datatype.
--- Cons-lists are terms with two immediate subterms.
---
+-- | Constructs the String type
+mkStringType :: String -> DataType
+mkStringType = mkPrimType StringRep
 
-nilConstr    = mkConstr 1 "[]"  Prefix
-consConstr   = mkConstr 2 "(:)" Infix
-listDataType = mkDataType [nilConstr,consConstr]
 
-instance Data a => Data [a] where
-  gfoldl f z []     = z []
-  gfoldl f z (x:xs) = z (:) `f` x `f` xs
-  toConstr []    = nilConstr
-  toConstr (_:_) = consConstr
-  fromConstr c = case conIndex c of
-                   1 -> []
-                   2 -> undefined:undefined
-  dataTypeOf _ = listDataType
+-- | Helper for mkIntType, mkFloatType, mkStringType
+mkPrimType :: DataRep -> String -> DataType
+mkPrimType dr str = DataType
+			{ tycon   = str
+			, datarep = dr
+			}
 
---
--- The gmaps are given as an illustration.
--- This shows that the gmaps for lists are different from list maps.
---
-  gmapT  f   []     = []
-  gmapT  f   (x:xs) = (f x:f xs)
-  gmapQ  f   []     = []
-  gmapQ  f   (x:xs) = [f x,f xs]
-  gmapM  f   []     = return []
-  gmapM  f   (x:xs) = f x >>= \x' -> f xs >>= \xs' -> return (x':xs')
 
+-- Makes a constructor for primitive types
+mkPrimCon :: DataType -> String -> ConstrRep -> Constr
+mkPrimCon dt str cr = Constr 
+			{ datatype  = dt
+			, conrep    = cr
+			, constring = str
+			, confields = error "constrFields"
+			, confixity = error "constrFixity"
+			}
 
---
--- Yet another polymorphic datatype constructor
--- No surprises.
---
 
-nothingConstr = mkConstr 1 "Nothing" Prefix
-justConstr    = mkConstr 2 "Just"    Prefix
-maybeDataType = mkDataType [nothingConstr,justConstr]
+mkIntConstr :: DataType -> Integer -> Constr
+mkIntConstr dt i = case datarep dt of
+		  IntRep -> mkPrimCon dt (show i) (IntConstr i)
+		  _ -> error "mkIntConstr"
 
-instance Data a => Data (Maybe a) where
-  gfoldl f z Nothing  = z Nothing
-  gfoldl f z (Just x) = z Just `f` x
-  toConstr Nothing  = nothingConstr
-  toConstr (Just _) = justConstr
-  fromConstr c = case conIndex c of
-                   1 -> Nothing
-                   2 -> Just undefined
-  dataTypeOf _ = maybeDataType
 
---
--- Yet another polymorphic datatype constructor.
--- No surprises.
---
+mkFloatConstr :: DataType -> Double -> Constr
+mkFloatConstr dt f = case datarep dt of
+		    FloatRep -> mkPrimCon dt (show f) (FloatConstr f)
+		    _ -> error "mkFloatConstr"
 
-pairConstr = mkConstr 1 "(,)" Infix
-productDataType = mkDataType [pairConstr]
 
-instance (Data a, Data b) => Data (a,b) where
-  gfoldl f z (a,b) = z (,) `f` a `f` b
-  toConstr _ = pairConstr
-  fromConstr c = case conIndex c of
-                   1 -> (undefined,undefined)
-  dataTypeOf _ = productDataType
+mkStringConstr :: DataType -> String -> Constr
+mkStringConstr dt str = case datarep dt of
+		       StringRep -> mkPrimCon dt str (StringConstr str)
+		       _ -> error "mkStringConstr"
 
 
-{-
+------------------------------------------------------------------------------
+--
+--	Non-representations for non-presentable types
+--
+------------------------------------------------------------------------------
 
-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 be
-sensible even more for UNFOLDING. In the definition of "gread"
-(generic read --- based on unfolding), we succeed handling strings in a
-special way by using a type-specific case for String.
-
-instance Data String where
-  toConstr x = StringConstr x
-  fromConstr (StringConstr x) = x
-  dataTypeOf _ = StringType
 
--}
+-- | Constructs a non-representation
+mkNorepType :: String -> DataType
+mkNorepType str = DataType
+			{ tycon   = str
+			, datarep = NoRep
+			}
+
+
+-- | Test for a non-representable type
+isNorepType :: DataType -> Bool
+isNorepType dt = case datarep dt of
+	 	   NoRep -> True
+		   _ -> False 
 
--- A last resort for functions
-instance (Typeable a, Typeable b) => Data (a -> b) where
-  toConstr _   = FunConstr
-  fromConstr _ = undefined
-  dataTypeOf _ = FunType
 
 
 ------------------------------------------------------------------------------
 --
---	Generic unfolding
+--	Convenience for qualified type constructors
 --
 ------------------------------------------------------------------------------
 
--- | Construct an initial with undefined immediate subterms
---   and then map over the skeleton to fill in proper terms.
+
+-- | Gets the unqualified type constructor
+-- Drop *.*.*... before name
 --
-gunfoldM :: (Monad m, Data a)
-         => Constr
-         -> (forall a. Data a => m a)
-         -> m a
-gunfoldM c f = gmapM (const f) $ fromConstr c
+tyconUQname :: String -> String
+tyconUQname x = let x' = dropWhile (not . (==) '.') x
+                 in if x' == [] then x else tyconUQname (tail x')
+
+
+-- | Gets the module of a type constructor
+-- Take *.*.*... before name
+tyconModule :: String -> String
+tyconModule x = let (a,b) = break ((==) '.') x
+                 in if b == ""
+                      then b 
+                      else a ++ tyconModule' (tail b)
+  where
+    tyconModule' x = let x' = tyconModule x
+                      in if x' == "" then "" else ('.':x')